mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
Merge branch 'master' into core-updates
This commit is contained in:
Ludovic Courtès
commit
872c69d00e
45 changed files with 1579 additions and 745 deletions
|
|
@ -24,23 +24,19 @@
|
||||||
|
|
||||||
(use-modules (gnu)
|
(use-modules (gnu)
|
||||||
|
|
||||||
(gnu packages zile)
|
|
||||||
(gnu packages xorg)
|
(gnu packages xorg)
|
||||||
(gnu packages admin)
|
(gnu packages avahi)
|
||||||
(gnu packages guile)
|
|
||||||
(gnu packages bash)
|
|
||||||
(gnu packages linux)
|
|
||||||
(gnu packages less)
|
|
||||||
(gnu packages tor)
|
|
||||||
(gnu packages package-management)
|
|
||||||
|
|
||||||
(gnu services networking)
|
(gnu services networking)
|
||||||
|
(gnu services avahi)
|
||||||
|
(gnu services dbus)
|
||||||
(gnu services xorg))
|
(gnu services xorg))
|
||||||
|
|
||||||
(operating-system
|
(operating-system
|
||||||
(host-name "gnu")
|
(host-name "gnu")
|
||||||
(timezone "Europe/Paris")
|
(timezone "Europe/Paris")
|
||||||
(locale "en_US.UTF-8")
|
(locale "en_US.UTF-8")
|
||||||
|
|
||||||
(bootloader (grub-configuration
|
(bootloader (grub-configuration
|
||||||
(device "/dev/sda")))
|
(device "/dev/sda")))
|
||||||
(file-systems
|
(file-systems
|
||||||
|
|
@ -52,6 +48,7 @@
|
||||||
(type "dummy"))
|
(type "dummy"))
|
||||||
;; %fuse-control-file-system ; needs fuse.ko
|
;; %fuse-control-file-system ; needs fuse.ko
|
||||||
%binary-format-file-system))
|
%binary-format-file-system))
|
||||||
|
|
||||||
(users (list (user-account
|
(users (list (user-account
|
||||||
(name "guest")
|
(name "guest")
|
||||||
(group "wheel")
|
(group "wheel")
|
||||||
|
|
@ -67,6 +64,17 @@
|
||||||
(name "users")
|
(name "users")
|
||||||
(id 100)
|
(id 100)
|
||||||
(members '("guest")))))
|
(members '("guest")))))
|
||||||
|
|
||||||
|
(issue "
|
||||||
|
This is an alpha preview of the GNU system. Welcome.
|
||||||
|
|
||||||
|
This image features the GNU Guix package manager, which was used to
|
||||||
|
build it (http://www.gnu.org/software/guix/). The init system is
|
||||||
|
GNU dmd (http://www.gnu.org/software/dmd/).
|
||||||
|
|
||||||
|
You can log in as 'guest' or 'root' with no password.
|
||||||
|
")
|
||||||
|
|
||||||
(services (cons* (slim-service #:auto-login? #t
|
(services (cons* (slim-service #:auto-login? #t
|
||||||
#:default-user "guest")
|
#:default-user "guest")
|
||||||
|
|
||||||
|
|
@ -75,11 +83,12 @@
|
||||||
#:name-servers '("10.0.2.3")
|
#:name-servers '("10.0.2.3")
|
||||||
#:gateway "10.0.2.2")
|
#:gateway "10.0.2.2")
|
||||||
|
|
||||||
|
(avahi-service)
|
||||||
|
(dbus-service (list avahi))
|
||||||
|
|
||||||
%base-services))
|
%base-services))
|
||||||
(pam-services
|
(pam-services
|
||||||
;; Explicitly allow for empty passwords.
|
;; Explicitly allow for empty passwords.
|
||||||
(base-pam-services #:allow-empty-passwords? #t))
|
(base-pam-services #:allow-empty-passwords? #t))
|
||||||
(packages (list bash coreutils findutils grep sed
|
|
||||||
procps psmisc less
|
(packages (cons* xterm avahi %base-packages)))
|
||||||
guile-2.0 dmd guix util-linux inetutils
|
|
||||||
xterm zile)))
|
|
||||||
|
|
|
||||||
|
|
@ -55,6 +55,7 @@
|
||||||
(gnu packages make-bootstrap)
|
(gnu packages make-bootstrap)
|
||||||
(gnu system)
|
(gnu system)
|
||||||
(gnu system vm)
|
(gnu system vm)
|
||||||
|
(gnu system install)
|
||||||
(srfi srfi-1)
|
(srfi srfi-1)
|
||||||
(srfi srfi-26)
|
(srfi srfi-26)
|
||||||
(ice-9 match))
|
(ice-9 match))
|
||||||
|
|
@ -114,6 +115,12 @@ SYSTEM."
|
||||||
'("mips64el-linux-gnu"
|
'("mips64el-linux-gnu"
|
||||||
"mips64el-linux-gnuabi64"))
|
"mips64el-linux-gnuabi64"))
|
||||||
|
|
||||||
|
(define (demo-os)
|
||||||
|
"Return the \"demo\" 'operating-system' structure."
|
||||||
|
(let* ((dir (dirname (assoc-ref (current-source-location) 'filename)))
|
||||||
|
(file (string-append dir "/demo-os.scm")))
|
||||||
|
(read-operating-system file)))
|
||||||
|
|
||||||
(define (qemu-jobs store system)
|
(define (qemu-jobs store system)
|
||||||
"Return a list of jobs that build QEMU images for SYSTEM."
|
"Return a list of jobs that build QEMU images for SYSTEM."
|
||||||
(define (->alist drv)
|
(define (->alist drv)
|
||||||
|
|
@ -130,24 +137,28 @@ system.")
|
||||||
(string->symbol system))))
|
(string->symbol system))))
|
||||||
`(,name . ,(cut ->alist drv))))
|
`(,name . ,(cut ->alist drv))))
|
||||||
|
|
||||||
(if (string=? system "x86_64-linux")
|
(define MiB
|
||||||
(let* ((dir (dirname (assoc-ref (current-source-location) 'filename)))
|
(expt 2 20))
|
||||||
(file (string-append dir "/demo-os.scm"))
|
|
||||||
(os (read-operating-system file))
|
(if (member system '("x86_64-linux" "i686-linux"))
|
||||||
(size (* 1400 (expt 2 20)))) ; 1.4GiB
|
|
||||||
(if (operating-system? os)
|
|
||||||
(list (->job 'qemu-image
|
(list (->job 'qemu-image
|
||||||
(run-with-store store
|
(run-with-store store
|
||||||
(system-qemu-image os
|
(system-qemu-image (demo-os)
|
||||||
#:disk-image-size size))))
|
#:disk-image-size
|
||||||
'()))
|
(* 1400 MiB)))) ; 1.4 GiB
|
||||||
|
(->job 'usb-image
|
||||||
|
(run-with-store store
|
||||||
|
(system-disk-image installation-os
|
||||||
|
#:disk-image-size
|
||||||
|
(* 630 MiB)))))
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
(define (hydra-jobs store arguments)
|
(define (hydra-jobs store arguments)
|
||||||
"Return Hydra jobs."
|
"Return Hydra jobs."
|
||||||
(define systems
|
(define systems
|
||||||
;; Systems we want to build for.
|
;; Systems we want to build for.
|
||||||
'("x86_64-linux" "i686-linux"))
|
'("x86_64-linux" "i686-linux"
|
||||||
|
"mips64el-linux"))
|
||||||
|
|
||||||
(define subset
|
(define subset
|
||||||
(match (assoc-ref arguments 'subset)
|
(match (assoc-ref arguments 'subset)
|
||||||
|
|
@ -165,12 +176,22 @@ system.")
|
||||||
(and (string-prefix? "i686-" system)
|
(and (string-prefix? "i686-" system)
|
||||||
(string-suffix? "64" target)))
|
(string-suffix? "64" target)))
|
||||||
|
|
||||||
|
(define (same? target)
|
||||||
|
;; Return true if SYSTEM and TARGET are the same thing. This is so we
|
||||||
|
;; don't try to cross-compile to 'mips64el-linux-gnu' from
|
||||||
|
;; 'mips64el-linux'.
|
||||||
|
(string-contains target system))
|
||||||
|
|
||||||
|
(define (either proc1 proc2)
|
||||||
|
(lambda (x)
|
||||||
|
(or (proc1 x) (proc2 x))))
|
||||||
|
|
||||||
(append-map (lambda (target)
|
(append-map (lambda (target)
|
||||||
(map (lambda (package)
|
(map (lambda (package)
|
||||||
(package-cross-job store (job-name package)
|
(package-cross-job store (job-name package)
|
||||||
package target system))
|
package target system))
|
||||||
%packages-to-cross-build))
|
%packages-to-cross-build))
|
||||||
(remove from-32-to-64? %cross-targets)))
|
(remove (either from-32-to-64? same?) %cross-targets)))
|
||||||
|
|
||||||
;; Return one job for each package, except bootstrap packages.
|
;; Return one job for each package, except bootstrap packages.
|
||||||
(let ((base-packages (delete-duplicates
|
(let ((base-packages (delete-duplicates
|
||||||
|
|
|
||||||
|
|
@ -4,7 +4,7 @@ exec guile -l "$0" \
|
||||||
(cdr (command-line)))'
|
(cdr (command-line)))'
|
||||||
!#
|
!#
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2013 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
|
;;; Copyright © 2013 Alex Sassmannshausen <alex.sassmannshausen@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
|
|
@ -148,7 +148,8 @@ decreasing, is 1."
|
||||||
|
|
||||||
`(div "status: "
|
`(div "status: "
|
||||||
,(url "x86_64-linux") " "
|
,(url "x86_64-linux") " "
|
||||||
,(url "i686-linux")))
|
,(url "i686-linux") " "
|
||||||
|
,(url "mips64el-linux")))
|
||||||
|
|
||||||
(define (package-logo name)
|
(define (package-logo name)
|
||||||
(and=> (lookup-gnu-package name)
|
(and=> (lookup-gnu-package name)
|
||||||
|
|
|
||||||
|
|
@ -1737,7 +1737,7 @@ a derivation is the @code{derivation} procedure:
|
||||||
@var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
|
@var{args} [#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
|
||||||
[#:recursive? #f] [#:inputs '()] [#:env-vars '()] @
|
[#:recursive? #f] [#:inputs '()] [#:env-vars '()] @
|
||||||
[#:system (%current-system)] [#:references-graphs #f] @
|
[#:system (%current-system)] [#:references-graphs #f] @
|
||||||
[#:local-build? #f]
|
[#:allowed-references #f] [#:local-build? #f]
|
||||||
Build a derivation with the given arguments, and return the resulting
|
Build a derivation with the given arguments, and return the resulting
|
||||||
@code{<derivation>} object.
|
@code{<derivation>} object.
|
||||||
|
|
||||||
|
|
@ -1753,6 +1753,9 @@ name/store path pairs. In that case, the reference graph of each store
|
||||||
path is exported in the build environment in the corresponding file, in
|
path is exported in the build environment in the corresponding file, in
|
||||||
a simple text format.
|
a simple text format.
|
||||||
|
|
||||||
|
When @var{allowed-references} is true, it must be a list of store items
|
||||||
|
or outputs that the derivation's output may refer to.
|
||||||
|
|
||||||
When @var{local-build?} is true, declare that the derivation is not a
|
When @var{local-build?} is true, declare that the derivation is not a
|
||||||
good candidate for offloading and should rather be built locally
|
good candidate for offloading and should rather be built locally
|
||||||
(@pxref{Daemon Offload Setup}). This is the case for small derivations
|
(@pxref{Daemon Offload Setup}). This is the case for small derivations
|
||||||
|
|
@ -1795,7 +1798,8 @@ is now deprecated in favor of the much nicer @code{gexp->derivation}.
|
||||||
[#:system (%current-system)] [#:inputs '()] @
|
[#:system (%current-system)] [#:inputs '()] @
|
||||||
[#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
|
[#:outputs '("out")] [#:hash #f] [#:hash-algo #f] @
|
||||||
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
|
[#:recursive? #f] [#:env-vars '()] [#:modules '()] @
|
||||||
[#:references-graphs #f] [#:local-build? #f] [#:guile-for-build #f]
|
[#:references-graphs #f] [#:allowed-references #f] @
|
||||||
|
[#:local-build? #f] [#:guile-for-build #f]
|
||||||
Return a derivation that executes Scheme expression @var{exp} as a
|
Return a derivation that executes Scheme expression @var{exp} as a
|
||||||
builder for derivation @var{name}. @var{inputs} must be a list of
|
builder for derivation @var{name}. @var{inputs} must be a list of
|
||||||
@code{(name drv-path sub-drv)} tuples; when @var{sub-drv} is omitted,
|
@code{(name drv-path sub-drv)} tuples; when @var{sub-drv} is omitted,
|
||||||
|
|
@ -1817,8 +1821,8 @@ terminates by passing the result of @var{exp} to @code{exit}; thus, when
|
||||||
@var{guile-for-build} is omitted or is @code{#f}, the value of the
|
@var{guile-for-build} is omitted or is @code{#f}, the value of the
|
||||||
@code{%guile-for-build} fluid is used instead.
|
@code{%guile-for-build} fluid is used instead.
|
||||||
|
|
||||||
See the @code{derivation} procedure for the meaning of @var{references-graphs}
|
See the @code{derivation} procedure for the meaning of
|
||||||
and @var{local-build?}.
|
@var{references-graphs}, @var{allowed-references}, and @var{local-build?}.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
@noindent
|
@noindent
|
||||||
|
|
@ -3113,14 +3117,8 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
|
||||||
@findex operating-system
|
@findex operating-system
|
||||||
@lisp
|
@lisp
|
||||||
(use-modules (gnu) ; for 'user-account', '%base-services', etc.
|
(use-modules (gnu) ; for 'user-account', '%base-services', etc.
|
||||||
(gnu services ssh) ; for 'lsh-service'
|
(gnu packages emacs) ; for 'emacs'
|
||||||
(gnu packages base) ; Coreutils, grep, etc.
|
(gnu services ssh)) ; for 'lsh-service'
|
||||||
(gnu packages bash) ; Bash
|
|
||||||
(gnu packages admin) ; dmd, Inetutils
|
|
||||||
(gnu packages zile) ; Zile
|
|
||||||
(gnu packages less) ; less
|
|
||||||
(gnu packages guile) ; Guile
|
|
||||||
(gnu packages linux)) ; procps, psmisc
|
|
||||||
|
|
||||||
(define komputilo
|
(define komputilo
|
||||||
(operating-system
|
(operating-system
|
||||||
|
|
@ -3130,7 +3128,7 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
|
||||||
(bootloader (grub-configuration
|
(bootloader (grub-configuration
|
||||||
(device "/dev/sda")))
|
(device "/dev/sda")))
|
||||||
(file-systems (list (file-system
|
(file-systems (list (file-system
|
||||||
(device "/dev/disk/by-label/root")
|
(device "/dev/sda1") ; or partition label
|
||||||
(mount-point "/")
|
(mount-point "/")
|
||||||
(type "ext3"))))
|
(type "ext3"))))
|
||||||
(users (list (user-account
|
(users (list (user-account
|
||||||
|
|
@ -3139,22 +3137,21 @@ Linux-Libre kernel, initial RAM disk, and boot loader looks like this:
|
||||||
(uid 1000) (gid 100)
|
(uid 1000) (gid 100)
|
||||||
(comment "Bob's sister")
|
(comment "Bob's sister")
|
||||||
(home-directory "/home/alice"))))
|
(home-directory "/home/alice"))))
|
||||||
(packages (list coreutils bash guile-2.0
|
(packages (cons emacs %base-packages))
|
||||||
guix dmd
|
|
||||||
inetutils
|
|
||||||
findutils grep sed
|
|
||||||
procps psmisc
|
|
||||||
zile less))
|
|
||||||
(services (cons (lsh-service #:port 2222 #:allow-root-login? #t)
|
(services (cons (lsh-service #:port 2222 #:allow-root-login? #t)
|
||||||
%base-services))))
|
%base-services))))
|
||||||
@end lisp
|
@end lisp
|
||||||
|
|
||||||
This example should be self-describing. The @code{packages} field lists
|
This example should be self-describing. The @code{packages} field lists
|
||||||
packages provided by the various @code{(gnu packages ...)} modules above
|
packages that will be globally visible on the system, for all user
|
||||||
(@pxref{Package Modules}). These are the packages that will be globally
|
accounts---i.e., in every user's @code{PATH} environment variable---in
|
||||||
visible on the system, for all user accounts---i.e., in every user's
|
addition to the per-user profiles (@pxref{Invoking guix package}). The
|
||||||
@code{PATH} environment variable---in addition to the per-user profiles
|
@var{%base-packages} variables provides all the tools one would expect
|
||||||
(@pxref{Invoking guix package}).
|
for basic user and administrator tasks---including the GNU Core
|
||||||
|
Utilities, the GNU Networking Utilities, the GNU Zile lightweight text
|
||||||
|
editor, @command{find}, @command{grep}, etc. The example above adds
|
||||||
|
Emacs to those, taken from the @code{(gnu packages emacs)} module
|
||||||
|
(@pxref{Package Modules}).
|
||||||
|
|
||||||
@vindex %base-services
|
@vindex %base-services
|
||||||
The @code{services} field lists @dfn{system services} to be made
|
The @code{services} field lists @dfn{system services} to be made
|
||||||
|
|
|
||||||
|
|
@ -62,15 +62,14 @@ GNU_SYSTEM_MODULES = \
|
||||||
gnu/packages/cyrus-sasl.scm \
|
gnu/packages/cyrus-sasl.scm \
|
||||||
gnu/packages/dc.scm \
|
gnu/packages/dc.scm \
|
||||||
gnu/packages/dejagnu.scm \
|
gnu/packages/dejagnu.scm \
|
||||||
gnu/packages/ddrescue.scm \
|
|
||||||
gnu/packages/dictionaries.scm \
|
gnu/packages/dictionaries.scm \
|
||||||
|
gnu/packages/disk.scm \
|
||||||
gnu/packages/docbook.scm \
|
gnu/packages/docbook.scm \
|
||||||
gnu/packages/doxygen.scm \
|
gnu/packages/doxygen.scm \
|
||||||
gnu/packages/dwm.scm \
|
gnu/packages/dwm.scm \
|
||||||
gnu/packages/ed.scm \
|
gnu/packages/ed.scm \
|
||||||
gnu/packages/elf.scm \
|
gnu/packages/elf.scm \
|
||||||
gnu/packages/emacs.scm \
|
gnu/packages/emacs.scm \
|
||||||
gnu/packages/fdisk.scm \
|
|
||||||
gnu/packages/file.scm \
|
gnu/packages/file.scm \
|
||||||
gnu/packages/flex.scm \
|
gnu/packages/flex.scm \
|
||||||
gnu/packages/fltk.scm \
|
gnu/packages/fltk.scm \
|
||||||
|
|
@ -177,7 +176,6 @@ GNU_SYSTEM_MODULES = \
|
||||||
gnu/packages/openssl.scm \
|
gnu/packages/openssl.scm \
|
||||||
gnu/packages/package-management.scm \
|
gnu/packages/package-management.scm \
|
||||||
gnu/packages/parallel.scm \
|
gnu/packages/parallel.scm \
|
||||||
gnu/packages/parted.scm \
|
|
||||||
gnu/packages/patchutils.scm \
|
gnu/packages/patchutils.scm \
|
||||||
gnu/packages/pciutils.scm \
|
gnu/packages/pciutils.scm \
|
||||||
gnu/packages/pcre.scm \
|
gnu/packages/pcre.scm \
|
||||||
|
|
@ -256,6 +254,7 @@ GNU_SYSTEM_MODULES = \
|
||||||
gnu/system.scm \
|
gnu/system.scm \
|
||||||
gnu/system/file-systems.scm \
|
gnu/system/file-systems.scm \
|
||||||
gnu/system/grub.scm \
|
gnu/system/grub.scm \
|
||||||
|
gnu/system/install.scm \
|
||||||
gnu/system/linux.scm \
|
gnu/system/linux.scm \
|
||||||
gnu/system/linux-initrd.scm \
|
gnu/system/linux-initrd.scm \
|
||||||
gnu/system/shadow.scm \
|
gnu/system/shadow.scm \
|
||||||
|
|
@ -279,6 +278,8 @@ dist_patch_DATA = \
|
||||||
gnu/packages/patches/coreutils-dummy-man.patch \
|
gnu/packages/patches/coreutils-dummy-man.patch \
|
||||||
gnu/packages/patches/coreutils-skip-nohup.patch \
|
gnu/packages/patches/coreutils-skip-nohup.patch \
|
||||||
gnu/packages/patches/cpio-gets-undeclared.patch \
|
gnu/packages/patches/cpio-gets-undeclared.patch \
|
||||||
|
gnu/packages/patches/cssc-gets-undeclared.patch \
|
||||||
|
gnu/packages/patches/cssc-missing-include.patch \
|
||||||
gnu/packages/patches/curl-fix-test172.patch \
|
gnu/packages/patches/curl-fix-test172.patch \
|
||||||
gnu/packages/patches/dbus-localstatedir.patch \
|
gnu/packages/patches/dbus-localstatedir.patch \
|
||||||
gnu/packages/patches/diffutils-gets-undeclared.patch \
|
gnu/packages/patches/diffutils-gets-undeclared.patch \
|
||||||
|
|
@ -311,7 +312,6 @@ dist_patch_DATA = \
|
||||||
gnu/packages/patches/guile-relocatable.patch \
|
gnu/packages/patches/guile-relocatable.patch \
|
||||||
gnu/packages/patches/guix-test-networking.patch \
|
gnu/packages/patches/guix-test-networking.patch \
|
||||||
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
|
gnu/packages/patches/gtkglext-disable-disable-deprecated.patch \
|
||||||
gnu/packages/patches/gtkglext-remove-pangox-dependency.patch \
|
|
||||||
gnu/packages/patches/hop-bigloo-4.0b.patch \
|
gnu/packages/patches/hop-bigloo-4.0b.patch \
|
||||||
gnu/packages/patches/inkscape-stray-comma.patch \
|
gnu/packages/patches/inkscape-stray-comma.patch \
|
||||||
gnu/packages/patches/libevent-dns-tests.patch \
|
gnu/packages/patches/libevent-dns-tests.patch \
|
||||||
|
|
@ -331,8 +331,7 @@ dist_patch_DATA = \
|
||||||
gnu/packages/patches/mhash-keygen-test-segfault.patch \
|
gnu/packages/patches/mhash-keygen-test-segfault.patch \
|
||||||
gnu/packages/patches/mit-krb5-init-fix.patch \
|
gnu/packages/patches/mit-krb5-init-fix.patch \
|
||||||
gnu/packages/patches/mpc123-initialize-ao.patch \
|
gnu/packages/patches/mpc123-initialize-ao.patch \
|
||||||
gnu/packages/patches/openssl-CVE-2010-5298.patch \
|
gnu/packages/patches/module-init-tools-moduledir.patch \
|
||||||
gnu/packages/patches/openssl-extension-checking-fixes.patch \
|
|
||||||
gnu/packages/patches/patchelf-page-size.patch \
|
gnu/packages/patches/patchelf-page-size.patch \
|
||||||
gnu/packages/patches/patchutils-xfail-gendiff-tests.patch \
|
gnu/packages/patches/patchutils-xfail-gendiff-tests.patch \
|
||||||
gnu/packages/patches/perl-no-sys-dirs.patch \
|
gnu/packages/patches/perl-no-sys-dirs.patch \
|
||||||
|
|
@ -359,6 +358,7 @@ dist_patch_DATA = \
|
||||||
gnu/packages/patches/superlu-dist-scotchmetis.patch \
|
gnu/packages/patches/superlu-dist-scotchmetis.patch \
|
||||||
gnu/packages/patches/tcsh-fix-autotest.patch \
|
gnu/packages/patches/tcsh-fix-autotest.patch \
|
||||||
gnu/packages/patches/teckit-cstdio.patch \
|
gnu/packages/patches/teckit-cstdio.patch \
|
||||||
|
gnu/packages/patches/util-linux-perl.patch \
|
||||||
gnu/packages/patches/valgrind-glibc.patch \
|
gnu/packages/patches/valgrind-glibc.patch \
|
||||||
gnu/packages/patches/vpnc-script.patch \
|
gnu/packages/patches/vpnc-script.patch \
|
||||||
gnu/packages/patches/w3m-fix-compile.patch \
|
gnu/packages/patches/w3m-fix-compile.patch \
|
||||||
|
|
|
||||||
|
|
@ -722,3 +722,41 @@ This package provides the 'wpa_supplicant' daemon and the 'wpa_cli' command.")
|
||||||
|
|
||||||
;; In practice, this is linked against Readline, which makes it GPLv3+.
|
;; In practice, this is linked against Readline, which makes it GPLv3+.
|
||||||
(license bsd-3)))
|
(license bsd-3)))
|
||||||
|
|
||||||
|
(define-public wakelan
|
||||||
|
(package
|
||||||
|
(name "wakelan")
|
||||||
|
(version "1.1")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append
|
||||||
|
"ftp://ftp.gwdg.de/pub/linux/metalab/system/network/misc/wakelan-"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0vydqpf44146ir6k87gmqaq6xy66xhc1gkr3nsd7jj3nhy7ypx9x"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(arguments
|
||||||
|
'(#:phases (alist-replace
|
||||||
|
'configure
|
||||||
|
(lambda* (#:key outputs #:allow-other-keys)
|
||||||
|
(let ((out (assoc-ref outputs "out")))
|
||||||
|
(mkdir-p (string-append out "/bin"))
|
||||||
|
(mkdir-p (string-append out "/share/man/man1"))
|
||||||
|
|
||||||
|
;; It's an old configure script that doesn't understand
|
||||||
|
;; the extra options we pass.
|
||||||
|
(setenv "CONFIG_SHELL" (which "bash"))
|
||||||
|
(zero?
|
||||||
|
(system* "./configure"
|
||||||
|
(string-append "--prefix=" out)
|
||||||
|
(string-append "--mandir=" out
|
||||||
|
"/share/man")))))
|
||||||
|
%standard-phases)
|
||||||
|
#:tests? #f))
|
||||||
|
(home-page "http://kernel.org") ; really, no home page
|
||||||
|
(synopsis "Send a wake-on-LAN packet")
|
||||||
|
(description
|
||||||
|
"WakeLan broadcasts a properly formatted UDP packet across the local area
|
||||||
|
network, which causes enabled computers to power on.")
|
||||||
|
(license gpl2+)))
|
||||||
|
|
|
||||||
|
|
@ -18,13 +18,25 @@
|
||||||
|
|
||||||
(define-module (gnu packages backup)
|
(define-module (gnu packages backup)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix licenses)
|
#:use-module ((guix licenses)
|
||||||
|
#:renamer (symbol-prefix-proc 'license:))
|
||||||
#:use-module (guix download)
|
#:use-module (guix download)
|
||||||
|
#:use-module (guix build-system gnu)
|
||||||
#:use-module (guix build-system python)
|
#:use-module (guix build-system python)
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:use-module (gnu packages python)
|
#:use-module (gnu packages base)
|
||||||
|
#:use-module (gnu packages compression)
|
||||||
|
#:use-module (gnu packages dejagnu)
|
||||||
|
#:use-module (gnu packages glib)
|
||||||
#:use-module (gnu packages gnupg)
|
#:use-module (gnu packages gnupg)
|
||||||
|
#:use-module (gnu packages mcrypt)
|
||||||
|
#:use-module (gnu packages nettle)
|
||||||
|
#:use-module (gnu packages pcre)
|
||||||
|
#:use-module (gnu packages python)
|
||||||
|
#:use-module (gnu packages pkg-config)
|
||||||
#:use-module (gnu packages rsync)
|
#:use-module (gnu packages rsync)
|
||||||
|
#:use-module (gnu packages ssh)
|
||||||
|
#:use-module (gnu packages xml)
|
||||||
#:use-module (srfi srfi-1))
|
#:use-module (srfi srfi-1))
|
||||||
|
|
||||||
(define-public duplicity
|
(define-public duplicity
|
||||||
|
|
@ -68,4 +80,200 @@ librsync, the incremental archives are space efficient and only record the
|
||||||
parts of files that have changed since the last backup. Because duplicity
|
parts of files that have changed since the last backup. Because duplicity
|
||||||
uses GnuPG to encrypt and/or sign these archives, they will be safe from
|
uses GnuPG to encrypt and/or sign these archives, they will be safe from
|
||||||
spying and/or modification by the server.")
|
spying and/or modification by the server.")
|
||||||
(license gpl2+)))
|
(license license:gpl2+)))
|
||||||
|
|
||||||
|
(define-public hdup
|
||||||
|
(package
|
||||||
|
(name "hdup")
|
||||||
|
(version "2.0.14")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
;; Source tarballs are not versioned
|
||||||
|
(uri "http://archive.miek.nl/projects/hdup2/hdup.tar.bz2")
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"02bnczg01cyhajmm4rhbnc0ja0dd9ikv9fwv28asxh1rlx9yr0b7"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||||
|
(inputs
|
||||||
|
`(("glib" ,glib)
|
||||||
|
("tar" ,tar)
|
||||||
|
("lzop" ,lzop)
|
||||||
|
("mcrypt" ,mcrypt)
|
||||||
|
("openssh" ,openssh)
|
||||||
|
("gnupg" ,gnupg-1)))
|
||||||
|
(arguments
|
||||||
|
`(#:configure-flags
|
||||||
|
`(,(string-append "--sbindir=" (assoc-ref %outputs "out") "/bin"))
|
||||||
|
#:tests? #f))
|
||||||
|
(home-page "http://archive.miek.nl/projects/hdup/index.html")
|
||||||
|
(synopsis "Simple incremental backup tool")
|
||||||
|
(description
|
||||||
|
"Hdup2 is a backup utilty, its aim is to make backup really simple. The
|
||||||
|
backup scheduling is done by means of a cron job. It supports an
|
||||||
|
include/exclude mechanism, remote backups, encrypted backups and split
|
||||||
|
backups (called chunks) to allow easy burning to CD/DVD.")
|
||||||
|
(license license:gpl2)))
|
||||||
|
|
||||||
|
(define-public libarchive
|
||||||
|
(package
|
||||||
|
(name "libarchive")
|
||||||
|
(version "3.1.2")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "http://libarchive.org/downloads/libarchive-"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0pixqnrcf35dnqgv0lp7qlcw7k13620qkhgxr288v7p4iz6ym1zb"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(inputs
|
||||||
|
`(("zlib" ,zlib)
|
||||||
|
("nettle" ,nettle)
|
||||||
|
("lzo" ,lzo)
|
||||||
|
("bzip2" ,bzip2)
|
||||||
|
("libxml2" ,libxml2)
|
||||||
|
("xz" ,xz)))
|
||||||
|
(arguments
|
||||||
|
`(#:phases
|
||||||
|
(alist-cons-before
|
||||||
|
'build 'patch-pwd
|
||||||
|
(lambda _
|
||||||
|
(substitute* "Makefile"
|
||||||
|
(("/bin/pwd") (which "pwd"))))
|
||||||
|
(alist-replace
|
||||||
|
'check
|
||||||
|
(lambda _
|
||||||
|
;; XXX: The test_owner_parse, test_read_disk, and
|
||||||
|
;; test_write_disk_lookup tests expect user 'root' to exist, but
|
||||||
|
;; the chroot's /etc/passwd doesn't have it. Turn off those tests.
|
||||||
|
;;
|
||||||
|
;; The tests allow one to disable tests matching a globbing pattern.
|
||||||
|
(and (zero? (system* "make"
|
||||||
|
"libarchive_test" "bsdcpio_test" "bsdtar_test"))
|
||||||
|
;; XXX: This glob disables too much.
|
||||||
|
(zero? (system* "./libarchive_test" "^test_*_disk*"))
|
||||||
|
(zero? (system* "./bsdcpio_test" "^test_owner_parse"))
|
||||||
|
(zero? (system* "./bsdtar_test"))))
|
||||||
|
%standard-phases))))
|
||||||
|
(home-page "http://libarchive.org/")
|
||||||
|
(synopsis "Multi-format archive and compression library")
|
||||||
|
(description
|
||||||
|
"Libarchive provides a flexible interface for reading and writing
|
||||||
|
archives in various formats such as tar and cpio. Libarchive also supports
|
||||||
|
reading and writing archives compressed using various compression filters such
|
||||||
|
as gzip and bzip2. The library is inherently stream-oriented; readers
|
||||||
|
serially iterate through the archive, writers serially add things to the
|
||||||
|
archive. In particular, note that there is currently no built-in support for
|
||||||
|
random access nor for in-place modification.")
|
||||||
|
(license license:bsd-2)))
|
||||||
|
|
||||||
|
(define-public rdup
|
||||||
|
(package
|
||||||
|
(name "rdup")
|
||||||
|
(version "1.1.14")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "http://archive.miek.nl/projects/rdup/rdup-"
|
||||||
|
version ".tar.bz2"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0aklwd9v7ix0m4ayl762sil685f42cwljzx3jz5skrnjaq32npmj"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(native-inputs
|
||||||
|
`(("pkg-config" ,pkg-config)
|
||||||
|
("dejagnu" ,dejagnu)))
|
||||||
|
(inputs
|
||||||
|
`(("glib" ,glib)
|
||||||
|
("pcre" ,pcre)
|
||||||
|
("libarchive" ,libarchive)
|
||||||
|
("nettle" ,nettle)))
|
||||||
|
(arguments
|
||||||
|
`(#:parallel-build? #f ;race conditions
|
||||||
|
#:phases (alist-cons-before
|
||||||
|
'build 'remove-Werror
|
||||||
|
;; rdup uses a deprecated function from libarchive
|
||||||
|
(lambda _
|
||||||
|
(substitute* "GNUmakefile"
|
||||||
|
(("^(CFLAGS=.*)-Werror" _ front) front)))
|
||||||
|
%standard-phases)))
|
||||||
|
(home-page "http://archive.miek.nl/projects/rdup/index.html")
|
||||||
|
(synopsis "Provide a list of files to backup")
|
||||||
|
(description
|
||||||
|
"Rdup is a utility inspired by rsync and the plan9 way of doing backups.
|
||||||
|
Rdup itself does not backup anything, it only print a list of absolute
|
||||||
|
filenames to standard output. Auxiliary scripts are needed that act on this
|
||||||
|
list and implement the backup strategy.")
|
||||||
|
(license license:gpl3+)))
|
||||||
|
|
||||||
|
(define-public btar
|
||||||
|
(package
|
||||||
|
(name "btar")
|
||||||
|
(version "1.1.1")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "http://vicerveza.homeunix.net/~viric/soft/btar/"
|
||||||
|
"btar-" version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0miklk4bqblpyzh1bni4x6lqn88fa8fjn15x1k1n8bxkx60nlymd"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(inputs
|
||||||
|
`(("librsync" ,librsync)))
|
||||||
|
(arguments
|
||||||
|
`(#:make-flags `(,(string-append "PREFIX=" (assoc-ref %outputs "out"))
|
||||||
|
"CC=gcc")
|
||||||
|
#:tests? #f ;test input not distributed
|
||||||
|
#:phases
|
||||||
|
(alist-delete
|
||||||
|
'configure ;no configure phase
|
||||||
|
%standard-phases)))
|
||||||
|
(home-page "http://viric.name/cgi-bin/btar/doc/trunk/doc/home.wiki")
|
||||||
|
(synopsis "Tar-compatible archiver")
|
||||||
|
(description
|
||||||
|
"Btar is a tar-compatible archiver which allows arbitrary compression and
|
||||||
|
ciphering, redundancy, differential backup, indexed extraction, multicore
|
||||||
|
compression, input and output serialisation, and tolerance to partial archive
|
||||||
|
errors.")
|
||||||
|
(license license:gpl3+)))
|
||||||
|
|
||||||
|
(define-public rdiff-backup
|
||||||
|
(package
|
||||||
|
(name "rdiff-backup")
|
||||||
|
(version "1.2.8")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://savannah/rdiff-backup/rdiff-backup-"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"1nwmmh816f96h0ff1jxk95ad38ilbhbdl5dgibx1d4cl81dsi48d"))))
|
||||||
|
(build-system python-build-system)
|
||||||
|
(native-inputs
|
||||||
|
`(("python2-setuptools" ,python2-setuptools)))
|
||||||
|
(inputs
|
||||||
|
`(("python" ,python-2)
|
||||||
|
("librsync" ,librsync)))
|
||||||
|
(arguments
|
||||||
|
`(#:python ,python-2
|
||||||
|
#:tests? #f))
|
||||||
|
(home-page "http://www.nongnu.org/rdiff-backup/")
|
||||||
|
(synopsis "Local/remote mirroring+incremental backup")
|
||||||
|
(description
|
||||||
|
"Rdiff-backup backs up one directory to another, possibly over a network.
|
||||||
|
The target directory ends up a copy of the source directory, but extra reverse
|
||||||
|
diffs are stored in a special subdirectory of that target directory, so you
|
||||||
|
can still recover files lost some time ago. The idea is to combine the best
|
||||||
|
features of a mirror and an incremental backup. Rdiff-backup also preserves
|
||||||
|
subdirectories, hard links, dev files, permissions, uid/gid ownership,
|
||||||
|
modification times, extended attributes, acls, and resource forks. Also,
|
||||||
|
rdiff-backup can operate in a bandwidth efficient manner over a pipe, like
|
||||||
|
rsync. Thus you can use rdiff-backup and ssh to securely back a hard drive up
|
||||||
|
to a remote location, and only the differences will be transmitted. Finally,
|
||||||
|
rdiff-backup is easy to use and settings have sensical defaults.")
|
||||||
|
(license license:gpl2+)))
|
||||||
|
|
|
||||||
|
|
@ -976,6 +976,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
|
||||||
;; The final GCC.
|
;; The final GCC.
|
||||||
(package (inherit gcc-boot0)
|
(package (inherit gcc-boot0)
|
||||||
(name "gcc")
|
(name "gcc")
|
||||||
|
(location (source-properties->location (current-source-location)))
|
||||||
(arguments
|
(arguments
|
||||||
`(#:guile ,%bootstrap-guile
|
`(#:guile ,%bootstrap-guile
|
||||||
#:implicit-inputs? #f
|
#:implicit-inputs? #f
|
||||||
|
|
|
||||||
|
|
@ -34,13 +34,21 @@
|
||||||
(sha256 (base32
|
(sha256 (base32
|
||||||
"1f2g2612lf8djbwbwhxsvmffmf9d7693kh2l20195pqp0f9jmnfx"))))
|
"1f2g2612lf8djbwbwhxsvmffmf9d7693kh2l20195pqp0f9jmnfx"))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
|
(outputs '("out" ; programs, libraries, headers
|
||||||
|
"doc")) ; 94 MiB of HTML docs
|
||||||
(arguments
|
(arguments
|
||||||
'(#:tests? #f ; no check target available
|
'(#:tests? #f ; no check target available
|
||||||
#:phases
|
#:phases
|
||||||
(alist-replace
|
(alist-replace
|
||||||
'configure
|
'configure
|
||||||
(lambda* (#:key outputs #:allow-other-keys)
|
(lambda* (#:key outputs #:allow-other-keys)
|
||||||
(let ((out (assoc-ref outputs "out")))
|
(let ((out (assoc-ref outputs "out"))
|
||||||
|
(doc (assoc-ref outputs "doc")))
|
||||||
|
;; '--docdir' is not honored, so we need to patch.
|
||||||
|
(substitute* "dist/Makefile.in"
|
||||||
|
(("docdir[[:blank:]]*=.*")
|
||||||
|
(string-append "docdir = " doc "/share/doc/bdb")))
|
||||||
|
|
||||||
(zero?
|
(zero?
|
||||||
(system* "./dist/configure"
|
(system* "./dist/configure"
|
||||||
(string-append "--prefix=" out)
|
(string-append "--prefix=" out)
|
||||||
|
|
|
||||||
|
|
@ -315,3 +315,4 @@ archives that can be readily emailed. A shell archive is a file that can be
|
||||||
processed by a Bourne-type shell to unpack the original collection of files.
|
processed by a Bourne-type shell to unpack the original collection of files.
|
||||||
This package is mostly for compatibility and historical interest.")
|
This package is mostly for compatibility and historical interest.")
|
||||||
(license license:gpl3+)))
|
(license license:gpl3+)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,47 +0,0 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
|
||||||
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
|
||||||
;;;
|
|
||||||
;;; This file is part of GNU Guix.
|
|
||||||
;;;
|
|
||||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
|
||||||
;;; under the terms of the GNU General Public License as published by
|
|
||||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
||||||
;;; your option) any later version.
|
|
||||||
;;;
|
|
||||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
|
||||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
;;; GNU General Public License for more details.
|
|
||||||
;;;
|
|
||||||
;;; You should have received a copy of the GNU General Public License
|
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
(define-module (gnu packages ddrescue)
|
|
||||||
#:use-module (guix licenses)
|
|
||||||
#:use-module (guix packages)
|
|
||||||
#:use-module (guix download)
|
|
||||||
#:use-module (guix build-system gnu)
|
|
||||||
#:use-module ((gnu packages compression) #:select (lzip)))
|
|
||||||
|
|
||||||
(define-public ddrescue
|
|
||||||
(package
|
|
||||||
(name "ddrescue")
|
|
||||||
(version "1.17")
|
|
||||||
(source
|
|
||||||
(origin
|
|
||||||
(method url-fetch)
|
|
||||||
(uri (string-append "mirror://gnu/ddrescue/ddrescue-"
|
|
||||||
version ".tar.lz"))
|
|
||||||
(sha256
|
|
||||||
(base32
|
|
||||||
"0bvmsbzli2j4czwkabzs978n1y6vx31axh02kpgcf7033cc6rydy"))))
|
|
||||||
(build-system gnu-build-system)
|
|
||||||
(home-page "http://www.gnu.org/software/ddrescue/ddrescue.html")
|
|
||||||
(synopsis "Data recovery utility")
|
|
||||||
(native-inputs `(("lzip" ,lzip)))
|
|
||||||
(description
|
|
||||||
"GNU ddrescue is a fully automated data recovery tool. It copies data
|
|
||||||
from one file to another, working to rescue data in case of read errors. The
|
|
||||||
program also includes a tool for manipulating its log files, which are used
|
|
||||||
to recover data more efficiently by only reading the necessary blocks.")
|
|
||||||
(license gpl3+)))
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
;;; Copyright © 2012, 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -16,7 +16,7 @@
|
||||||
;;; You should have received a copy of the GNU General Public License
|
;;; You should have received a copy of the GNU General Public License
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gnu packages parted)
|
(define-module (gnu packages disk)
|
||||||
#:use-module (guix licenses)
|
#:use-module (guix licenses)
|
||||||
#:use-module (guix packages)
|
#:use-module (guix packages)
|
||||||
#:use-module (guix download)
|
#:use-module (guix download)
|
||||||
|
|
@ -24,7 +24,10 @@
|
||||||
#:use-module (gnu packages check)
|
#:use-module (gnu packages check)
|
||||||
#:use-module (gnu packages gettext)
|
#:use-module (gnu packages gettext)
|
||||||
#:use-module (gnu packages linux)
|
#:use-module (gnu packages linux)
|
||||||
#:use-module (gnu packages readline))
|
#:use-module (gnu packages readline)
|
||||||
|
#:use-module (gnu packages guile)
|
||||||
|
#:use-module ((gnu packages compression)
|
||||||
|
#:select (lzip)))
|
||||||
|
|
||||||
(define-public parted
|
(define-public parted
|
||||||
(package
|
(package
|
||||||
|
|
@ -67,3 +70,52 @@
|
||||||
"GNU Parted is a package for creating and manipulating disk partition
|
"GNU Parted is a package for creating and manipulating disk partition
|
||||||
tables. It includes a library and command-line utility.")
|
tables. It includes a library and command-line utility.")
|
||||||
(license gpl3+)))
|
(license gpl3+)))
|
||||||
|
|
||||||
|
(define-public fdisk
|
||||||
|
(package
|
||||||
|
(name "fdisk")
|
||||||
|
(version "2.0.0a")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://gnu/fdisk/gnufdisk-"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"04nd7civ561x2lwcmxhsqbprml3178jfc58fy1v7hzqg5k4nbhy3"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(inputs
|
||||||
|
`(("gettext" ,gnu-gettext)
|
||||||
|
("guile" ,guile-1.8)
|
||||||
|
("util-linux" ,util-linux)
|
||||||
|
("parted" ,parted)))
|
||||||
|
(home-page "https://www.gnu.org/software/fdisk/")
|
||||||
|
(synopsis "Low-level disk partitioning and formatting")
|
||||||
|
(description
|
||||||
|
"GNU fdisk provides a GNU version of the common disk partitioning tool
|
||||||
|
fdisk. fdisk is used for the creation and manipulation of disk partition
|
||||||
|
tables, and it understands a variety of different formats.")
|
||||||
|
(license gpl3+)))
|
||||||
|
|
||||||
|
(define-public ddrescue
|
||||||
|
(package
|
||||||
|
(name "ddrescue")
|
||||||
|
(version "1.17")
|
||||||
|
(source
|
||||||
|
(origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://gnu/ddrescue/ddrescue-"
|
||||||
|
version ".tar.lz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0bvmsbzli2j4czwkabzs978n1y6vx31axh02kpgcf7033cc6rydy"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(home-page "http://www.gnu.org/software/ddrescue/ddrescue.html")
|
||||||
|
(synopsis "Data recovery utility")
|
||||||
|
(native-inputs `(("lzip" ,lzip)))
|
||||||
|
(description
|
||||||
|
"GNU ddrescue is a fully automated data recovery tool. It copies data
|
||||||
|
from one file to another, working to rescue data in case of read errors. The
|
||||||
|
program also includes a tool for manipulating its log files, which are used
|
||||||
|
to recover data more efficiently by only reading the necessary blocks.")
|
||||||
|
(license gpl3+)))
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -47,8 +47,11 @@
|
||||||
(native-inputs `(("m4" ,m4)))
|
(native-inputs `(("m4" ,m4)))
|
||||||
(inputs `(("zlib" ,zlib)))
|
(inputs `(("zlib" ,zlib)))
|
||||||
(home-page "https://fedorahosted.org/elfutils/")
|
(home-page "https://fedorahosted.org/elfutils/")
|
||||||
(synopsis #f)
|
(synopsis "Linker and ELF manipulation tools")
|
||||||
(description #f)
|
(description
|
||||||
|
"This package provides command-line tools to manipulate binaries in the
|
||||||
|
Executable and Linkable Format (ELF). This includes ld, ar, objdump,
|
||||||
|
addr2line, and more.")
|
||||||
|
|
||||||
;; Libraries are dual-licensed LGPLv3.0+ | GPLv2, and programs are GPLv3+.
|
;; Libraries are dual-licensed LGPLv3.0+ | GPLv2, and programs are GPLv3+.
|
||||||
(license lgpl3+)))
|
(license lgpl3+)))
|
||||||
|
|
|
||||||
|
|
@ -1,53 +0,0 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
|
||||||
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
|
||||||
;;;
|
|
||||||
;;; This file is part of GNU Guix.
|
|
||||||
;;;
|
|
||||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
|
||||||
;;; under the terms of the GNU General Public License as published by
|
|
||||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
|
||||||
;;; your option) any later version.
|
|
||||||
;;;
|
|
||||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
|
||||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
||||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
||||||
;;; GNU General Public License for more details.
|
|
||||||
;;;
|
|
||||||
;;; You should have received a copy of the GNU General Public License
|
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
|
||||||
|
|
||||||
(define-module (gnu packages fdisk)
|
|
||||||
#:use-module ((guix licenses) #:select (gpl3+))
|
|
||||||
#:use-module (gnu packages gettext)
|
|
||||||
#:use-module (gnu packages guile)
|
|
||||||
#:use-module (gnu packages linux)
|
|
||||||
#:use-module (gnu packages parted)
|
|
||||||
#:use-module (guix packages)
|
|
||||||
#:use-module (guix download)
|
|
||||||
#:use-module (guix build-system gnu))
|
|
||||||
|
|
||||||
(define-public fdisk
|
|
||||||
(package
|
|
||||||
(name "fdisk")
|
|
||||||
(version "2.0.0a")
|
|
||||||
(source
|
|
||||||
(origin
|
|
||||||
(method url-fetch)
|
|
||||||
(uri (string-append "mirror://gnu/fdisk/gnufdisk-"
|
|
||||||
version ".tar.gz"))
|
|
||||||
(sha256
|
|
||||||
(base32
|
|
||||||
"04nd7civ561x2lwcmxhsqbprml3178jfc58fy1v7hzqg5k4nbhy3"))))
|
|
||||||
(build-system gnu-build-system)
|
|
||||||
(inputs
|
|
||||||
`(("gettext" ,gnu-gettext)
|
|
||||||
("guile" ,guile-1.8)
|
|
||||||
("util-linux" ,util-linux)
|
|
||||||
("parted" ,parted)))
|
|
||||||
(home-page "https://www.gnu.org/software/fdisk/")
|
|
||||||
(synopsis "Low-level disk partitioning and formatting")
|
|
||||||
(description
|
|
||||||
"GNU fdisk provides a GNU version of the common disk partitioning tool
|
|
||||||
fdisk. fdisk is used for the creation and manipulation of disk partition
|
|
||||||
tables, and it understands a variety of different formats.")
|
|
||||||
(license gpl3+)))
|
|
||||||
|
|
@ -460,7 +460,6 @@ the API")
|
||||||
(sha256
|
(sha256
|
||||||
(base32 "1ya4d2j2aacr9ii5zj4ac95fjpdvlm2rg79mgnk7yvl1dcy3y1z5"))
|
(base32 "1ya4d2j2aacr9ii5zj4ac95fjpdvlm2rg79mgnk7yvl1dcy3y1z5"))
|
||||||
(patches (list
|
(patches (list
|
||||||
(search-patch "gtkglext-remove-pangox-dependency.patch")
|
|
||||||
(search-patch "gtkglext-disable-disable-deprecated.patch")))))
|
(search-patch "gtkglext-disable-disable-deprecated.patch")))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(inputs `(("gtk+" ,gtk+-2)
|
(inputs `(("gtk+" ,gtk+-2)
|
||||||
|
|
@ -468,6 +467,7 @@ the API")
|
||||||
("libx11" ,libx11)
|
("libx11" ,libx11)
|
||||||
("libxt" ,libxt)))
|
("libxt" ,libxt)))
|
||||||
(native-inputs `(("pkg-config" ,pkg-config)))
|
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||||
|
(propagated-inputs `(("pangox-compat" ,pangox-compat)))
|
||||||
(home-page "https://projects.gnome.org/gtkglext")
|
(home-page "https://projects.gnome.org/gtkglext")
|
||||||
(synopsis "OpenGL extension to GTK+.")
|
(synopsis "OpenGL extension to GTK+.")
|
||||||
(description "GtkGLExt is an OpenGL extension to GTK+. It provides
|
(description "GtkGLExt is an OpenGL extension to GTK+. It provides
|
||||||
|
|
@ -837,7 +837,8 @@ allows applications to access local and remote files with a single consistent AP
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append
|
(uri (string-append
|
||||||
"mirror://gnome/sources/" name "/" (string-take version 3) "/" name "-"
|
"mirror://gnome/sources/" name "/"
|
||||||
|
(string-take version 4) "/" name "-"
|
||||||
version
|
version
|
||||||
".tar.bz2"))
|
".tar.bz2"))
|
||||||
(sha256
|
(sha256
|
||||||
|
|
|
||||||
|
|
@ -63,7 +63,7 @@ specifications.")
|
||||||
(define-public gnutls
|
(define-public gnutls
|
||||||
(package
|
(package
|
||||||
(name "gnutls")
|
(name "gnutls")
|
||||||
(version "3.2.12")
|
(version "3.2.15")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri
|
(uri
|
||||||
|
|
@ -75,7 +75,7 @@ specifications.")
|
||||||
"/gnutls-" version ".tar.xz"))
|
"/gnutls-" version ".tar.xz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0195nliarszq5mginli6d2f5z7ljnd7mwa46iy9z8pkcgy56khbl"))))
|
"1fbpr9r1r2y803s3avwjpy1higqsz85dyb302kvmh0i29frwgg9h"))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(arguments
|
(arguments
|
||||||
;; Work around build issue reported at
|
;; Work around build issue reported at
|
||||||
|
|
|
||||||
|
|
@ -34,6 +34,7 @@
|
||||||
#:use-module (gnu packages python)
|
#:use-module (gnu packages python)
|
||||||
#:use-module (gnu packages algebra)
|
#:use-module (gnu packages algebra)
|
||||||
#:use-module (gnu packages gettext)
|
#:use-module (gnu packages gettext)
|
||||||
|
#:use-module (gnu packages glib)
|
||||||
#:use-module (gnu packages pulseaudio)
|
#:use-module (gnu packages pulseaudio)
|
||||||
#:use-module (gnu packages attr)
|
#:use-module (gnu packages attr)
|
||||||
#:use-module (gnu packages xml)
|
#:use-module (gnu packages xml)
|
||||||
|
|
@ -132,7 +133,9 @@
|
||||||
version ".tar.bz2"))
|
version ".tar.bz2"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0jxnz9ahfic79rp93l5wxcbgh4pkv85mwnjlbv1gz3jawv5cvwp1"))))
|
"0jxnz9ahfic79rp93l5wxcbgh4pkv85mwnjlbv1gz3jawv5cvwp1"))
|
||||||
|
(patches
|
||||||
|
(list (search-patch "module-init-tools-moduledir.patch")))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(arguments
|
(arguments
|
||||||
;; FIXME: The upstream tarball lacks man pages, and building them would
|
;; FIXME: The upstream tarball lacks man pages, and building them would
|
||||||
|
|
@ -181,7 +184,8 @@
|
||||||
"CONFIG_VIRTIO_MMIO=m\n"
|
"CONFIG_VIRTIO_MMIO=m\n"
|
||||||
"CONFIG_FUSE_FS=m\n"
|
"CONFIG_FUSE_FS=m\n"
|
||||||
"CONFIG_CIFS=m\n"
|
"CONFIG_CIFS=m\n"
|
||||||
"CONFIG_9P_FS=m\n")
|
"CONFIG_9P_FS=m\n"
|
||||||
|
"CONFIG_E1000E=m\n")
|
||||||
port)
|
port)
|
||||||
(close-port port))
|
(close-port port))
|
||||||
|
|
||||||
|
|
@ -316,15 +320,15 @@ providing the system administrator with some help in common tasks.")
|
||||||
(package
|
(package
|
||||||
(name "util-linux")
|
(name "util-linux")
|
||||||
(version "2.21")
|
(version "2.21")
|
||||||
(source
|
(source (origin
|
||||||
(origin
|
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "mirror://kernel.org/linux/utils/"
|
(uri (string-append "mirror://kernel.org/linux/utils/"
|
||||||
name "/v" version "/"
|
name "/v" version "/"
|
||||||
name "-" version ".2" ".tar.xz"))
|
name "-" version ".2" ".tar.xz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"1rpgghf7n0zx0cdy8hibr41wvkm2qp1yvd8ab1rxr193l1jmgcir"))))
|
"1rpgghf7n0zx0cdy8hibr41wvkm2qp1yvd8ab1rxr193l1jmgcir"))
|
||||||
|
(patches (list (search-patch "util-linux-perl.patch")))))
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(arguments
|
(arguments
|
||||||
`(#:configure-flags '("--disable-use-tty-group"
|
`(#:configure-flags '("--disable-use-tty-group"
|
||||||
|
|
@ -961,7 +965,15 @@ processes currently causing I/O.")
|
||||||
"/bin/" maybe-u "mount")))
|
"/bin/" maybe-u "mount")))
|
||||||
(substitute* '("util/mount.fuse.c")
|
(substitute* '("util/mount.fuse.c")
|
||||||
(("/bin/sh")
|
(("/bin/sh")
|
||||||
(which "sh"))))
|
(which "sh")))
|
||||||
|
|
||||||
|
;; This hack leads libfuse to search for 'fusermount' in
|
||||||
|
;; $PATH, where it may find a setuid-root binary, instead of
|
||||||
|
;; trying solely $out/sbin/fusermount and failing because
|
||||||
|
;; it's not setuid.
|
||||||
|
(substitute* "lib/Makefile"
|
||||||
|
(("-DFUSERMOUNT_DIR=[[:graph:]]+")
|
||||||
|
"-DFUSERMOUNT_DIR=\\\"/var/empty\\\"")))
|
||||||
%standard-phases)))
|
%standard-phases)))
|
||||||
(home-page "http://fuse.sourceforge.net/")
|
(home-page "http://fuse.sourceforge.net/")
|
||||||
(synopsis "Support file systems implemented in user space")
|
(synopsis "Support file systems implemented in user space")
|
||||||
|
|
@ -1033,6 +1045,32 @@ UnionFS-FUSE additionally supports copy-on-write.")
|
||||||
#:configure-flags '("-DCMAKE_EXE_LINKER_FLAGS=-static")))
|
#:configure-flags '("-DCMAKE_EXE_LINKER_FLAGS=-static")))
|
||||||
(inputs `(("fuse" ,fuse-static)))))
|
(inputs `(("fuse" ,fuse-static)))))
|
||||||
|
|
||||||
|
(define-public sshfs-fuse
|
||||||
|
(package
|
||||||
|
(name "sshfs-fuse")
|
||||||
|
(version "2.5")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://sourceforge/fuse/sshfs-fuse-"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0gp6qr33l2p0964j0kds0dfmvyyf5lpgsn11daf0n5fhwm9185z9"))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(inputs
|
||||||
|
`(("fuse" ,fuse)
|
||||||
|
("glib" ,glib)))
|
||||||
|
(native-inputs
|
||||||
|
`(("pkg-config" ,pkg-config)))
|
||||||
|
(home-page "http://fuse.sourceforge.net/sshfs.html")
|
||||||
|
(synopsis "Mount remote file systems over SSH")
|
||||||
|
(description
|
||||||
|
"This is a file system client based on the SSH File Transfer Protocol.
|
||||||
|
Since most SSH servers already support this protocol it is very easy to set
|
||||||
|
up: on the server side there's nothing to do; on the client side mounting the
|
||||||
|
file system is as easy as logging into the server with an SSH client.")
|
||||||
|
(license gpl2+)))
|
||||||
|
|
||||||
(define-public numactl
|
(define-public numactl
|
||||||
(package
|
(package
|
||||||
(name "numactl")
|
(name "numactl")
|
||||||
|
|
|
||||||
|
|
@ -253,7 +253,8 @@ plotting engine by third-party applications like Octave.")
|
||||||
(source
|
(source
|
||||||
(origin
|
(origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "http://www.hdfgroup.org/ftp/HDF5/current/src/hdf5-"
|
(uri (string-append "http://www.hdfgroup.org/ftp/HDF5/releases/hdf5-"
|
||||||
|
version "/src/hdf5-"
|
||||||
version ".tar.bz2"))
|
version ".tar.bz2"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32 "0f9n0v3p3lwc7564791a39c6cn1d3dbrn7d1j3ikqsi27a8hy23d"))))
|
(base32 "0f9n0v3p3lwc7564791a39c6cn1d3dbrn7d1j3ikqsi27a8hy23d"))))
|
||||||
|
|
|
||||||
|
|
@ -28,17 +28,14 @@
|
||||||
(define-public openssl
|
(define-public openssl
|
||||||
(package
|
(package
|
||||||
(name "openssl")
|
(name "openssl")
|
||||||
(version "1.0.1g")
|
(version "1.0.1h")
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
(uri (string-append "ftp://ftp.openssl.org/source/openssl-" version
|
(uri (string-append "ftp://ftp.openssl.org/source/openssl-" version
|
||||||
".tar.gz"))
|
".tar.gz"))
|
||||||
(sha256
|
(sha256
|
||||||
(base32
|
(base32
|
||||||
"0a70qdqccg16nw4bbawa6pjvzn05vfp5wkwg6jl0grch7f683jsk"))
|
"14yhsgag5as7nhxnw7f0vklwjwa3pmn1i15nmp3f4qxa6sc8l74x"))))
|
||||||
(patches
|
|
||||||
(list (search-patch "openssl-CVE-2010-5298.patch")
|
|
||||||
(search-patch "openssl-extension-checking-fixes.patch")))))
|
|
||||||
(build-system gnu-build-system)
|
(build-system gnu-build-system)
|
||||||
(native-inputs `(("perl" ,perl)))
|
(native-inputs `(("perl" ,perl)))
|
||||||
(arguments
|
(arguments
|
||||||
|
|
|
||||||
|
|
@ -43,6 +43,7 @@
|
||||||
(arguments
|
(arguments
|
||||||
`(#:configure-flags (list
|
`(#:configure-flags (list
|
||||||
"--localstatedir=/var"
|
"--localstatedir=/var"
|
||||||
|
"--sysconfdir=/etc"
|
||||||
(string-append "--with-libgcrypt-prefix="
|
(string-append "--with-libgcrypt-prefix="
|
||||||
(assoc-ref %build-inputs
|
(assoc-ref %build-inputs
|
||||||
"libgcrypt")))
|
"libgcrypt")))
|
||||||
|
|
|
||||||
17
gnu/packages/patches/cssc-gets-undeclared.patch
Normal file
17
gnu/packages/patches/cssc-gets-undeclared.patch
Normal file
|
|
@ -0,0 +1,17 @@
|
||||||
|
CSSC uses a gets in a couple of places. For security reasons, modern gnulib
|
||||||
|
does not allow this. This patch allows it again.
|
||||||
|
--- CSSC-1.3.0/gl/lib/stdio.in.h 2010-05-15 00:15:35.000000000 +0200
|
||||||
|
+++ CSSC-1.3.0/gl/lib/stdio.in.h 2014-02-03 21:27:10.000000000 +0100
|
||||||
|
@@ -135,12 +135,6 @@
|
||||||
|
"use gnulib module fflush for portable POSIX compliance");
|
||||||
|
#endif
|
||||||
|
|
||||||
|
-/* It is very rare that the developer ever has full control of stdin,
|
||||||
|
- so any use of gets warrants an unconditional warning. Assume it is
|
||||||
|
- always declared, since it is required by C89. */
|
||||||
|
-#undef gets
|
||||||
|
-_GL_WARN_ON_USE (gets, "gets is a security hole - use fgets instead");
|
||||||
|
-
|
||||||
|
#if @GNULIB_FOPEN@
|
||||||
|
# if @REPLACE_FOPEN@
|
||||||
|
# if !(defined __cplusplus && defined GNULIB_NAMESPACE)
|
||||||
12
gnu/packages/patches/cssc-missing-include.patch
Normal file
12
gnu/packages/patches/cssc-missing-include.patch
Normal file
|
|
@ -0,0 +1,12 @@
|
||||||
|
Added a missing include file (necessary for gid_t and others).
|
||||||
|
So far as I am aware, this has not been added upstream yet.
|
||||||
|
--- CSSC-1.3.0/src/file.h 2010-05-16 19:31:33.000000000 +0200
|
||||||
|
+++ CSSC-1.3.0/src/file.h 2014-02-03 21:48:30.000000000 +0100
|
||||||
|
@@ -30,6 +30,7 @@
|
||||||
|
#ifndef CSSC__FILE_H__
|
||||||
|
#define CSSC__FILE_H__
|
||||||
|
|
||||||
|
+#include <sys/types.h>
|
||||||
|
#include "filelock.h"
|
||||||
|
|
||||||
|
enum create_mode {
|
||||||
|
|
@ -1,132 +0,0 @@
|
||||||
This patch removes the dependency on pangox which has been deprecated. It
|
|
||||||
achieves the same result as the upstream patch at
|
|
||||||
https://git.gnome.org/browse/gtkglext/commit/?id=df7a7b35b80b395d7ba411c7f727970a46fb0588
|
|
||||||
Like the upstream patch, it removes the functions gdk_gl_font_use_pango_font,
|
|
||||||
and gdk_gl_font_use_pango_font_for_display from the API.
|
|
||||||
|
|
||||||
diff -r -U 3 a/configure b/configure
|
|
||||||
--- a/configure 2006-02-05 04:17:47.000000000 +0100
|
|
||||||
+++ b/configure 2013-12-26 12:55:21.000000000 +0100
|
|
||||||
@@ -19880,14 +19880,12 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \\
|
|
||||||
gdk-2.0 >= 2.0.0 \\
|
|
||||||
pango >= 1.0.0 \\
|
|
||||||
-pangox >= 1.0.0 \\
|
|
||||||
gmodule-2.0 >= 2.0.0 \\
|
|
||||||
\"") >&5
|
|
||||||
($PKG_CONFIG --exists --print-errors "\
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
") 2>&5
|
|
||||||
ac_status=$?
|
|
||||||
@@ -19897,7 +19895,6 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
" 2>/dev/null`
|
|
||||||
else
|
|
||||||
@@ -19916,14 +19913,12 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \\
|
|
||||||
gdk-2.0 >= 2.0.0 \\
|
|
||||||
pango >= 1.0.0 \\
|
|
||||||
-pangox >= 1.0.0 \\
|
|
||||||
gmodule-2.0 >= 2.0.0 \\
|
|
||||||
\"") >&5
|
|
||||||
($PKG_CONFIG --exists --print-errors "\
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
") 2>&5
|
|
||||||
ac_status=$?
|
|
||||||
@@ -19933,7 +19928,6 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
" 2>/dev/null`
|
|
||||||
else
|
|
||||||
@@ -19958,7 +19952,6 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
"`
|
|
||||||
else
|
|
||||||
@@ -19966,7 +19959,6 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
"`
|
|
||||||
fi
|
|
||||||
@@ -19977,7 +19969,6 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
) were not met:
|
|
||||||
|
|
||||||
@@ -19994,7 +19985,6 @@
|
|
||||||
gtk+-2.0 >= 2.0.0 \
|
|
||||||
gdk-2.0 >= 2.0.0 \
|
|
||||||
pango >= 1.0.0 \
|
|
||||||
-pangox >= 1.0.0 \
|
|
||||||
gmodule-2.0 >= 2.0.0 \
|
|
||||||
) were not met:
|
|
||||||
|
|
||||||
@@ -25420,7 +25410,7 @@
|
|
||||||
# CFLAGS and LIBS
|
|
||||||
##################################################
|
|
||||||
|
|
||||||
-GDKGLEXT_PACKAGES="gdk-2.0 pango pangox gmodule-2.0"
|
|
||||||
+GDKGLEXT_PACKAGES="gdk-2.0 pango gmodule-2.0"
|
|
||||||
GDKGLEXT_EXTRA_CFLAGS="$GL_CFLAGS $GDKGLEXT_WIN_CFLAGS"
|
|
||||||
GDKGLEXT_EXTRA_LIBS="$GL_LIBS $GDKGLEXT_WIN_LIBS"
|
|
||||||
GDKGLEXT_DEP_CFLAGS="$GDKGLEXT_EXTRA_CFLAGS `$PKG_CONFIG --cflags $GDKGLEXT_PACKAGES`"
|
|
||||||
diff -r -U 3 a/gdk/x11/Makefile.in b/gdk/x11/Makefile.in
|
|
||||||
--- a/gdk/x11/Makefile.in 2006-02-05 04:17:42.000000000 +0100
|
|
||||||
+++ b/gdk/x11/Makefile.in 2013-12-26 13:12:04.000000000 +0100
|
|
||||||
@@ -257,7 +257,6 @@
|
|
||||||
gdkgldrawable-x11.c \
|
|
||||||
gdkglpixmap-x11.c \
|
|
||||||
gdkglwindow-x11.c \
|
|
||||||
- gdkglfont-x11.c \
|
|
||||||
gdkglglxext.c
|
|
||||||
|
|
||||||
|
|
||||||
@@ -288,7 +287,7 @@
|
|
||||||
am__objects_1 =
|
|
||||||
am__objects_2 = gdkglquery-x11.lo gdkglconfig-x11.lo gdkgloverlay-x11.lo \
|
|
||||||
gdkglcontext-x11.lo gdkgldrawable-x11.lo gdkglpixmap-x11.lo \
|
|
||||||
- gdkglwindow-x11.lo gdkglfont-x11.lo gdkglglxext.lo
|
|
||||||
+ gdkglwindow-x11.lo gdkglglxext.lo
|
|
||||||
am__objects_3 = $(am__objects_1) $(am__objects_2)
|
|
||||||
am_libgdkglext_x11_la_OBJECTS = $(am__objects_3)
|
|
||||||
libgdkglext_x11_la_OBJECTS = $(am_libgdkglext_x11_la_OBJECTS)
|
|
||||||
@@ -299,7 +298,6 @@
|
|
||||||
@AMDEP_TRUE@DEP_FILES = ./$(DEPDIR)/gdkglconfig-x11.Plo \
|
|
||||||
@AMDEP_TRUE@ ./$(DEPDIR)/gdkglcontext-x11.Plo \
|
|
||||||
@AMDEP_TRUE@ ./$(DEPDIR)/gdkgldrawable-x11.Plo \
|
|
||||||
-@AMDEP_TRUE@ ./$(DEPDIR)/gdkglfont-x11.Plo \
|
|
||||||
@AMDEP_TRUE@ ./$(DEPDIR)/gdkglglxext.Plo \
|
|
||||||
@AMDEP_TRUE@ ./$(DEPDIR)/gdkgloverlay-x11.Plo \
|
|
||||||
@AMDEP_TRUE@ ./$(DEPDIR)/gdkglpixmap-x11.Plo \
|
|
||||||
@@ -349,7 +347,6 @@
|
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkglconfig-x11.Plo@am__quote@
|
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkglcontext-x11.Plo@am__quote@
|
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkgldrawable-x11.Plo@am__quote@
|
|
||||||
-@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkglfont-x11.Plo@am__quote@
|
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkglglxext.Plo@am__quote@
|
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkgloverlay-x11.Plo@am__quote@
|
|
||||||
@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/gdkglpixmap-x11.Plo@am__quote@
|
|
||||||
168
gnu/packages/patches/module-init-tools-moduledir.patch
Normal file
168
gnu/packages/patches/module-init-tools-moduledir.patch
Normal file
|
|
@ -0,0 +1,168 @@
|
||||||
|
This patch changes 'modprobe' & co. so they honor the 'LINUX_MODULE_DIRECTORY'
|
||||||
|
environment variable, rather than looking for modules exclusively in
|
||||||
|
/lib/modules.
|
||||||
|
|
||||||
|
Patch by David Guibert, from Nixpkgs; adjusted to use 'LINUX_MODULE_DIRECTORY'
|
||||||
|
rather than 'MODULE_DIR' as the variable name.
|
||||||
|
|
||||||
|
commit cf2c95edb7918bc658f6cae93793c1949fc9cb6e
|
||||||
|
Author: David Guibert <david.guibert@gmail.com>
|
||||||
|
Date: Fri Aug 5 14:20:12 2011 +0200
|
||||||
|
|
||||||
|
introduce module-dir
|
||||||
|
|
||||||
|
diff --git a/depmod.c b/depmod.c
|
||||||
|
index a1d2f8c..9362a35 100644
|
||||||
|
--- a/depmod.c
|
||||||
|
+++ b/depmod.c
|
||||||
|
@@ -48,9 +48,6 @@
|
||||||
|
|
||||||
|
#include "testing.h"
|
||||||
|
|
||||||
|
-#ifndef MODULE_DIR
|
||||||
|
-#define MODULE_DIR "/lib/modules/"
|
||||||
|
-#endif
|
||||||
|
|
||||||
|
#ifndef MODULE_BUILTIN_KEY
|
||||||
|
#define MODULE_BUILTIN_KEY "built-in"
|
||||||
|
@@ -1516,6 +1513,7 @@ static int parse_config_file(const char *filename,
|
||||||
|
char *line;
|
||||||
|
unsigned int linenum = 0;
|
||||||
|
FILE *cfile;
|
||||||
|
+ char *module_dir;
|
||||||
|
|
||||||
|
cfile = fopen(filename, "r");
|
||||||
|
if (!cfile) {
|
||||||
|
@@ -1525,6 +1523,10 @@ static int parse_config_file(const char *filename,
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
+ if((module_dir = getenv("LINUX_MODULE_DIRECTORY")) == NULL) {
|
||||||
|
+ module_dir = "/lib/modules/";
|
||||||
|
+ }
|
||||||
|
+
|
||||||
|
while ((line = getline_wrapped(cfile, &linenum)) != NULL) {
|
||||||
|
char *ptr = line;
|
||||||
|
char *cmd, *modname;
|
||||||
|
@@ -1550,7 +1552,7 @@ static int parse_config_file(const char *filename,
|
||||||
|
continue;
|
||||||
|
}
|
||||||
|
nofail_asprintf(&dirname, "%s%s%s/%s", basedir,
|
||||||
|
- MODULE_DIR, kernelversion, search_path);
|
||||||
|
+ module_dir, kernelversion, search_path);
|
||||||
|
len = strlen(dirname);
|
||||||
|
*search = add_search(dirname, len, *search);
|
||||||
|
free(dirname);
|
||||||
|
@@ -1565,7 +1567,7 @@ static int parse_config_file(const char *filename,
|
||||||
|
continue;
|
||||||
|
|
||||||
|
nofail_asprintf(&pathname, "%s%s%s/%s/%s.ko", basedir,
|
||||||
|
- MODULE_DIR, kernelversion, subdir, modname);
|
||||||
|
+ module_dir, kernelversion, subdir, modname);
|
||||||
|
|
||||||
|
*overrides = add_override(pathname, *overrides);
|
||||||
|
free(pathname);
|
||||||
|
@@ -1737,6 +1739,7 @@ int main(int argc, char *argv[])
|
||||||
|
char *basedir = "", *dirname, *version;
|
||||||
|
char *system_map = NULL, *module_symvers = NULL;
|
||||||
|
int i;
|
||||||
|
+ char *module_dir;
|
||||||
|
const char *config = NULL;
|
||||||
|
|
||||||
|
if (native_endianness() == 0)
|
||||||
|
@@ -1832,7 +1835,11 @@ int main(int argc, char *argv[])
|
||||||
|
if (optind == argc)
|
||||||
|
all = 1;
|
||||||
|
|
||||||
|
- nofail_asprintf(&dirname, "%s%s%s", basedir, MODULE_DIR, version);
|
||||||
|
+ if((module_dir = getenv("LINUX_MODULE_DIRECTORY")) == NULL) {
|
||||||
|
+ module_dir = "/lib/modules/";
|
||||||
|
+ }
|
||||||
|
+
|
||||||
|
+ nofail_asprintf(&dirname, "%s%s%s", basedir, module_dir, version);
|
||||||
|
|
||||||
|
if (maybe_all) {
|
||||||
|
if (!doing_stdout && !depfile_out_of_date(dirname))
|
||||||
|
@@ -1850,7 +1857,7 @@ int main(int argc, char *argv[])
|
||||||
|
size_t len;
|
||||||
|
|
||||||
|
nofail_asprintf(&dirname, "%s%s%s/updates", basedir,
|
||||||
|
- MODULE_DIR, version);
|
||||||
|
+ module_dir, version);
|
||||||
|
len = strlen(dirname);
|
||||||
|
search = add_search(dirname, len, search);
|
||||||
|
}
|
||||||
|
diff --git a/modinfo.c b/modinfo.c
|
||||||
|
index 1dd8469..67b1041 100644
|
||||||
|
--- a/modinfo.c
|
||||||
|
+++ b/modinfo.c
|
||||||
|
@@ -19,9 +19,6 @@
|
||||||
|
#include "zlibsupport.h"
|
||||||
|
#include "testing.h"
|
||||||
|
|
||||||
|
-#ifndef MODULE_DIR
|
||||||
|
-#define MODULE_DIR "/lib/modules"
|
||||||
|
-#endif
|
||||||
|
|
||||||
|
struct param
|
||||||
|
{
|
||||||
|
@@ -193,6 +190,11 @@ static struct elf_file *grab_module(const char *name,
|
||||||
|
struct utsname buf;
|
||||||
|
char *depname, *p, *moddir;
|
||||||
|
struct elf_file *module;
|
||||||
|
+ char *module_dir;
|
||||||
|
+
|
||||||
|
+ if((module_dir = getenv("LINUX_MODULE_DIRECTORY")) == NULL) {
|
||||||
|
+ module_dir = "/lib/modules/";
|
||||||
|
+ }
|
||||||
|
|
||||||
|
if (strchr(name, '.') || strchr(name, '/')) {
|
||||||
|
module = grab_elf_file(name);
|
||||||
|
@@ -207,9 +209,9 @@ static struct elf_file *grab_module(const char *name,
|
||||||
|
kernel = buf.release;
|
||||||
|
}
|
||||||
|
if (strlen(basedir))
|
||||||
|
- nofail_asprintf(&moddir, "%s/%s/%s", basedir, MODULE_DIR, kernel);
|
||||||
|
+ nofail_asprintf(&moddir, "%s/%s/%s", basedir, module_dir, kernel);
|
||||||
|
else
|
||||||
|
- nofail_asprintf(&moddir, "%s/%s", MODULE_DIR, kernel);
|
||||||
|
+ nofail_asprintf(&moddir, "%s/%s", module_dir, kernel);
|
||||||
|
|
||||||
|
/* Search for it in modules.dep. */
|
||||||
|
nofail_asprintf(&depname, "%s/%s", moddir, "modules.dep");
|
||||||
|
diff --git a/modprobe.c b/modprobe.c
|
||||||
|
index 5464f45..d9fbf9d 100644
|
||||||
|
--- a/modprobe.c
|
||||||
|
+++ b/modprobe.c
|
||||||
|
@@ -86,10 +86,6 @@ typedef enum
|
||||||
|
|
||||||
|
} modprobe_flags_t;
|
||||||
|
|
||||||
|
-#ifndef MODULE_DIR
|
||||||
|
-#define MODULE_DIR "/lib/modules"
|
||||||
|
-#endif
|
||||||
|
-
|
||||||
|
/**
|
||||||
|
* print_usage - output the prefered program usage
|
||||||
|
*
|
||||||
|
@@ -2136,6 +2132,7 @@ int main(int argc, char *argv[])
|
||||||
|
struct modprobe_conf conf = {};
|
||||||
|
|
||||||
|
recursion_depth = 0;
|
||||||
|
+ char *module_dir = NULL;
|
||||||
|
|
||||||
|
/* Prepend options from environment. */
|
||||||
|
argv = merge_args(getenv("MODPROBE_OPTIONS"), argv, &argc);
|
||||||
|
@@ -2233,7 +2230,11 @@ int main(int argc, char *argv[])
|
||||||
|
if (argc < optind + 1 && !dump_config && !list_only)
|
||||||
|
print_usage(argv[0]);
|
||||||
|
|
||||||
|
- nofail_asprintf(&dirname, "%s%s/%s", basedir, MODULE_DIR, buf.release);
|
||||||
|
+ if((module_dir = getenv("LINUX_MODULE_DIRECTORY")) == NULL) {
|
||||||
|
+ module_dir = "/lib/modules";
|
||||||
|
+ }
|
||||||
|
+
|
||||||
|
+ nofail_asprintf(&dirname, "%s%s/%s", basedir, module_dir, buf.release);
|
||||||
|
|
||||||
|
/* Old-style -t xxx wildcard? Only with -l. */
|
||||||
|
if (list_only) {
|
||||||
|
|
@ -1,27 +0,0 @@
|
||||||
From db978be7388852059cf54e42539a363d549c5bfd Mon Sep 17 00:00:00 2001
|
|
||||||
From: Kurt Roeckx <kurt@roeckx.be>
|
|
||||||
Date: Sun, 13 Apr 2014 15:05:30 +0200
|
|
||||||
Subject: [PATCH] Don't release the buffer when there still is data in it
|
|
||||||
|
|
||||||
RT: 2167, 3265
|
|
||||||
---
|
|
||||||
ssl/s3_pkt.c | 3 ++-
|
|
||||||
1 file changed, 2 insertions(+), 1 deletion(-)
|
|
||||||
|
|
||||||
diff --git a/ssl/s3_pkt.c b/ssl/s3_pkt.c
|
|
||||||
index b9e45c7..32e9207 100644
|
|
||||||
--- a/ssl/s3_pkt.c
|
|
||||||
+++ b/ssl/s3_pkt.c
|
|
||||||
@@ -1055,7 +1055,8 @@ int ssl3_read_bytes(SSL *s, int type, unsigned char *buf, int len, int peek)
|
|
||||||
{
|
|
||||||
s->rstate=SSL_ST_READ_HEADER;
|
|
||||||
rr->off=0;
|
|
||||||
- if (s->mode & SSL_MODE_RELEASE_BUFFERS)
|
|
||||||
+ if (s->mode & SSL_MODE_RELEASE_BUFFERS &&
|
|
||||||
+ s->s3->rbuf.left == 0)
|
|
||||||
ssl3_release_read_buffer(s);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
--
|
|
||||||
1.9.1
|
|
||||||
|
|
||||||
|
|
@ -1,40 +0,0 @@
|
||||||
From 300b9f0b704048f60776881f1d378c74d9c32fbd Mon Sep 17 00:00:00 2001
|
|
||||||
From: "Dr. Stephen Henson" <steve@openssl.org>
|
|
||||||
Date: Tue, 15 Apr 2014 18:48:54 +0100
|
|
||||||
Subject: [PATCH] Extension checking fixes.
|
|
||||||
|
|
||||||
When looking for an extension we need to set the last found
|
|
||||||
position to -1 to properly search all extensions.
|
|
||||||
|
|
||||||
PR#3309.
|
|
||||||
---
|
|
||||||
crypto/x509v3/v3_purp.c | 6 +++---
|
|
||||||
1 file changed, 3 insertions(+), 3 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/crypto/x509v3/v3_purp.c b/crypto/x509v3/v3_purp.c
|
|
||||||
index 6c40c7d..5f931db 100644
|
|
||||||
--- a/crypto/x509v3/v3_purp.c
|
|
||||||
+++ b/crypto/x509v3/v3_purp.c
|
|
||||||
@@ -389,8 +389,8 @@ static void x509v3_cache_extensions(X509 *x)
|
|
||||||
/* Handle proxy certificates */
|
|
||||||
if((pci=X509_get_ext_d2i(x, NID_proxyCertInfo, NULL, NULL))) {
|
|
||||||
if (x->ex_flags & EXFLAG_CA
|
|
||||||
- || X509_get_ext_by_NID(x, NID_subject_alt_name, 0) >= 0
|
|
||||||
- || X509_get_ext_by_NID(x, NID_issuer_alt_name, 0) >= 0) {
|
|
||||||
+ || X509_get_ext_by_NID(x, NID_subject_alt_name, -1) >= 0
|
|
||||||
+ || X509_get_ext_by_NID(x, NID_issuer_alt_name, -1) >= 0) {
|
|
||||||
x->ex_flags |= EXFLAG_INVALID;
|
|
||||||
}
|
|
||||||
if (pci->pcPathLengthConstraint) {
|
|
||||||
@@ -670,7 +670,7 @@ static int check_purpose_timestamp_sign(const X509_PURPOSE *xp, const X509 *x,
|
|
||||||
return 0;
|
|
||||||
|
|
||||||
/* Extended Key Usage MUST be critical */
|
|
||||||
- i_ext = X509_get_ext_by_NID((X509 *) x, NID_ext_key_usage, 0);
|
|
||||||
+ i_ext = X509_get_ext_by_NID((X509 *) x, NID_ext_key_usage, -1);
|
|
||||||
if (i_ext >= 0)
|
|
||||||
{
|
|
||||||
X509_EXTENSION *ext = X509_get_ext((X509 *) x, i_ext);
|
|
||||||
--
|
|
||||||
1.9.1
|
|
||||||
|
|
||||||
15
gnu/packages/patches/util-linux-perl.patch
Normal file
15
gnu/packages/patches/util-linux-perl.patch
Normal file
|
|
@ -0,0 +1,15 @@
|
||||||
|
Use this common trick that exploits similarities between sh and Perl syntax
|
||||||
|
to avoid a hard dependency on Perl. Instead, this script will work only
|
||||||
|
when 'perl' is available in $PATH.
|
||||||
|
|
||||||
|
--- util-linux-2.21.2/misc-utils/chkdupexe.pl 2012-05-15 13:51:45.000000000 +0200
|
||||||
|
+++ util-linux-2.21.2/misc-utils/chkdupexe.pl 2014-06-01 22:46:06.000000000 +0200
|
||||||
|
@@ -1,5 +1,6 @@
|
||||||
|
-#!@PERL@ -w
|
||||||
|
-#
|
||||||
|
+eval '(exit $?0)' && eval 'exec perl -wS "$0" ${1+"$@"}'
|
||||||
|
+ & eval 'exec perl -wS "$0" $argv:q'
|
||||||
|
+ if 0;
|
||||||
|
# chkdupexe version 2.1.1
|
||||||
|
#
|
||||||
|
# Simple script to look for and list duplicate executables and dangling
|
||||||
|
|
@ -44,7 +44,8 @@
|
||||||
#:use-module (gnu packages emacs)
|
#:use-module (gnu packages emacs)
|
||||||
#:use-module (gnu packages compression)
|
#:use-module (gnu packages compression)
|
||||||
#:use-module (gnu packages swig)
|
#:use-module (gnu packages swig)
|
||||||
#:use-module (gnu packages tcl))
|
#:use-module (gnu packages tcl)
|
||||||
|
#:use-module (gnu packages))
|
||||||
|
|
||||||
(define-public bazaar
|
(define-public bazaar
|
||||||
(package
|
(package
|
||||||
|
|
@ -435,3 +436,46 @@ standards-compliant ChangeLog entries based on the changes that it detects.")
|
||||||
insertions, deletions, and modifications per-file. It is useful for reviewing
|
insertions, deletions, and modifications per-file. It is useful for reviewing
|
||||||
large, complex patch files.")
|
large, complex patch files.")
|
||||||
(license (x11-style "file://COPYING"))))
|
(license (x11-style "file://COPYING"))))
|
||||||
|
|
||||||
|
|
||||||
|
(define-public cssc
|
||||||
|
(package
|
||||||
|
(name "cssc")
|
||||||
|
(version "1.3.0")
|
||||||
|
(source (origin
|
||||||
|
(method url-fetch)
|
||||||
|
(uri (string-append "mirror://gnu/" name "/CSSC-"
|
||||||
|
version ".tar.gz"))
|
||||||
|
(sha256
|
||||||
|
(base32
|
||||||
|
"0bkw6fjh20ppvn54smv05461lm1vcwvn02avx941c4acafmkl1cm"))
|
||||||
|
(patches (list (search-patch "cssc-gets-undeclared.patch")
|
||||||
|
(search-patch "cssc-missing-include.patch")))))
|
||||||
|
(build-system gnu-build-system)
|
||||||
|
(arguments
|
||||||
|
`(#:phases (alist-cons-before
|
||||||
|
'check 'precheck
|
||||||
|
(lambda _
|
||||||
|
(begin
|
||||||
|
(substitute* "tests/common/test-common"
|
||||||
|
(("/bin/pwd") (which "pwd")))
|
||||||
|
|
||||||
|
(substitute* "tests/prt/all-512.sh"
|
||||||
|
(("/bin/sh") (which "sh")))
|
||||||
|
|
||||||
|
;; XXX: This test has no hope of passing until there is a "nogroup"
|
||||||
|
;; entry (or at least some group to which the guix builder does
|
||||||
|
;; not belong) in the /etc/group file of the build environment.
|
||||||
|
;; Currently we do not have such a group. Disable this test for now.
|
||||||
|
(substitute* "tests/Makefile"
|
||||||
|
(("test-delta ") ""))))
|
||||||
|
%standard-phases)))
|
||||||
|
;; These are needed for the tests
|
||||||
|
(native-inputs `(("git" ,git)
|
||||||
|
("cvs" ,cvs)))
|
||||||
|
(home-page "http://www.gnu.org/software/cssc/")
|
||||||
|
(synopsis "File-based version control like SCCS")
|
||||||
|
(description "GNU CSSC provides a replacement for the legacy Unix source
|
||||||
|
code control system SCCS. This allows old code still under that system to be
|
||||||
|
accessed and migrated on modern systems.")
|
||||||
|
(license gpl3+)))
|
||||||
|
|
|
||||||
|
|
@ -17,6 +17,8 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gnu services base)
|
(define-module (gnu services base)
|
||||||
|
#:use-module ((guix store)
|
||||||
|
#:select (%store-prefix))
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu system shadow) ; 'user-account', etc.
|
#:use-module (gnu system shadow) ; 'user-account', etc.
|
||||||
#:use-module (gnu system linux) ; 'pam-service', etc.
|
#:use-module (gnu system linux) ; 'pam-service', etc.
|
||||||
|
|
@ -89,9 +91,11 @@ This service must be the root of the service dependency graph so that its
|
||||||
(respawn? #f)))))
|
(respawn? #f)))))
|
||||||
|
|
||||||
(define* (file-system-service device target type
|
(define* (file-system-service device target type
|
||||||
#:key (check? #t) options)
|
#:key (check? #t) options (title 'any))
|
||||||
"Return a service that mounts DEVICE on TARGET as a file system TYPE with
|
"Return a service that mounts DEVICE on TARGET as a file system TYPE with
|
||||||
OPTIONS. When CHECK? is true, check the file system before mounting it."
|
OPTIONS. TITLE is a symbol specifying what kind of name DEVICE is: 'label for
|
||||||
|
a partition label, 'device for a device file name, or 'any. When CHECK? is
|
||||||
|
true, check the file system before mounting it."
|
||||||
(with-monad %store-monad
|
(with-monad %store-monad
|
||||||
(return
|
(return
|
||||||
(service
|
(service
|
||||||
|
|
@ -99,10 +103,11 @@ OPTIONS. When CHECK? is true, check the file system before mounting it."
|
||||||
(requirement '(root-file-system))
|
(requirement '(root-file-system))
|
||||||
(documentation "Check, mount, and unmount the given file system.")
|
(documentation "Check, mount, and unmount the given file system.")
|
||||||
(start #~(lambda args
|
(start #~(lambda args
|
||||||
|
(let ((device (canonicalize-device-spec #$device '#$title)))
|
||||||
#$(if check?
|
#$(if check?
|
||||||
#~(check-file-system #$device #$type)
|
#~(check-file-system device #$type)
|
||||||
#~#t)
|
#~#t)
|
||||||
(mount #$device #$target #$type 0 #$options)
|
(mount device #$target #$type 0 #$options))
|
||||||
#t))
|
#t))
|
||||||
(stop #~(lambda args
|
(stop #~(lambda args
|
||||||
;; Normally there are no processes left at this point, so
|
;; Normally there are no processes left at this point, so
|
||||||
|
|
@ -193,9 +198,31 @@ stopped before 'kill' is called."
|
||||||
(define* (mingetty-service tty
|
(define* (mingetty-service tty
|
||||||
#:key
|
#:key
|
||||||
(motd (text-file "motd" "Welcome.\n"))
|
(motd (text-file "motd" "Welcome.\n"))
|
||||||
|
auto-login
|
||||||
|
login-program
|
||||||
|
login-pause?
|
||||||
(allow-empty-passwords? #t))
|
(allow-empty-passwords? #t))
|
||||||
"Return a service to run mingetty on TTY."
|
"Return a service to run mingetty on @var{tty}.
|
||||||
(mlet %store-monad ((motd motd))
|
|
||||||
|
When @var{allow-empty-passwords?} is true, allow empty log-in password. When
|
||||||
|
@var{auto-login} is true, it must be a user name under which to log-in
|
||||||
|
automatically. @var{login-pause?} can be set to @code{#t} in conjunction with
|
||||||
|
@var{auto-login}, in which case the user will have to press a key before the
|
||||||
|
login shell is launched.
|
||||||
|
|
||||||
|
When true, @var{login-program} is a gexp or a monadic gexp denoting the name
|
||||||
|
of the log-in program (the default is the @code{login} program from the Shadow
|
||||||
|
tool suite.)
|
||||||
|
|
||||||
|
@var{motd} is a monadic value containing a text file to use as
|
||||||
|
the \"message of the day\"."
|
||||||
|
(mlet %store-monad ((motd motd)
|
||||||
|
(login-program (cond ((gexp? login-program)
|
||||||
|
(return login-program))
|
||||||
|
((not login-program)
|
||||||
|
(return #f))
|
||||||
|
(else
|
||||||
|
login-program))))
|
||||||
(return
|
(return
|
||||||
(service
|
(service
|
||||||
(documentation (string-append "Run mingetty on " tty "."))
|
(documentation (string-append "Run mingetty on " tty "."))
|
||||||
|
|
@ -207,7 +234,16 @@ stopped before 'kill' is called."
|
||||||
|
|
||||||
(start #~(make-forkexec-constructor
|
(start #~(make-forkexec-constructor
|
||||||
(string-append #$mingetty "/sbin/mingetty")
|
(string-append #$mingetty "/sbin/mingetty")
|
||||||
"--noclear" #$tty))
|
"--noclear" #$tty
|
||||||
|
#$@(if auto-login
|
||||||
|
#~("--autologin" #$auto-login)
|
||||||
|
#~())
|
||||||
|
#$@(if login-program
|
||||||
|
#~("--loginprog" #$login-program)
|
||||||
|
#~())
|
||||||
|
#$@(if login-pause?
|
||||||
|
#~("--loginpause")
|
||||||
|
#~())))
|
||||||
(stop #~(make-kill-destructor))
|
(stop #~(make-kill-destructor))
|
||||||
|
|
||||||
(pam-services
|
(pam-services
|
||||||
|
|
@ -243,11 +279,11 @@ stopped before 'kill' is called."
|
||||||
|
|
||||||
;; Snippet adapted from the GNU inetutils manual.
|
;; Snippet adapted from the GNU inetutils manual.
|
||||||
(define contents "
|
(define contents "
|
||||||
# Log all kernel messages, authentication messages of
|
# Log all error messages, authentication messages of
|
||||||
# level notice or higher and anything of level err or
|
# level notice or higher and anything of level err or
|
||||||
# higher to the console.
|
# higher to the console.
|
||||||
# Don't log private authentication messages!
|
# Don't log private authentication messages!
|
||||||
*.err;kern.*;auth.notice;authpriv.none /dev/console
|
*.err;auth.notice;authpriv.none /dev/console
|
||||||
|
|
||||||
# Log anything (except mail) of level info or higher.
|
# Log anything (except mail) of level info or higher.
|
||||||
# Don't log private authentication messages!
|
# Don't log private authentication messages!
|
||||||
|
|
@ -290,16 +326,57 @@ starting at FIRST-UID, and under GID."
|
||||||
(name (format #f "guixbuilder~2,'0d" n))
|
(name (format #f "guixbuilder~2,'0d" n))
|
||||||
(uid (+ first-uid n -1))
|
(uid (+ first-uid n -1))
|
||||||
(group group)
|
(group group)
|
||||||
|
|
||||||
|
;; guix-daemon expects GROUP to be listed as a
|
||||||
|
;; supplementary group too:
|
||||||
|
;; <http://lists.gnu.org/archive/html/bug-guix/2013-01/msg00239.html>.
|
||||||
|
(supplementary-groups (list group))
|
||||||
|
|
||||||
(comment (format #f "Guix Build User ~2d" n))
|
(comment (format #f "Guix Build User ~2d" n))
|
||||||
(home-directory "/var/empty")
|
(home-directory "/var/empty")
|
||||||
(shell #~(string-append #$shadow "/sbin/nologin"))))
|
(shell #~(string-append #$shadow "/sbin/nologin"))))
|
||||||
1+
|
1+
|
||||||
1))))
|
1))))
|
||||||
|
|
||||||
|
(define (hydra-key-authorization guix)
|
||||||
|
"Return a gexp with code to register the hydra.gnu.org public key with
|
||||||
|
GUIX."
|
||||||
|
#~(unless (file-exists? "/etc/guix/acl")
|
||||||
|
(let ((pid (primitive-fork)))
|
||||||
|
(case pid
|
||||||
|
((0)
|
||||||
|
(let* ((key (string-append #$guix
|
||||||
|
"/share/guix/hydra.gnu.org.pub"))
|
||||||
|
(port (open-file key "r0b")))
|
||||||
|
(format #t "registering public key '~a'...~%" key)
|
||||||
|
(close-port (current-input-port))
|
||||||
|
(dup port 0)
|
||||||
|
(execl (string-append #$guix "/bin/guix")
|
||||||
|
"guix" "archive" "--authorize")
|
||||||
|
(exit 1)))
|
||||||
|
(else
|
||||||
|
(let ((status (cdr (waitpid pid))))
|
||||||
|
(unless (zero? status)
|
||||||
|
(format (current-error-port) "warning: \
|
||||||
|
failed to register hydra.gnu.org public key: ~a~%" status))))))))
|
||||||
|
|
||||||
(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
|
(define* (guix-service #:key (guix guix) (builder-group "guixbuild")
|
||||||
(build-accounts 10))
|
(build-accounts 10) authorize-hydra-key?)
|
||||||
"Return a service that runs the build daemon from GUIX, and has
|
"Return a service that runs the build daemon from GUIX, and has
|
||||||
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
|
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID.
|
||||||
|
|
||||||
|
When AUTHORIZE-HYDRA-KEY? is true, the hydra.gnu.org public key provided by
|
||||||
|
GUIX is authorized upon activation, meaning that substitutes from
|
||||||
|
hydra.gnu.org are used by default."
|
||||||
|
(define activate
|
||||||
|
;; Assume that the store has BUILDER-GROUP as its group. We could
|
||||||
|
;; otherwise call 'chown' here, but the problem is that on a COW unionfs,
|
||||||
|
;; chown leads to an entire copy of the tree, which is a bad idea.
|
||||||
|
|
||||||
|
;; Optionally authorize hydra.gnu.org's key.
|
||||||
|
(and authorize-hydra-key?
|
||||||
|
(hydra-key-authorization guix)))
|
||||||
|
|
||||||
(mlet %store-monad ((accounts (guix-build-accounts build-accounts
|
(mlet %store-monad ((accounts (guix-build-accounts build-accounts
|
||||||
#:group builder-group)))
|
#:group builder-group)))
|
||||||
(return (service
|
(return (service
|
||||||
|
|
@ -315,7 +392,12 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
|
||||||
(user-groups (list (user-group
|
(user-groups (list (user-group
|
||||||
(name builder-group)
|
(name builder-group)
|
||||||
(members (map user-account-name
|
(members (map user-account-name
|
||||||
user-accounts)))))))))
|
user-accounts))
|
||||||
|
|
||||||
|
;; Use a fixed GID so that we can create the
|
||||||
|
;; store with the right owner.
|
||||||
|
(id 30000))))
|
||||||
|
(activate activate)))))
|
||||||
|
|
||||||
(define %base-services
|
(define %base-services
|
||||||
;; Convenience variable holding the basic services.
|
;; Convenience variable holding the basic services.
|
||||||
|
|
|
||||||
|
|
@ -50,7 +50,7 @@
|
||||||
(use-modules (ice-9 ftw)
|
(use-modules (ice-9 ftw)
|
||||||
(guix build syscalls)
|
(guix build syscalls)
|
||||||
((guix build linux-initrd)
|
((guix build linux-initrd)
|
||||||
#:select (check-file-system)))
|
#:select (check-file-system canonicalize-device-spec)))
|
||||||
|
|
||||||
(register-services
|
(register-services
|
||||||
#$@(map (lambda (service)
|
#$@(map (lambda (service)
|
||||||
|
|
|
||||||
|
|
@ -26,7 +26,11 @@
|
||||||
#:use-module (gnu packages base)
|
#:use-module (gnu packages base)
|
||||||
#:use-module (gnu packages bash)
|
#:use-module (gnu packages bash)
|
||||||
#:use-module (gnu packages admin)
|
#:use-module (gnu packages admin)
|
||||||
|
#:use-module (gnu packages linux)
|
||||||
#:use-module (gnu packages package-management)
|
#:use-module (gnu packages package-management)
|
||||||
|
#:use-module (gnu packages which)
|
||||||
|
#:use-module (gnu packages less)
|
||||||
|
#:use-module (gnu packages zile)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services dmd)
|
#:use-module (gnu services dmd)
|
||||||
#:use-module (gnu services base)
|
#:use-module (gnu services base)
|
||||||
|
|
@ -50,6 +54,7 @@
|
||||||
operating-system-initrd
|
operating-system-initrd
|
||||||
operating-system-users
|
operating-system-users
|
||||||
operating-system-groups
|
operating-system-groups
|
||||||
|
operating-system-issue
|
||||||
operating-system-packages
|
operating-system-packages
|
||||||
operating-system-timezone
|
operating-system-timezone
|
||||||
operating-system-locale
|
operating-system-locale
|
||||||
|
|
@ -57,7 +62,9 @@
|
||||||
|
|
||||||
operating-system-derivation
|
operating-system-derivation
|
||||||
operating-system-profile
|
operating-system-profile
|
||||||
operating-system-grub.cfg))
|
operating-system-grub.cfg
|
||||||
|
|
||||||
|
%base-packages))
|
||||||
|
|
||||||
;;; Commentary:
|
;;; Commentary:
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -91,17 +98,11 @@
|
||||||
|
|
||||||
(skeletons operating-system-skeletons ; list of name/monadic value
|
(skeletons operating-system-skeletons ; list of name/monadic value
|
||||||
(default (default-skeletons)))
|
(default (default-skeletons)))
|
||||||
|
(issue operating-system-issue ; string
|
||||||
|
(default %default-issue))
|
||||||
|
|
||||||
(packages operating-system-packages ; list of (PACKAGE OUTPUT...)
|
(packages operating-system-packages ; list of (PACKAGE OUTPUT...)
|
||||||
(default (list coreutils ; or just PACKAGE
|
(default %base-packages)) ; or just PACKAGE
|
||||||
grep
|
|
||||||
sed
|
|
||||||
findutils
|
|
||||||
guile
|
|
||||||
bash
|
|
||||||
(@ (gnu packages dmd) dmd)
|
|
||||||
guix
|
|
||||||
tzdata)))
|
|
||||||
|
|
||||||
(timezone operating-system-timezone) ; string
|
(timezone operating-system-timezone) ; string
|
||||||
(locale operating-system-locale) ; string
|
(locale operating-system-locale) ; string
|
||||||
|
|
@ -178,8 +179,10 @@ as 'needed-for-boot'."
|
||||||
|
|
||||||
(sequence %store-monad
|
(sequence %store-monad
|
||||||
(map (match-lambda
|
(map (match-lambda
|
||||||
(($ <file-system> device target type flags opts #f check?)
|
(($ <file-system> device title target type flags opts
|
||||||
|
#f check?)
|
||||||
(file-system-service device target type
|
(file-system-service device target type
|
||||||
|
#:title title
|
||||||
#:check? check?
|
#:check? check?
|
||||||
#:options opts)))
|
#:options opts)))
|
||||||
file-systems)))
|
file-systems)))
|
||||||
|
|
@ -210,8 +213,25 @@ explicitly appear in OS."
|
||||||
;;; /etc.
|
;;; /etc.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
|
(define %base-packages
|
||||||
|
;; Default set of packages globally visible. It should include anything
|
||||||
|
;; required for basic administrator tasks.
|
||||||
|
(list bash coreutils findutils grep sed
|
||||||
|
procps psmisc less zile
|
||||||
|
guile-final (@ (gnu packages admin) dmd) guix
|
||||||
|
util-linux inetutils isc-dhcp
|
||||||
|
net-tools ; XXX: remove when Inetutils suffices
|
||||||
|
module-init-tools kbd))
|
||||||
|
|
||||||
|
(define %default-issue
|
||||||
|
;; Default contents for /etc/issue.
|
||||||
|
"
|
||||||
|
This is the GNU system. Welcome.\n")
|
||||||
|
|
||||||
(define* (etc-directory #:key
|
(define* (etc-directory #:key
|
||||||
|
kernel
|
||||||
(locale "C") (timezone "Europe/Paris")
|
(locale "C") (timezone "Europe/Paris")
|
||||||
|
(issue "Hello!\n")
|
||||||
(skeletons '())
|
(skeletons '())
|
||||||
(pam-services '())
|
(pam-services '())
|
||||||
(profile "/run/current-system/profile")
|
(profile "/run/current-system/profile")
|
||||||
|
|
@ -226,15 +246,7 @@ explicitly appear in OS."
|
||||||
/bin/sh
|
/bin/sh
|
||||||
/run/current-system/profile/bin/sh
|
/run/current-system/profile/bin/sh
|
||||||
/run/current-system/profile/bin/bash\n"))
|
/run/current-system/profile/bin/bash\n"))
|
||||||
(issue (text-file "issue" "
|
(issue (text-file "issue" issue))
|
||||||
This is an alpha preview of the GNU system. Welcome.
|
|
||||||
|
|
||||||
This image features the GNU Guix package manager, which was used to
|
|
||||||
build it (http://www.gnu.org/software/guix/). The init system is
|
|
||||||
GNU dmd (http://www.gnu.org/software/dmd/).
|
|
||||||
|
|
||||||
You can log in as 'guest' or 'root' with no password.
|
|
||||||
"))
|
|
||||||
|
|
||||||
;; TODO: Generate bashrc from packages' search-paths.
|
;; TODO: Generate bashrc from packages' search-paths.
|
||||||
(bashrc (text-file* "bashrc" "
|
(bashrc (text-file* "bashrc" "
|
||||||
|
|
@ -244,8 +256,13 @@ export LC_ALL=\"" locale "\"
|
||||||
export TZ=\"" timezone "\"
|
export TZ=\"" timezone "\"
|
||||||
export TZDIR=\"" tzdata "/share/zoneinfo\"
|
export TZDIR=\"" tzdata "/share/zoneinfo\"
|
||||||
|
|
||||||
export PATH=/run/setuid-programs:/run/current-system/profile/sbin
|
# Tell 'modprobe' & co. where to look for modules.
|
||||||
export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin:$PATH
|
# XXX: The downside of doing it here is that when switching to a new config
|
||||||
|
# without rebooting, this variable possibly becomes invalid.
|
||||||
|
export LINUX_MODULE_DIRECTORY=" kernel "/lib/modules
|
||||||
|
|
||||||
|
export PATH=$HOME/.guix-profile/bin:/run/current-system/profile/bin
|
||||||
|
export PATH=/run/setuid-programs:/run/current-system/profile/sbin:$PATH
|
||||||
export CPATH=$HOME/.guix-profile/include:" profile "/include
|
export CPATH=$HOME/.guix-profile/include:" profile "/include
|
||||||
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
|
export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib
|
||||||
alias ls='ls -p --color'
|
alias ls='ls -p --color'
|
||||||
|
|
@ -306,8 +323,10 @@ alias ll='ls -l'
|
||||||
(append-map service-pam-services services))))
|
(append-map service-pam-services services))))
|
||||||
(profile-drv (operating-system-profile os))
|
(profile-drv (operating-system-profile os))
|
||||||
(skeletons (operating-system-skeletons os)))
|
(skeletons (operating-system-skeletons os)))
|
||||||
(etc-directory #:pam-services pam-services
|
(etc-directory #:kernel (operating-system-kernel os)
|
||||||
|
#:pam-services pam-services
|
||||||
#:skeletons skeletons
|
#:skeletons skeletons
|
||||||
|
#:issue (operating-system-issue os)
|
||||||
#:locale (operating-system-locale os)
|
#:locale (operating-system-locale os)
|
||||||
#:timezone (operating-system-timezone os)
|
#:timezone (operating-system-timezone os)
|
||||||
#:sudoers (operating-system-sudoers os)
|
#:sudoers (operating-system-sudoers os)
|
||||||
|
|
@ -319,7 +338,8 @@ alias ll='ls -l'
|
||||||
(list #~(string-append #$shadow "/bin/passwd")
|
(list #~(string-append #$shadow "/bin/passwd")
|
||||||
#~(string-append #$shadow "/bin/su")
|
#~(string-append #$shadow "/bin/su")
|
||||||
#~(string-append #$inetutils "/bin/ping")
|
#~(string-append #$inetutils "/bin/ping")
|
||||||
#~(string-append #$sudo "/bin/sudo"))))
|
#~(string-append #$sudo "/bin/sudo")
|
||||||
|
#~(string-append #$fuse "/bin/fusermount"))))
|
||||||
|
|
||||||
(define %sudoers-specification
|
(define %sudoers-specification
|
||||||
;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
|
;; Default /etc/sudoers contents: 'root' and all members of the 'wheel'
|
||||||
|
|
@ -382,7 +402,7 @@ etc."
|
||||||
(define group-specs
|
(define group-specs
|
||||||
(map user-group->gexp groups))
|
(map user-group->gexp groups))
|
||||||
|
|
||||||
(gexp->file "boot"
|
(gexp->file "activate"
|
||||||
#~(begin
|
#~(begin
|
||||||
(eval-when (expand load eval)
|
(eval-when (expand load eval)
|
||||||
;; Make sure 'use-modules' below succeeds.
|
;; Make sure 'use-modules' below succeeds.
|
||||||
|
|
@ -445,7 +465,7 @@ we're running in the final root."
|
||||||
(define (operating-system-root-file-system os)
|
(define (operating-system-root-file-system os)
|
||||||
"Return the root file system of OS."
|
"Return the root file system of OS."
|
||||||
(find (match-lambda
|
(find (match-lambda
|
||||||
(($ <file-system> _ "/") #t)
|
(($ <file-system> _ _ "/") #t)
|
||||||
(_ #f))
|
(_ #f))
|
||||||
(operating-system-file-systems os)))
|
(operating-system-file-systems os)))
|
||||||
|
|
||||||
|
|
@ -453,9 +473,10 @@ we're running in the final root."
|
||||||
"Return a gexp denoting the initrd file of OS."
|
"Return a gexp denoting the initrd file of OS."
|
||||||
(define boot-file-systems
|
(define boot-file-systems
|
||||||
(filter (match-lambda
|
(filter (match-lambda
|
||||||
(($ <file-system> device "/")
|
(($ <file-system> device title "/")
|
||||||
#t)
|
#t)
|
||||||
(($ <file-system> device mount-point type flags options boot?)
|
(($ <file-system> device title mount-point type flags
|
||||||
|
options boot?)
|
||||||
boot?))
|
boot?))
|
||||||
(operating-system-file-systems os)))
|
(operating-system-file-systems os)))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,7 @@
|
||||||
file-system
|
file-system
|
||||||
file-system?
|
file-system?
|
||||||
file-system-device
|
file-system-device
|
||||||
|
file-system-title
|
||||||
file-system-mount-point
|
file-system-mount-point
|
||||||
file-system-type
|
file-system-type
|
||||||
file-system-needed-for-boot?
|
file-system-needed-for-boot?
|
||||||
|
|
@ -42,6 +43,8 @@
|
||||||
make-file-system
|
make-file-system
|
||||||
file-system?
|
file-system?
|
||||||
(device file-system-device) ; string
|
(device file-system-device) ; string
|
||||||
|
(title file-system-title ; 'device | 'label | 'uuid
|
||||||
|
(default 'device))
|
||||||
(mount-point file-system-mount-point) ; string
|
(mount-point file-system-mount-point) ; string
|
||||||
(type file-system-type) ; string
|
(type file-system-type) ; string
|
||||||
(flags file-system-flags ; list of symbols
|
(flags file-system-flags ; list of symbols
|
||||||
|
|
|
||||||
147
gnu/system/install.scm
Normal file
147
gnu/system/install.scm
Normal file
|
|
@ -0,0 +1,147 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (gnu system install)
|
||||||
|
#:use-module (gnu)
|
||||||
|
#:use-module (guix gexp)
|
||||||
|
#:use-module (guix monads)
|
||||||
|
#:use-module (gnu packages linux)
|
||||||
|
#:use-module (gnu packages package-management)
|
||||||
|
#:use-module (gnu packages disk)
|
||||||
|
#:use-module (gnu packages texinfo)
|
||||||
|
#:export (installation-os))
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
;;;
|
||||||
|
;;; This module provides an 'operating-system' definition for use on images
|
||||||
|
;;; for USB sticks etc., for the installation of the GNU system.
|
||||||
|
;;;
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(define (log-to-info)
|
||||||
|
"Return a script that spawns the Info reader on the right section of the
|
||||||
|
manual."
|
||||||
|
(gexp->script "log-to-info"
|
||||||
|
#~(execl (string-append #$texinfo-4 "/bin/info") "info"
|
||||||
|
"-d" "/run/current-system/profile/share/info"
|
||||||
|
"-f" (string-append #$guix "/share/info/guix.info")
|
||||||
|
"-n" "System Configuration")))
|
||||||
|
|
||||||
|
(define (installation-services)
|
||||||
|
"Return the list services for the installation image."
|
||||||
|
(let ((motd (text-file "motd" "
|
||||||
|
Welcome to the installation of the GNU operating system!
|
||||||
|
|
||||||
|
There is NO WARRANTY, to the extent permitted by law. In particular, you may
|
||||||
|
LOSE ALL YOUR DATA as a side effect of the installation process. Furthermore,
|
||||||
|
it is alpha software, so it may BREAK IN UNEXPECTED WAYS.
|
||||||
|
|
||||||
|
You have been warned. Thanks for being so brave.
|
||||||
|
")))
|
||||||
|
(define (normal-tty tty)
|
||||||
|
(mingetty-service tty
|
||||||
|
#:motd motd
|
||||||
|
#:auto-login "root"
|
||||||
|
#:login-pause? #t))
|
||||||
|
|
||||||
|
(list (mingetty-service "tty1"
|
||||||
|
#:motd motd
|
||||||
|
#:auto-login "root")
|
||||||
|
|
||||||
|
;; Documentation.
|
||||||
|
(mingetty-service "tty2"
|
||||||
|
#:motd motd
|
||||||
|
#:auto-login "guest"
|
||||||
|
#:login-program (log-to-info))
|
||||||
|
|
||||||
|
;; A bunch of 'root' ttys.
|
||||||
|
(normal-tty "tty3")
|
||||||
|
(normal-tty "tty4")
|
||||||
|
(normal-tty "tty5")
|
||||||
|
(normal-tty "tty6")
|
||||||
|
|
||||||
|
;; The usual services.
|
||||||
|
(syslog-service)
|
||||||
|
|
||||||
|
;; The build daemon. Register the hydra.gnu.org key as trusted.
|
||||||
|
;; This allows the installation process to use substitutes by
|
||||||
|
;; default.
|
||||||
|
(guix-service #:authorize-hydra-key? #t)
|
||||||
|
|
||||||
|
(nscd-service))))
|
||||||
|
|
||||||
|
(define %issue
|
||||||
|
;; Greeting.
|
||||||
|
"
|
||||||
|
This is an installation image of the GNU system. Welcome.
|
||||||
|
|
||||||
|
Use Alt-F2 for documentation.
|
||||||
|
")
|
||||||
|
|
||||||
|
(define installation-os
|
||||||
|
;; The operating system used on installation images for USB sticks etc.
|
||||||
|
(operating-system
|
||||||
|
(host-name "gnu")
|
||||||
|
(timezone "Europe/Paris")
|
||||||
|
(locale "en_US.UTF-8")
|
||||||
|
(bootloader (grub-configuration
|
||||||
|
(device "/dev/sda")))
|
||||||
|
(file-systems
|
||||||
|
;; Note: the disk image build code overrides this root file system with
|
||||||
|
;; the appropriate one.
|
||||||
|
(list (file-system
|
||||||
|
(mount-point "/")
|
||||||
|
(device "gnu-disk-image")
|
||||||
|
(type "ext4"))))
|
||||||
|
|
||||||
|
(users (list (user-account
|
||||||
|
(name "guest")
|
||||||
|
(group "wheel")
|
||||||
|
(password "")
|
||||||
|
(comment "Guest of GNU")
|
||||||
|
(home-directory "/home/guest"))))
|
||||||
|
(groups (list (user-group (name "root") (id 0))
|
||||||
|
(user-group
|
||||||
|
(name "wheel")
|
||||||
|
(id 1)
|
||||||
|
(members '("guest"))) ; allow 'guest' to use sudo
|
||||||
|
(user-group
|
||||||
|
(name "users")
|
||||||
|
(id 100)
|
||||||
|
(members '("guest")))))
|
||||||
|
|
||||||
|
(issue %issue)
|
||||||
|
|
||||||
|
(services (installation-services))
|
||||||
|
|
||||||
|
;; We don't need setuid programs so pass the empty list so we don't pull
|
||||||
|
;; additional programs here.
|
||||||
|
(setuid-programs '())
|
||||||
|
|
||||||
|
(pam-services
|
||||||
|
;; Explicitly allow for empty passwords.
|
||||||
|
(base-pam-services #:allow-empty-passwords? #t))
|
||||||
|
|
||||||
|
(packages (cons* texinfo-4 ; for the standalone Info reader
|
||||||
|
parted fdisk ddrescue
|
||||||
|
%base-packages))))
|
||||||
|
|
||||||
|
;; Return it here so 'guix system' can consume it directly.
|
||||||
|
installation-os
|
||||||
|
|
||||||
|
;;; install.scm ends here
|
||||||
|
|
@ -198,8 +198,8 @@ a list of Guile module names to be embedded in the initrd."
|
||||||
"Return a list corresponding to file-system FS that can be passed to the
|
"Return a list corresponding to file-system FS that can be passed to the
|
||||||
initrd code."
|
initrd code."
|
||||||
(match fs
|
(match fs
|
||||||
(($ <file-system> device mount-point type flags options _ check?)
|
(($ <file-system> device title mount-point type flags options _ check?)
|
||||||
(list device mount-point type flags options check?))))
|
(list device title mount-point type flags options check?))))
|
||||||
|
|
||||||
(define* (qemu-initrd file-systems
|
(define* (qemu-initrd file-systems
|
||||||
#:key
|
#:key
|
||||||
|
|
|
||||||
|
|
@ -29,7 +29,7 @@
|
||||||
#:use-module (gnu packages bash)
|
#:use-module (gnu packages bash)
|
||||||
#:use-module (gnu packages less)
|
#:use-module (gnu packages less)
|
||||||
#:use-module (gnu packages qemu)
|
#:use-module (gnu packages qemu)
|
||||||
#:use-module (gnu packages parted)
|
#:use-module (gnu packages disk)
|
||||||
#:use-module (gnu packages zile)
|
#:use-module (gnu packages zile)
|
||||||
#:use-module (gnu packages grub)
|
#:use-module (gnu packages grub)
|
||||||
#:use-module (gnu packages linux)
|
#:use-module (gnu packages linux)
|
||||||
|
|
@ -196,15 +196,17 @@ made available under the /xchg CIFS share."
|
||||||
(disk-image-size (* 100 (expt 2 20)))
|
(disk-image-size (* 100 (expt 2 20)))
|
||||||
(disk-image-format "qcow2")
|
(disk-image-format "qcow2")
|
||||||
(file-system-type "ext4")
|
(file-system-type "ext4")
|
||||||
|
file-system-label
|
||||||
grub-configuration
|
grub-configuration
|
||||||
(register-closures? #t)
|
(register-closures? #t)
|
||||||
(inputs '())
|
(inputs '())
|
||||||
copy-inputs?)
|
copy-inputs?)
|
||||||
"Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
|
"Return a bootable, stand-alone QEMU image of type DISK-IMAGE-FORMAT (e.g.,
|
||||||
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE. The
|
'qcow2' or 'raw'), with a root partition of type FILE-SYSTEM-TYPE.
|
||||||
returned image is a full disk image, with a GRUB installation that uses
|
Optionally, FILE-SYSTEM-LABEL can be specified as the volume name for the root
|
||||||
GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION must be the
|
partition. The returned image is a full disk image, with a GRUB installation
|
||||||
name of a file in the VM.)
|
that uses GRUB-CONFIGURATION as its configuration file (GRUB-CONFIGURATION
|
||||||
|
must be the name of a file in the VM.)
|
||||||
|
|
||||||
INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
|
INPUTS is a list of inputs (as for packages). When COPY-INPUTS? is true, copy
|
||||||
all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
|
all of INPUTS into the image being built. When REGISTER-CLOSURES? is true,
|
||||||
|
|
@ -243,7 +245,8 @@ the image."
|
||||||
#:copy-closures? #$copy-inputs?
|
#:copy-closures? #$copy-inputs?
|
||||||
#:register-closures? #$register-closures?
|
#:register-closures? #$register-closures?
|
||||||
#:disk-image-size #$disk-image-size
|
#:disk-image-size #$disk-image-size
|
||||||
#:file-system-type #$file-system-type)
|
#:file-system-type #$file-system-type
|
||||||
|
#:file-system-label #$file-system-label)
|
||||||
(reboot))))
|
(reboot))))
|
||||||
#:system system
|
#:system system
|
||||||
#:make-disk-image? #t
|
#:make-disk-image? #t
|
||||||
|
|
@ -258,6 +261,7 @@ the image."
|
||||||
|
|
||||||
(define* (system-disk-image os
|
(define* (system-disk-image os
|
||||||
#:key
|
#:key
|
||||||
|
(name "disk-image")
|
||||||
(file-system-type "ext4")
|
(file-system-type "ext4")
|
||||||
(disk-image-size (* 900 (expt 2 20)))
|
(disk-image-size (* 900 (expt 2 20)))
|
||||||
(volatile? #t))
|
(volatile? #t))
|
||||||
|
|
@ -265,6 +269,12 @@ the image."
|
||||||
system described by OS. Said image can be copied on a USB stick as is. When
|
system described by OS. Said image can be copied on a USB stick as is. When
|
||||||
VOLATILE? is true, the root file system is made volatile; this is useful
|
VOLATILE? is true, the root file system is made volatile; this is useful
|
||||||
to USB sticks meant to be read-only."
|
to USB sticks meant to be read-only."
|
||||||
|
(define root-label
|
||||||
|
;; Volume name of the root file system. Since we don't know which device
|
||||||
|
;; will hold it, we use the volume name to find it (using the UUID would
|
||||||
|
;; be even better, but somewhat less convenient.)
|
||||||
|
"gnu-disk-image")
|
||||||
|
|
||||||
(define file-systems-to-keep
|
(define file-systems-to-keep
|
||||||
(remove (lambda (fs)
|
(remove (lambda (fs)
|
||||||
(string=? (file-system-mount-point fs) "/"))
|
(string=? (file-system-mount-point fs) "/"))
|
||||||
|
|
@ -280,16 +290,19 @@ to USB sticks meant to be read-only."
|
||||||
;; Force our own root file system.
|
;; Force our own root file system.
|
||||||
(file-systems (cons (file-system
|
(file-systems (cons (file-system
|
||||||
(mount-point "/")
|
(mount-point "/")
|
||||||
(device "/dev/sda1")
|
(device root-label)
|
||||||
|
(title 'label)
|
||||||
(type file-system-type))
|
(type file-system-type))
|
||||||
file-systems-to-keep)))))
|
file-systems-to-keep)))))
|
||||||
|
|
||||||
(mlet* %store-monad ((os-drv (operating-system-derivation os))
|
(mlet* %store-monad ((os-drv (operating-system-derivation os))
|
||||||
(grub.cfg (operating-system-grub.cfg os)))
|
(grub.cfg (operating-system-grub.cfg os)))
|
||||||
(qemu-image #:grub-configuration grub.cfg
|
(qemu-image #:name name
|
||||||
|
#:grub-configuration grub.cfg
|
||||||
#:disk-image-size disk-image-size
|
#:disk-image-size disk-image-size
|
||||||
#:disk-image-format "raw"
|
#:disk-image-format "raw"
|
||||||
#:file-system-type file-system-type
|
#:file-system-type file-system-type
|
||||||
|
#:file-system-label root-label
|
||||||
#:copy-inputs? #t
|
#:copy-inputs? #t
|
||||||
#:register-closures? #t
|
#:register-closures? #t
|
||||||
#:inputs `(("system" ,os-drv)
|
#:inputs `(("system" ,os-drv)
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -265,7 +265,8 @@ System: GCC, GNU Make, Bash, Coreutils, etc."
|
||||||
(system (%current-system))
|
(system (%current-system))
|
||||||
(implicit-inputs? #t) ; useful when bootstrapping
|
(implicit-inputs? #t) ; useful when bootstrapping
|
||||||
(imported-modules %default-modules)
|
(imported-modules %default-modules)
|
||||||
(modules %default-modules))
|
(modules %default-modules)
|
||||||
|
allowed-references)
|
||||||
"Return a derivation called NAME that builds from tarball SOURCE, with
|
"Return a derivation called NAME that builds from tarball SOURCE, with
|
||||||
input derivation INPUTS, using the usual procedure of the GNU Build
|
input derivation INPUTS, using the usual procedure of the GNU Build
|
||||||
System. The builder is run with GUILE, or with the distro's final Guile
|
System. The builder is run with GUILE, or with the distro's final Guile
|
||||||
|
|
@ -276,7 +277,10 @@ specifies modules not provided by Guile itself that must be imported in
|
||||||
the builder's environment, from the host. Note that we distinguish
|
the builder's environment, from the host. Note that we distinguish
|
||||||
between both, because for Guile's own modules like (ice-9 foo), we want
|
between both, because for Guile's own modules like (ice-9 foo), we want
|
||||||
to use GUILE's own version of it, rather than import the user's one,
|
to use GUILE's own version of it, rather than import the user's one,
|
||||||
which could lead to gratuitous input divergence."
|
which could lead to gratuitous input divergence.
|
||||||
|
|
||||||
|
ALLOWED-REFERENCES can be either #f, or a list of packages that the outputs
|
||||||
|
are allowed to refer to."
|
||||||
(define implicit-inputs
|
(define implicit-inputs
|
||||||
(and implicit-inputs?
|
(and implicit-inputs?
|
||||||
(parameterize ((%store store))
|
(parameterize ((%store store))
|
||||||
|
|
@ -287,6 +291,16 @@ which could lead to gratuitous input divergence."
|
||||||
(standard-search-paths)
|
(standard-search-paths)
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
|
(define canonicalize-reference
|
||||||
|
(match-lambda
|
||||||
|
((? package? p)
|
||||||
|
(derivation->output-path (package-derivation store p system)))
|
||||||
|
(((? package? p) output)
|
||||||
|
(derivation->output-path (package-derivation store p system)
|
||||||
|
output))
|
||||||
|
((? string? output)
|
||||||
|
output)))
|
||||||
|
|
||||||
(define builder
|
(define builder
|
||||||
`(begin
|
`(begin
|
||||||
(use-modules ,@modules)
|
(use-modules ,@modules)
|
||||||
|
|
@ -337,6 +351,10 @@ which could lead to gratuitous input divergence."
|
||||||
outputs
|
outputs
|
||||||
(delete "debug" outputs))
|
(delete "debug" outputs))
|
||||||
#:modules imported-modules
|
#:modules imported-modules
|
||||||
|
#:allowed-references
|
||||||
|
(and allowed-references
|
||||||
|
(map canonicalize-reference
|
||||||
|
allowed-references))
|
||||||
#:guile-for-build guile-for-build))
|
#:guile-for-build guile-for-build))
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -403,7 +421,8 @@ inputs."
|
||||||
(imported-modules '((guix build gnu-build-system)
|
(imported-modules '((guix build gnu-build-system)
|
||||||
(guix build utils)))
|
(guix build utils)))
|
||||||
(modules '((guix build gnu-build-system)
|
(modules '((guix build gnu-build-system)
|
||||||
(guix build utils))))
|
(guix build utils)))
|
||||||
|
allowed-references)
|
||||||
"Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are
|
"Cross-build NAME for TARGET, where TARGET is a GNU triplet. INPUTS are
|
||||||
cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
|
cross-built inputs, and NATIVE-INPUTS are inputs that run on the build
|
||||||
platform."
|
platform."
|
||||||
|
|
@ -428,6 +447,16 @@ platform."
|
||||||
(standard-cross-search-paths target 'target)
|
(standard-cross-search-paths target 'target)
|
||||||
'()))
|
'()))
|
||||||
|
|
||||||
|
(define canonicalize-reference
|
||||||
|
(match-lambda
|
||||||
|
((? package? p)
|
||||||
|
(derivation->output-path (package-cross-derivation store p system)))
|
||||||
|
(((? package? p) output)
|
||||||
|
(derivation->output-path (package-cross-derivation store p system)
|
||||||
|
output))
|
||||||
|
((? string? output)
|
||||||
|
output)))
|
||||||
|
|
||||||
(define builder
|
(define builder
|
||||||
`(begin
|
`(begin
|
||||||
(use-modules ,@modules)
|
(use-modules ,@modules)
|
||||||
|
|
@ -512,6 +541,10 @@ platform."
|
||||||
outputs
|
outputs
|
||||||
(delete "debug" outputs))
|
(delete "debug" outputs))
|
||||||
#:modules imported-modules
|
#:modules imported-modules
|
||||||
|
#:allowed-references
|
||||||
|
(and allowed-references
|
||||||
|
(map canonicalize-reference
|
||||||
|
allowed-references))
|
||||||
#:guile-for-build guile-for-build))
|
#:guile-for-build guile-for-build))
|
||||||
|
|
||||||
(define gnu-build-system
|
(define gnu-build-system
|
||||||
|
|
|
||||||
|
|
@ -126,7 +126,8 @@ numeric gid or #f."
|
||||||
;; Then create the groups.
|
;; Then create the groups.
|
||||||
(for-each (match-lambda
|
(for-each (match-lambda
|
||||||
((name password gid)
|
((name password gid)
|
||||||
(add-group name #:gid gid #:password password)))
|
(unless (false-if-exception (getgrnam name))
|
||||||
|
(add-group name #:gid gid #:password password))))
|
||||||
groups)
|
groups)
|
||||||
|
|
||||||
;; Finally create the other user accounts.
|
;; Finally create the other user accounts.
|
||||||
|
|
|
||||||
|
|
@ -73,7 +73,10 @@ directory TARGET."
|
||||||
(define (directives store)
|
(define (directives store)
|
||||||
"Return a list of directives to populate the root file system that will host
|
"Return a list of directives to populate the root file system that will host
|
||||||
STORE."
|
STORE."
|
||||||
`((directory ,store 0 0)
|
`(;; Note: the store's GID is fixed precisely so we can set it here rather
|
||||||
|
;; than at activation time.
|
||||||
|
(directory ,store 0 30000)
|
||||||
|
|
||||||
(directory "/etc")
|
(directory "/etc")
|
||||||
(directory "/var/log") ; for dmd
|
(directory "/var/log") ; for dmd
|
||||||
(directory "/var/guix/gcroots")
|
(directory "/var/guix/gcroots")
|
||||||
|
|
|
||||||
|
|
@ -18,12 +18,14 @@
|
||||||
|
|
||||||
(define-module (guix build linux-initrd)
|
(define-module (guix build linux-initrd)
|
||||||
#:use-module (rnrs io ports)
|
#:use-module (rnrs io ports)
|
||||||
|
#:use-module (rnrs bytevectors)
|
||||||
#:use-module (system foreign)
|
#:use-module (system foreign)
|
||||||
#:autoload (system repl repl) (start-repl)
|
#:autoload (system repl repl) (start-repl)
|
||||||
#:autoload (system base compile) (compile-file)
|
#:autoload (system base compile) (compile-file)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:use-module (ice-9 rdelim)
|
||||||
#:use-module (ice-9 ftw)
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (guix build utils)
|
#:use-module (guix build utils)
|
||||||
#:export (mount-essential-file-systems
|
#:export (mount-essential-file-systems
|
||||||
|
|
@ -31,9 +33,16 @@
|
||||||
find-long-option
|
find-long-option
|
||||||
make-essential-device-nodes
|
make-essential-device-nodes
|
||||||
configure-qemu-networking
|
configure-qemu-networking
|
||||||
|
|
||||||
|
disk-partitions
|
||||||
|
partition-label-predicate
|
||||||
|
find-partition-by-label
|
||||||
|
canonicalize-device-spec
|
||||||
|
|
||||||
check-file-system
|
check-file-system
|
||||||
mount-file-system
|
mount-file-system
|
||||||
bind-mount
|
bind-mount
|
||||||
|
|
||||||
load-linux-module*
|
load-linux-module*
|
||||||
device-number
|
device-number
|
||||||
boot-system))
|
boot-system))
|
||||||
|
|
@ -88,6 +97,169 @@ Return the value associated with OPTION, or #f on failure."
|
||||||
(lambda (arg)
|
(lambda (arg)
|
||||||
(substring arg (+ 1 (string-index arg #\=)))))))
|
(substring arg (+ 1 (string-index arg #\=)))))))
|
||||||
|
|
||||||
|
(define-syntax %ext2-endianness
|
||||||
|
;; Endianness of ext2 file systems.
|
||||||
|
(identifier-syntax (endianness little)))
|
||||||
|
|
||||||
|
;; Offset in bytes of interesting parts of an ext2 superblock. See
|
||||||
|
;; <http://www.nongnu.org/ext2-doc/ext2.html#DEF-SUPERBLOCK>.
|
||||||
|
;; TODO: Use "packed structs" from Guile-OpenGL or similar.
|
||||||
|
(define-syntax %ext2-sblock-magic (identifier-syntax 56))
|
||||||
|
(define-syntax %ext2-sblock-creator-os (identifier-syntax 72))
|
||||||
|
(define-syntax %ext2-sblock-uuid (identifier-syntax 104))
|
||||||
|
(define-syntax %ext2-sblock-volume-name (identifier-syntax 120))
|
||||||
|
|
||||||
|
(define (read-ext2-superblock device)
|
||||||
|
"Return the raw contents of DEVICE's ext2 superblock as a bytevector, or #f
|
||||||
|
if DEVICE does not contain an ext2 file system."
|
||||||
|
(define %ext2-magic
|
||||||
|
;; The magic bytes that identify an ext2 file system.
|
||||||
|
#xef53)
|
||||||
|
|
||||||
|
(call-with-input-file device
|
||||||
|
(lambda (port)
|
||||||
|
(seek port 1024 SEEK_SET)
|
||||||
|
(let* ((block (get-bytevector-n port 264))
|
||||||
|
(magic (bytevector-u16-ref block %ext2-sblock-magic
|
||||||
|
%ext2-endianness)))
|
||||||
|
(and (= magic %ext2-magic)
|
||||||
|
block)))))
|
||||||
|
|
||||||
|
(define (ext2-superblock-uuid sblock)
|
||||||
|
"Return the UUID of ext2 superblock SBLOCK as a 16-byte bytevector."
|
||||||
|
(let ((uuid (make-bytevector 16)))
|
||||||
|
(bytevector-copy! sblock %ext2-sblock-uuid uuid 0 16)
|
||||||
|
uuid))
|
||||||
|
|
||||||
|
(define (ext2-superblock-volume-name sblock)
|
||||||
|
"Return the volume name of SBLOCK as a string of at most 16 characters, or
|
||||||
|
#f if SBLOCK has no volume name."
|
||||||
|
(let ((bv (make-bytevector 16)))
|
||||||
|
(bytevector-copy! sblock %ext2-sblock-volume-name bv 0 16)
|
||||||
|
|
||||||
|
;; This is a Latin-1, nul-terminated string.
|
||||||
|
(let ((bytes (take-while (negate zero?) (bytevector->u8-list bv))))
|
||||||
|
(if (null? bytes)
|
||||||
|
#f
|
||||||
|
(list->string (map integer->char bytes))))))
|
||||||
|
|
||||||
|
(define (disk-partitions)
|
||||||
|
"Return the list of device names corresponding to valid disk partitions."
|
||||||
|
(define (partition? major minor)
|
||||||
|
(let ((marker (format #f "/sys/dev/block/~a:~a/partition" major minor)))
|
||||||
|
(catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
(not (zero? (call-with-input-file marker read))))
|
||||||
|
(lambda args
|
||||||
|
(if (= ENOENT (system-error-errno args))
|
||||||
|
#f
|
||||||
|
(apply throw args))))))
|
||||||
|
|
||||||
|
(call-with-input-file "/proc/partitions"
|
||||||
|
(lambda (port)
|
||||||
|
;; Skip the two header lines.
|
||||||
|
(read-line port)
|
||||||
|
(read-line port)
|
||||||
|
|
||||||
|
;; Read each subsequent line, and extract the last space-separated
|
||||||
|
;; field.
|
||||||
|
(let loop ((parts '()))
|
||||||
|
(let ((line (read-line port)))
|
||||||
|
(if (eof-object? line)
|
||||||
|
(reverse parts)
|
||||||
|
(match (string-tokenize line)
|
||||||
|
(((= string->number major) (= string->number minor)
|
||||||
|
blocks name)
|
||||||
|
(if (partition? major minor)
|
||||||
|
(loop (cons name parts))
|
||||||
|
(loop parts))))))))))
|
||||||
|
|
||||||
|
(define (partition-label-predicate label)
|
||||||
|
"Return a procedure that, when applied to a partition name such as \"sda1\",
|
||||||
|
return #t if that partition's volume name is LABEL."
|
||||||
|
(lambda (part)
|
||||||
|
(let* ((device (string-append "/dev/" part))
|
||||||
|
(sblock (catch 'system-error
|
||||||
|
(lambda ()
|
||||||
|
(read-ext2-superblock device))
|
||||||
|
(lambda args
|
||||||
|
;; When running on the hand-made /dev,
|
||||||
|
;; 'disk-partitions' could return partitions for which
|
||||||
|
;; we have no /dev node. Handle that gracefully.
|
||||||
|
(if (= ENOENT (system-error-errno args))
|
||||||
|
(begin
|
||||||
|
(format (current-error-port)
|
||||||
|
"warning: device '~a' not found~%"
|
||||||
|
device)
|
||||||
|
#f)
|
||||||
|
(apply throw args))))))
|
||||||
|
(and sblock
|
||||||
|
(let ((volume (ext2-superblock-volume-name sblock)))
|
||||||
|
(and volume
|
||||||
|
(string=? volume label)))))))
|
||||||
|
|
||||||
|
(define (find-partition-by-label label)
|
||||||
|
"Return the first partition found whose volume name is LABEL, or #f if none
|
||||||
|
were found."
|
||||||
|
(and=> (find (partition-label-predicate label)
|
||||||
|
(disk-partitions))
|
||||||
|
(cut string-append "/dev/" <>)))
|
||||||
|
|
||||||
|
(define* (canonicalize-device-spec spec #:optional (title 'any))
|
||||||
|
"Return the device name corresponding to SPEC. TITLE is a symbol, one of
|
||||||
|
the following:
|
||||||
|
|
||||||
|
• 'device', in which case SPEC is known to designate a device node--e.g.,
|
||||||
|
\"/dev/sda1\";
|
||||||
|
• 'label', in which case SPEC is known to designate a partition label--e.g.,
|
||||||
|
\"my-root-part\";
|
||||||
|
• 'any', in which case SPEC can be anything.
|
||||||
|
"
|
||||||
|
(define max-trials
|
||||||
|
;; Number of times we retry partition label resolution.
|
||||||
|
7)
|
||||||
|
|
||||||
|
(define canonical-title
|
||||||
|
;; The realm of canonicalization.
|
||||||
|
(if (eq? title 'any)
|
||||||
|
(if (string-prefix? "/" spec)
|
||||||
|
'device
|
||||||
|
'label)
|
||||||
|
title))
|
||||||
|
|
||||||
|
(case canonical-title
|
||||||
|
((device)
|
||||||
|
;; Nothing to do.
|
||||||
|
spec)
|
||||||
|
((label)
|
||||||
|
;; Resolve the label.
|
||||||
|
(let loop ((count 0))
|
||||||
|
(let ((device (find-partition-by-label spec)))
|
||||||
|
(or device
|
||||||
|
;; Some devices take a bit of time to appear, most notably USB
|
||||||
|
;; storage devices. Thus, wait for the device to appear.
|
||||||
|
(if (> count max-trials)
|
||||||
|
(begin
|
||||||
|
(format (current-error-port)
|
||||||
|
"failed to resolve partition label: ~s~%" spec)
|
||||||
|
(start-repl))
|
||||||
|
(begin
|
||||||
|
(sleep 1)
|
||||||
|
(loop (+ 1 count))))))))
|
||||||
|
;; TODO: Add support for UUIDs.
|
||||||
|
(else
|
||||||
|
(error "unknown device title" title))))
|
||||||
|
|
||||||
|
(define* (make-disk-device-nodes base major #:optional (minor 0))
|
||||||
|
"Make the block device nodes around BASE (something like \"/root/dev/sda\")
|
||||||
|
with the given MAJOR number, starting with MINOR."
|
||||||
|
(mknod base 'block-special #o644 (device-number major minor))
|
||||||
|
(let loop ((i 1))
|
||||||
|
(when (< i 6)
|
||||||
|
(mknod (string-append base (number->string i))
|
||||||
|
'block-special #o644 (device-number major (+ minor i)))
|
||||||
|
(loop (+ i 1)))))
|
||||||
|
|
||||||
(define* (make-essential-device-nodes #:key (root "/"))
|
(define* (make-essential-device-nodes #:key (root "/"))
|
||||||
"Make essential device nodes under ROOT/dev."
|
"Make essential device nodes under ROOT/dev."
|
||||||
;; The hand-made udev!
|
;; The hand-made udev!
|
||||||
|
|
@ -103,14 +275,17 @@ Return the value associated with OPTION, or #f on failure."
|
||||||
(mkdir (scope "dev")))
|
(mkdir (scope "dev")))
|
||||||
|
|
||||||
;; Make the device nodes for SCSI disks.
|
;; Make the device nodes for SCSI disks.
|
||||||
(mknod (scope "dev/sda") 'block-special #o644 (device-number 8 0))
|
(make-disk-device-nodes (scope "dev/sda") 8)
|
||||||
(mknod (scope "dev/sda1") 'block-special #o644 (device-number 8 1))
|
(make-disk-device-nodes (scope "dev/sdb") 8 16)
|
||||||
(mknod (scope "dev/sda2") 'block-special #o644 (device-number 8 2))
|
(make-disk-device-nodes (scope "dev/sdc") 8 32)
|
||||||
|
(make-disk-device-nodes (scope "dev/sdd") 8 48)
|
||||||
|
|
||||||
|
;; SCSI CD-ROM devices (aka. "/dev/sr0" etc.).
|
||||||
|
(mknod (scope "dev/scd0") 'block-special #o644 (device-number 11 0))
|
||||||
|
(mknod (scope "dev/scd1") 'block-special #o644 (device-number 11 1))
|
||||||
|
|
||||||
;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM.
|
;; The virtio (para-virtualized) block devices, as supported by QEMU/KVM.
|
||||||
(mknod (scope "dev/vda") 'block-special #o644 (device-number 252 0))
|
(make-disk-device-nodes (scope "dev/vda") 252)
|
||||||
(mknod (scope "dev/vda1") 'block-special #o644 (device-number 252 1))
|
|
||||||
(mknod (scope "dev/vda2") 'block-special #o644 (device-number 252 2))
|
|
||||||
|
|
||||||
;; Memory (used by Xorg's VESA driver.)
|
;; Memory (used by Xorg's VESA driver.)
|
||||||
(mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1))
|
(mknod (scope "dev/mem") 'char-special #o640 (device-number 1 1))
|
||||||
|
|
@ -123,6 +298,12 @@ Return the value associated with OPTION, or #f on failure."
|
||||||
(mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32))
|
(mknod (scope "dev/input/mouse0") 'char-special #o640 (device-number 13 32))
|
||||||
(mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64))
|
(mknod (scope "dev/input/event0") 'char-special #o640 (device-number 13 64))
|
||||||
|
|
||||||
|
;; System console. This node is magically created by the kernel on the
|
||||||
|
;; initrd's root, so don't try to create it in that case.
|
||||||
|
(unless (string=? root "/")
|
||||||
|
(mknod (scope "dev/console") 'char-special #o600
|
||||||
|
(device-number 5 1)))
|
||||||
|
|
||||||
;; TTYs.
|
;; TTYs.
|
||||||
(mknod (scope "dev/tty") 'char-special #o600
|
(mknod (scope "dev/tty") 'char-special #o600
|
||||||
(device-number 5 0))
|
(device-number 5 0))
|
||||||
|
|
@ -305,7 +486,7 @@ UNIONFS."
|
||||||
"Mount the file system described by SPEC under ROOT. SPEC must have the
|
"Mount the file system described by SPEC under ROOT. SPEC must have the
|
||||||
form:
|
form:
|
||||||
|
|
||||||
(DEVICE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
|
(DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?)
|
||||||
|
|
||||||
DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
|
DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f;
|
||||||
FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to
|
FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to
|
||||||
|
|
@ -320,8 +501,9 @@ run a file system check."
|
||||||
0)))
|
0)))
|
||||||
|
|
||||||
(match spec
|
(match spec
|
||||||
((source mount-point type (flags ...) options check?)
|
((source title mount-point type (flags ...) options check?)
|
||||||
(let ((mount-point (string-append root "/" mount-point)))
|
(let ((source (canonicalize-device-spec source title))
|
||||||
|
(mount-point (string-append root "/" mount-point)))
|
||||||
(when check?
|
(when check?
|
||||||
(check-file-system source type))
|
(check-file-system source type))
|
||||||
(mkdir-p mount-point)
|
(mkdir-p mount-point)
|
||||||
|
|
@ -381,6 +563,7 @@ bailing out.~%root contents: ~s~%" (scandir "/"))
|
||||||
|
|
||||||
(close-port console))))
|
(close-port console))))
|
||||||
|
|
||||||
|
|
||||||
(define* (boot-system #:key
|
(define* (boot-system #:key
|
||||||
(linux-modules '())
|
(linux-modules '())
|
||||||
qemu-guest-networking?
|
qemu-guest-networking?
|
||||||
|
|
@ -414,12 +597,12 @@ to it are lost."
|
||||||
|
|
||||||
(define root-mount-point?
|
(define root-mount-point?
|
||||||
(match-lambda
|
(match-lambda
|
||||||
((device "/" _ ...) #t)
|
((device _ "/" _ ...) #t)
|
||||||
(_ #f)))
|
(_ #f)))
|
||||||
|
|
||||||
(define root-fs-type
|
(define root-fs-type
|
||||||
(or (any (match-lambda
|
(or (any (match-lambda
|
||||||
((device "/" type _ ...) type)
|
((device _ "/" type _ ...) type)
|
||||||
(_ #f))
|
(_ #f))
|
||||||
mounts)
|
mounts)
|
||||||
"ext4"))
|
"ext4"))
|
||||||
|
|
@ -451,7 +634,8 @@ to it are lost."
|
||||||
(unless (file-exists? "/root")
|
(unless (file-exists? "/root")
|
||||||
(mkdir "/root"))
|
(mkdir "/root"))
|
||||||
(if root
|
(if root
|
||||||
(mount-root-file-system root root-fs-type
|
(mount-root-file-system (canonicalize-device-spec root)
|
||||||
|
root-fs-type
|
||||||
#:volatile-root? volatile-root?)
|
#:volatile-root? volatile-root?)
|
||||||
(mount "none" "/root" "tmpfs"))
|
(mount "none" "/root" "tmpfs"))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -158,10 +158,16 @@ REFERENCE-GRAPHS, a list of reference-graph files."
|
||||||
|
|
||||||
(define MS_BIND 4096) ; <sys/mounts.h> again!
|
(define MS_BIND 4096) ; <sys/mounts.h> again!
|
||||||
|
|
||||||
(define (format-partition partition type)
|
(define* (format-partition partition type
|
||||||
"Create a file system TYPE on PARTITION."
|
#:key label)
|
||||||
|
"Create a file system TYPE on PARTITION. If LABEL is true, use that as the
|
||||||
|
volume name."
|
||||||
(format #t "creating ~a partition...\n" type)
|
(format #t "creating ~a partition...\n" type)
|
||||||
(unless (zero? (system* (string-append "mkfs." type) "-F" partition))
|
(unless (zero? (apply system* (string-append "mkfs." type)
|
||||||
|
"-F" partition
|
||||||
|
(if label
|
||||||
|
`("-L" ,label)
|
||||||
|
'())))
|
||||||
(error "failed to create partition")))
|
(error "failed to create partition")))
|
||||||
|
|
||||||
(define* (initialize-root-partition target-directory
|
(define* (initialize-root-partition target-directory
|
||||||
|
|
@ -204,13 +210,15 @@ REFERENCE-GRAPHS, a list of reference-graph files."
|
||||||
grub.cfg
|
grub.cfg
|
||||||
disk-image-size
|
disk-image-size
|
||||||
(file-system-type "ext4")
|
(file-system-type "ext4")
|
||||||
|
file-system-label
|
||||||
(closures '())
|
(closures '())
|
||||||
copy-closures?
|
copy-closures?
|
||||||
(register-closures? #t))
|
(register-closures? #t))
|
||||||
"Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a
|
"Initialize DEVICE, a disk of DISK-IMAGE-SIZE bytes, with a FILE-SYSTEM-TYPE
|
||||||
FILE-SYSTEM-TYPE partition, and with GRUB installed. If REGISTER-CLOSURES? is
|
partition with (optionally) FILE-SYSTEM-LABEL as its volume name, and with
|
||||||
true, register all of CLOSURES is the partition's store. If COPY-CLOSURES? is
|
GRUB installed. If REGISTER-CLOSURES? is true, register all of CLOSURES is
|
||||||
true, copy all of CLOSURES to the partition."
|
the partition's store. If COPY-CLOSURES? is true, copy all of CLOSURES to the
|
||||||
|
partition."
|
||||||
(define target-directory
|
(define target-directory
|
||||||
"/fs")
|
"/fs")
|
||||||
|
|
||||||
|
|
@ -220,7 +228,8 @@ true, copy all of CLOSURES to the partition."
|
||||||
(initialize-partition-table device
|
(initialize-partition-table device
|
||||||
(- disk-image-size (* 5 (expt 2 20))))
|
(- disk-image-size (* 5 (expt 2 20))))
|
||||||
|
|
||||||
(format-partition partition file-system-type)
|
(format-partition partition file-system-type
|
||||||
|
#:label file-system-label)
|
||||||
|
|
||||||
(display "mounting partition...\n")
|
(display "mounting partition...\n")
|
||||||
(mkdir target-directory)
|
(mkdir target-directory)
|
||||||
|
|
|
||||||
|
|
@ -565,7 +565,7 @@ HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for
|
||||||
(system (%current-system)) (env-vars '())
|
(system (%current-system)) (env-vars '())
|
||||||
(inputs '()) (outputs '("out"))
|
(inputs '()) (outputs '("out"))
|
||||||
hash hash-algo recursive?
|
hash hash-algo recursive?
|
||||||
references-graphs
|
references-graphs allowed-references
|
||||||
local-build?)
|
local-build?)
|
||||||
"Build a derivation with the given arguments, and return the resulting
|
"Build a derivation with the given arguments, and return the resulting
|
||||||
<derivation> object. When HASH and HASH-ALGO are given, a
|
<derivation> object. When HASH and HASH-ALGO are given, a
|
||||||
|
|
@ -578,6 +578,9 @@ When REFERENCES-GRAPHS is true, it must be a list of file name/store path
|
||||||
pairs. In that case, the reference graph of each store path is exported in
|
pairs. In that case, the reference graph of each store path is exported in
|
||||||
the build environment in the corresponding file, in a simple text format.
|
the build environment in the corresponding file, in a simple text format.
|
||||||
|
|
||||||
|
When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
|
||||||
|
that the derivation's output may refer to.
|
||||||
|
|
||||||
When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
|
When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
|
||||||
for offloading and should rather be built locally. This is the case for small
|
for offloading and should rather be built locally. This is the case for small
|
||||||
derivations where the costs of data transfers would outweigh the benefits."
|
derivations where the costs of data transfers would outweigh the benefits."
|
||||||
|
|
@ -615,10 +618,14 @@ derivations where the costs of data transfers would outweigh the benefits."
|
||||||
;; Some options are passed to the build daemon via the env. vars of
|
;; Some options are passed to the build daemon via the env. vars of
|
||||||
;; derivations (urgh!). We hide that from our API, but here is the place
|
;; derivations (urgh!). We hide that from our API, but here is the place
|
||||||
;; where we kludgify those options.
|
;; where we kludgify those options.
|
||||||
(let ((env-vars (if local-build?
|
(let ((env-vars `(,@(if local-build?
|
||||||
`(("preferLocalBuild" . "1")
|
`(("preferLocalBuild" . "1"))
|
||||||
,@env-vars)
|
'())
|
||||||
env-vars)))
|
,@(if allowed-references
|
||||||
|
`(("allowedReferences"
|
||||||
|
. ,(string-join allowed-references)))
|
||||||
|
'())
|
||||||
|
,@env-vars)))
|
||||||
(match references-graphs
|
(match references-graphs
|
||||||
(((file . path) ...)
|
(((file . path) ...)
|
||||||
(let ((value (map (cut string-append <> " " <>)
|
(let ((value (map (cut string-append <> " " <>)
|
||||||
|
|
@ -955,6 +962,7 @@ they can refer to each other."
|
||||||
(modules '())
|
(modules '())
|
||||||
guile-for-build
|
guile-for-build
|
||||||
references-graphs
|
references-graphs
|
||||||
|
allowed-references
|
||||||
local-build?)
|
local-build?)
|
||||||
"Return a derivation that executes Scheme expression EXP as a builder
|
"Return a derivation that executes Scheme expression EXP as a builder
|
||||||
for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
|
for derivation NAME. INPUTS must be a list of (NAME DRV-PATH SUB-DRV)
|
||||||
|
|
@ -974,8 +982,8 @@ EXP returns #f, the build is considered to have failed.
|
||||||
EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
|
EXP is built using GUILE-FOR-BUILD (a derivation). When GUILE-FOR-BUILD is
|
||||||
omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
|
omitted or is #f, the value of the `%guile-for-build' fluid is used instead.
|
||||||
|
|
||||||
See the `derivation' procedure for the meaning of REFERENCES-GRAPHS and
|
See the `derivation' procedure for the meaning of REFERENCES-GRAPHS,
|
||||||
LOCAL-BUILD?."
|
ALLOWED-REFERENCES, and LOCAL-BUILD?."
|
||||||
(define guile-drv
|
(define guile-drv
|
||||||
(or guile-for-build (%guile-for-build)))
|
(or guile-for-build (%guile-for-build)))
|
||||||
|
|
||||||
|
|
@ -1100,4 +1108,5 @@ LOCAL-BUILD?."
|
||||||
#:recursive? recursive?
|
#:recursive? recursive?
|
||||||
#:outputs outputs
|
#:outputs outputs
|
||||||
#:references-graphs references-graphs
|
#:references-graphs references-graphs
|
||||||
|
#:allowed-references allowed-references
|
||||||
#:local-build? local-build?)))
|
#:local-build? local-build?)))
|
||||||
|
|
|
||||||
|
|
@ -351,6 +351,10 @@ its search path."
|
||||||
(gexp
|
(gexp
|
||||||
(call-with-output-file (ungexp output)
|
(call-with-output-file (ungexp output)
|
||||||
(lambda (port)
|
(lambda (port)
|
||||||
|
;; Note: that makes a long shebang. When the store
|
||||||
|
;; is /gnu/store, that fits within the 128-byte
|
||||||
|
;; limit imposed by Linux, but that may go beyond
|
||||||
|
;; when running tests.
|
||||||
(format port
|
(format port
|
||||||
"#!~a/bin/guile --no-auto-compile~%!#~%"
|
"#!~a/bin/guile --no-auto-compile~%!#~%"
|
||||||
(ungexp guile))
|
(ungexp guile))
|
||||||
|
|
|
||||||
|
|
@ -390,6 +390,43 @@
|
||||||
((p2 . _)
|
((p2 . _)
|
||||||
(string<? p1 p2)))))))))))))))
|
(string<? p1 p2)))))))))))))))
|
||||||
|
|
||||||
|
(test-assert "derivation #:allowed-references, ok"
|
||||||
|
(let ((drv (derivation %store "allowed" %bash
|
||||||
|
'("-c" "echo hello > $out")
|
||||||
|
#:inputs `((,%bash))
|
||||||
|
#:allowed-references '())))
|
||||||
|
(build-derivations %store (list drv))))
|
||||||
|
|
||||||
|
(test-assert "derivation #:allowed-references, not allowed"
|
||||||
|
(let* ((txt (add-text-to-store %store "foo" "Hello, world."))
|
||||||
|
(drv (derivation %store "disallowed" %bash
|
||||||
|
`("-c" ,(string-append "echo " txt "> $out"))
|
||||||
|
#:inputs `((,%bash) (,txt))
|
||||||
|
#:allowed-references '())))
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
;; There's no specific error message to check for.
|
||||||
|
#t))
|
||||||
|
(build-derivations %store (list drv))
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
(test-assert "derivation #:allowed-references, self allowed"
|
||||||
|
(let ((drv (derivation %store "allowed" %bash
|
||||||
|
'("-c" "echo $out > $out")
|
||||||
|
#:inputs `((,%bash))
|
||||||
|
#:allowed-references '("out"))))
|
||||||
|
(build-derivations %store (list drv))))
|
||||||
|
|
||||||
|
(test-assert "derivation #:allowed-references, self not allowed"
|
||||||
|
(let ((drv (derivation %store "disallowed" %bash
|
||||||
|
`("-c" ,"echo $out > $out")
|
||||||
|
#:inputs `((,%bash))
|
||||||
|
#:allowed-references '())))
|
||||||
|
(guard (c ((nix-protocol-error? c)
|
||||||
|
;; There's no specific error message to check for.
|
||||||
|
#t))
|
||||||
|
(build-derivations %store (list drv))
|
||||||
|
#f)))
|
||||||
|
|
||||||
|
|
||||||
(define %coreutils
|
(define %coreutils
|
||||||
(false-if-exception
|
(false-if-exception
|
||||||
|
|
|
||||||
|
|
@ -211,6 +211,14 @@
|
||||||
(return (string=? (readlink (string-append out "/foo"))
|
(return (string=? (readlink (string-append out "/foo"))
|
||||||
guile))))
|
guile))))
|
||||||
|
|
||||||
|
(define shebang
|
||||||
|
(string-append (derivation->output-path guile-for-build)
|
||||||
|
"/bin/guile --no-auto-compile"))
|
||||||
|
|
||||||
|
;; If we're going to hit the silly shebang limit (128 chars on Linux-based
|
||||||
|
;; systems), then skip the following test.
|
||||||
|
(test-skip (if (> (string-length shebang) 127) 1 0))
|
||||||
|
|
||||||
(test-assertm "gexp->script"
|
(test-assertm "gexp->script"
|
||||||
(mlet* %store-monad ((n -> (random (expt 2 50)))
|
(mlet* %store-monad ((n -> (random (expt 2 50)))
|
||||||
(exp -> (gexp
|
(exp -> (gexp
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue