diff options
| -rw-r--r-- | Makefile.am | 4 | ||||
| -rw-r--r-- | TODO | 13 | ||||
| -rw-r--r-- | distro/packages/linux.scm | 69 | ||||
| -rw-r--r-- | distro/packages/lsh.scm | 125 | ||||
| -rw-r--r-- | distro/packages/patches/lsh-guile-compat.patch | 9 | ||||
| -rw-r--r-- | distro/packages/patches/lsh-no-root-login.patch | 16 | ||||
| -rw-r--r-- | distro/packages/patches/lsh-pam-service-name.patch | 14 | ||||
| -rw-r--r-- | guix-build.in | 149 | ||||
| -rw-r--r-- | guix/derivations.scm | 3 | ||||
| -rw-r--r-- | guix/store.scm | 6 | ||||
| -rw-r--r-- | tests/derivations.scm | 23 | ||||
| -rw-r--r-- | tests/packages.scm | 17 |
12 files changed, 368 insertions, 80 deletions
diff --git a/Makefile.am b/Makefile.am index 147ba1949e..101ac1dfdb 100644 --- a/Makefile.am +++ b/Makefile.am @@ -67,6 +67,7 @@ MODULES = \ distro/packages/libunistring.scm \ distro/packages/linux.scm \ distro/packages/lout.scm \ + distro/packages/lsh.scm \ distro/packages/m4.scm \ distro/packages/make-bootstrap.scm \ distro/packages/multiprecision.scm \ @@ -103,6 +104,9 @@ dist_patch_DATA = \ distro/packages/patches/guile-default-utf8.patch \ distro/packages/patches/guile-relocatable.patch \ distro/packages/patches/libtool-skip-tests.patch \ + distro/packages/patches/lsh-guile-compat.patch \ + distro/packages/patches/lsh-no-root-login.patch \ + distro/packages/patches/lsh-pam-service-name.patch \ distro/packages/patches/m4-gets-undeclared.patch \ distro/packages/patches/m4-readlink-EINVAL.patch \ distro/packages/patches/m4-s_isdir.patch \ diff --git a/TODO b/TODO index cecea9636f..f0088a5ae2 100644 --- a/TODO +++ b/TODO @@ -51,6 +51,19 @@ This should specify builder code to be run when building a user environment with ‘guix-package’. For instance, Texinfo’s hook would create a new ‘dir’. +** add ‘patches’ there + +** extend ‘propagated-build-inputs’ with support for multiple outputs + +#+BEGIN_SRC scheme + (outputs '("out" "include")) + (propagated-build-inputs + `(((("i1" ,p1 "o1") + ("i2" ,p2)) + => "include") + ("i3" ,p3))) +#+END_SRC + * support cross-compilation Implement ‘package-cross-derivation’, and add the corresponding code in diff --git a/distro/packages/linux.scm b/distro/packages/linux.scm index 54a0606a11..d6669312dc 100644 --- a/distro/packages/linux.scm +++ b/distro/packages/linux.scm @@ -1,5 +1,6 @@ ;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- ;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; Copyright (C) 2012 Nikita Karetnikov <nikita@karetnikov.org> ;;; ;;; This file is part of Guix. ;;; @@ -17,10 +18,13 @@ ;;; along with Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (distro packages linux) - #:use-module (guix packages) - #:use-module (guix download) + #:use-module (distro packages compression) #:use-module (distro packages flex) + #:use-module (distro packages ncurses) #:use-module (distro packages perl) + #:use-module (distro packages ncurses) + #:use-module (guix packages) + #:use-module (guix download) #:use-module (guix build-system gnu)) (define-public linux-libre-headers @@ -104,3 +108,64 @@ Pluggable authentication modules are small shared object files that can be used through the PAM API to perform tasks, like authenticating a user at login. Local and dynamic reconfiguration are its key features") (license "BSD"))) + +(define-public psmisc + (package + (name "psmisc") + (version "22.20") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://sourceforge/psmisc/psmisc/psmisc-" + version ".tar.gz")) + (sha256 + (base32 + "052mfraykmxnavpi8s78aljx8w87hyvpx8mvzsgpjsjz73i28wmi")))) + (build-system gnu-build-system) + (inputs `(("ncurses" ,ncurses))) + (home-page "http://psmisc.sourceforge.net/") + (synopsis + "set of utilities that use the proc filesystem, such as fuser, killall, and pstree") + (description + "This PSmisc package is a set of some small useful utilities that +use the proc filesystem. We're not about changing the world, but +providing the system administrator with some help in common tasks.") + (license "GPLv2+"))) + +(define-public util-linux + (package + (name "util-linux") + (version "2.21") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://kernel.org/linux/utils/" + name "/v" version "/" + name "-" version ".2" ".tar.xz")) + (sha256 + (base32 + "1rpgghf7n0zx0cdy8hibr41wvkm2qp1yvd8ab1rxr193l1jmgcir")))) + (build-system gnu-build-system) + (arguments + `(#:configure-flags '("--disable-use-tty-group") + #:phases (alist-cons-after + 'install 'patch-chkdupexe + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "out"))) + (substitute* (string-append out "/bin/chkdupexe") + ;; Allow 'patch-shebang' to do its work. + (("@PERL@") "/bin/perl")))) + %standard-phases))) + (inputs `(("zlib" ,zlib) + ("ncurses" ,ncurses) + ("perl" ,perl))) + (home-page "https://www.kernel.org/pub/linux/utils/util-linux/") + (synopsis + "util-linux is a random collection of utilities for the Linux kernel") + (description + "util-linux is a random collection of utilities for the Linux kernel.") + ;; Note that util-linux doesn't use the same license for all the + ;; code. GPLv2+ is the default license for a code without an + ;; explicitly defined license. + (license '("GPLv3+" "GPLv2+" "GPLv2" "LGPLv2+" + "BSD-original" "Public Domain")))) diff --git a/distro/packages/lsh.scm b/distro/packages/lsh.scm new file mode 100644 index 0000000000..f6caf52caf --- /dev/null +++ b/distro/packages/lsh.scm @@ -0,0 +1,125 @@ +;;; Guix --- Nix package management from Guile. -*- coding: utf-8 -*- +;;; Copyright (C) 2012 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Guix. +;;; +;;; 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. +;;; +;;; 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 Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (distro packages lsh) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (distro) + #:use-module (distro packages m4) + #:use-module (distro packages linux) + #:use-module (distro packages compression) + #:use-module (distro packages multiprecision) + #:use-module (distro packages readline) + #:use-module (distro packages gperf) + #:use-module (distro packages base)) + +(define-public liboop + (package + (name "liboop") + (version "1.0") + (source + (origin + (method url-fetch) + (uri (string-append "http://download.ofb.net/liboop/liboop-" + version ".tar.gz")) + (sha256 + (base32 + "0z6rlalhvfca64jpvksppc9bdhs7jwhiw4y35g5ibvh91xp3rn1l")))) + (build-system gnu-build-system) + (home-page "http://liboop.ofb.net/") + (synopsis "`liboop', an event loop library") + (description "liboop is an event loop library.") + (license "LGPLv2.1+"))) + +(define-public lsh + (package + (name "lsh") + (version "2.0.4") + (source + (origin + (method url-fetch) + (uri (string-append "mirror://gnu/lsh/lsh-" + version ".tar.gz")) + (sha256 + (base32 + "149hf49xcj99wwvi7hcb59igq4vpyv8har1br1if3lrsw5irsjv1")))) + (build-system gnu-build-system) + (inputs + `(("linux-pam" ,linux-pam) + ("m4" ,m4) + ("readline" ,readline) + ("liboop" ,liboop) + ("zlib" ,zlib) + ("gmp" ,gmp) + ("guile" ,guile-final) + ("gperf" ,gperf) + ("psmisc" ,psmisc) ; for `killall' + + ("patch/no-root-login" ,(search-patch "lsh-no-root-login.patch")) + ("patch/guile-compat" ,(search-patch "lsh-guile-compat.patch")) + ("patch/pam-service-name" + ,(search-patch "lsh-pam-service-name.patch")))) + (arguments + '(#:patches (list (assoc-ref %build-inputs "patch/no-root-login") + (assoc-ref %build-inputs "patch/pam-service-name") + (assoc-ref %build-inputs "patch/guile-compat")) + + ;; Skip the `configure' test that checks whether /dev/ptmx & + ;; co. work as expected, because it relies on impurities (for + ;; instance, /dev/pts may be unavailable in chroots.) + #:configure-flags '("lsh_cv_sys_unix98_ptys=yes") + + ;; FIXME: Tests won't run in a chroot, presumably because + ;; /etc/profile is missing, and thus clients get an empty $PATH + ;; and nothing works. + #:tests? #f + + #:phases + (alist-cons-before + 'configure 'fix-test-suite + (lambda _ + ;; Tests rely on $USER being set. + (setenv "USER" "guix") + + (substitute* "src/testsuite/functions.sh" + (("localhost") + ;; Avoid host name lookups since they don't work in chroot + ;; builds. + "127.0.0.1") + (("set -e") + ;; Make tests more verbose. + "set -e\nset -x")) + + (substitute* (find-files "src/testsuite" "-test$") + (("localhost") "127.0.0.1")) + + (substitute* "src/testsuite/login-auth-test" + (("/bin/cat") + ;; Use the right path to `cat'. + (search-path (search-path-as-string->list (getenv "PATH")) + "cat")))) + %standard-phases))) + (home-page "http://www.lysator.liu.se/~nisse/lsh/") + (synopsis + "GNU lsh, a GPL'd implementation of the SSH protocol") + (description + "lsh is a free implementation (in the GNU sense) of the ssh +version 2 protocol, currently being standardised by the IETF +SECSH working group.") + (license "GPLv2+"))) diff --git a/distro/packages/patches/lsh-guile-compat.patch b/distro/packages/patches/lsh-guile-compat.patch new file mode 100644 index 0000000000..0fe0484580 --- /dev/null +++ b/distro/packages/patches/lsh-guile-compat.patch @@ -0,0 +1,9 @@ +Use (ice-9 rdelim) for `read-line'. + +--- lsh-2.0.4/src/scm/guile-compat.scm 2012-12-03 23:28:01.000000000 +0100 ++++ lsh-2.0.4/src/scm/guile-compat.scm 2012-12-03 23:28:04.000000000 +0100 +@@ -21,3 +21,4 @@ + ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + (use-syntax (ice-9 syncase)) ++(use-modules (ice-9 rdelim)) diff --git a/distro/packages/patches/lsh-no-root-login.patch b/distro/packages/patches/lsh-no-root-login.patch new file mode 100644 index 0000000000..9dd81de3fb --- /dev/null +++ b/distro/packages/patches/lsh-no-root-login.patch @@ -0,0 +1,16 @@ +Correctly handle the `--no-root-login' option. + +--- lsh-2.0.4/src/lshd.c 2006-05-01 13:47:44.000000000 +0200 ++++ lsh-2.0.4/src/lshd.c 2009-09-08 12:20:36.000000000 +0200 +@@ -758,6 +758,10 @@ main_argp_parser(int key, char *arg, str + self->allow_root = 1; + break; + ++ case OPT_NO_ROOT_LOGIN: ++ self->allow_root = 0; ++ break; ++ + case OPT_KERBEROS_PASSWD: + self->pw_helper = PATH_KERBEROS_HELPER; + break; + diff --git a/distro/packages/patches/lsh-pam-service-name.patch b/distro/packages/patches/lsh-pam-service-name.patch new file mode 100644 index 0000000000..6a6156855c --- /dev/null +++ b/distro/packages/patches/lsh-pam-service-name.patch @@ -0,0 +1,14 @@ +Tell `lsh-pam-checkpw', the PAM password helper program, to use a more +descriptive service name. + +--- lsh-2.0.4/src/lsh-pam-checkpw.c 2003-02-16 22:30:10.000000000 +0100 ++++ lsh-2.0.4/src/lsh-pam-checkpw.c 2008-11-28 16:16:58.000000000 +0100 +@@ -38,7 +38,7 @@ + #include <security/pam_appl.h> + + #define PWD_MAXLEN 1024 +-#define SERVICE_NAME "other" ++#define SERVICE_NAME "lshd" + #define TIMEOUT 600 + + static int diff --git a/guix-build.in b/guix-build.in index 72386ac511..a3f6f5766b 100644 --- a/guix-build.in +++ b/guix-build.in @@ -45,7 +45,7 @@ exec ${GUILE-@GUILE@} -L "@guilemoduledir@" -l "$0" \ #:export (guix-build)) (define %store - (open-connection)) + (make-parameter #f)) (define (derivations-from-package-expressions exp system source?) "Eval EXP and return the corresponding derivation path for SYSTEM. @@ -56,10 +56,10 @@ When SOURCE? is true, return the derivations of the package sources." (let ((source (package-source p)) (loc (package-location p))) (if source - (package-source-derivation %store source) + (package-source-derivation (%store) source) (leave (_ "~a: error: package `~a' has no source~%") (location->string loc) (package-name p)))) - (package-derivation %store p system)) + (package-derivation (%store) p system)) (leave (_ "expression `~s' does not evaluate to a package~%") exp)))) @@ -176,12 +176,12 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (match outputs* ((output) (symlink output root) - (add-indirect-root %store root)) + (add-indirect-root (%store) root)) ((outputs ...) (fold (lambda (output count) (let ((root (string-append root "-" (number->string count)))) (symlink output root) - (add-indirect-root %store root)) + (add-indirect-root (%store) root)) (+ 1 count)) 0 outputs)))) @@ -197,77 +197,78 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@")) (setvbuf (current-error-port) _IOLBF) (with-error-handling - (let* ((opts (parse-options)) - (src? (assoc-ref opts 'source?)) - (sys (assoc-ref opts 'system)) - (drv (filter-map (match-lambda - (('expression . exp) - (derivations-from-package-expressions exp sys - src?)) - (('argument . (? derivation-path? drv)) - drv) - (('argument . (? string? x)) - (match (find-packages-by-name x) - ((p _ ...) - (if src? - (let ((s (package-source p))) - (package-source-derivation %store s)) - (package-derivation %store p sys))) - (_ - (leave (_ "~A: unknown package~%") x)))) - (_ #f)) - opts)) - (req (append-map (lambda (drv-path) - (let ((d (call-with-input-file drv-path - read-derivation))) - (derivation-prerequisites-to-build %store d))) - drv)) - (req* (delete-duplicates - (append (remove (compose (cut valid-path? %store <>) - derivation-path->output-path) - drv) - (map derivation-input-path req))))) - (if (assoc-ref opts 'dry-run?) - (format (current-error-port) - (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*) - (format (current-error-port) - (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" - "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" - (length req*)) - (null? req*) req*)) + (let ((opts (parse-options))) + (parameterize ((%store (open-connection))) + (let* ((src? (assoc-ref opts 'source?)) + (sys (assoc-ref opts 'system)) + (drv (filter-map (match-lambda + (('expression . exp) + (derivations-from-package-expressions exp sys + src?)) + (('argument . (? derivation-path? drv)) + drv) + (('argument . (? string? x)) + (match (find-packages-by-name x) + ((p _ ...) + (if src? + (let ((s (package-source p))) + (package-source-derivation (%store) s)) + (package-derivation (%store) p sys))) + (_ + (leave (_ "~A: unknown package~%") x)))) + (_ #f)) + opts)) + (req (append-map (lambda (drv-path) + (let ((d (call-with-input-file drv-path + read-derivation))) + (derivation-prerequisites-to-build (%store) d))) + drv)) + (req* (delete-duplicates + (append (remove (compose (cut valid-path? (%store) <>) + derivation-path->output-path) + drv) + (map derivation-input-path req))))) + (if (assoc-ref opts 'dry-run?) + (format (current-error-port) + (N_ "~:[the following derivation would be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations would be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*) + (format (current-error-port) + (N_ "~:[the following derivation will be built:~%~{ ~a~%~}~;~]" + "~:[the following derivations will be built:~%~{ ~a~%~}~;~]" + (length req*)) + (null? req*) req*)) - ;; TODO: Add more options. - (set-build-options %store - #:keep-failed? (assoc-ref opts 'keep-failed?) - #:build-cores (or (assoc-ref opts 'cores) 0) - #:use-substitutes? (assoc-ref opts 'substitutes?)) + ;; TODO: Add more options. + (set-build-options (%store) + #:keep-failed? (assoc-ref opts 'keep-failed?) + #:build-cores (or (assoc-ref opts 'cores) 0) + #:use-substitutes? (assoc-ref opts 'substitutes?)) - (if (assoc-ref opts 'derivations-only?) - (format #t "~{~a~%~}" drv) - (or (assoc-ref opts 'dry-run?) - (and (build-derivations %store drv) - (for-each (lambda (d) - (let ((drv (call-with-input-file d - read-derivation))) - (format #t "~{~a~%~}" - (map (match-lambda - ((out-name . out) - (derivation-path->output-path - d out-name))) - (derivation-outputs drv))))) - drv) - (let ((roots (filter-map (match-lambda - (('gc-root . root) - root) - (_ #f)) - opts))) - (when roots - (for-each (cut register-root <> <>) - drv roots) - #t)))))))) + (if (assoc-ref opts 'derivations-only?) + (format #t "~{~a~%~}" drv) + (or (assoc-ref opts 'dry-run?) + (and (build-derivations (%store) drv) + (for-each (lambda (d) + (let ((drv (call-with-input-file d + read-derivation))) + (format #t "~{~a~%~}" + (map (match-lambda + ((out-name . out) + (derivation-path->output-path + d out-name))) + (derivation-outputs drv))))) + drv) + (let ((roots (filter-map (match-lambda + (('gc-root . root) + root) + (_ #f)) + opts))) + (when roots + (for-each (cut register-root <> <>) + drv roots) + #t)))))))))) ;; Local Variables: ;; eval: (put 'guard 'scheme-indent-function 1) diff --git a/guix/derivations.scm b/guix/derivations.scm index cda1f065d4..b1f54232bc 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -418,8 +418,7 @@ known in advance, such as a file download." ((input . _) (let ((path (add-to-store store (basename input) - (hash-algo sha256) #t #t - input))) + #t #t "sha256" input))) (make-derivation-input path '())))) (delete-duplicates inputs))) (env-vars (env-vars-with-empty-outputs)) diff --git a/guix/store.scm b/guix/store.scm index d1621e4504..9aafb332dc 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -111,7 +111,8 @@ (sha1 2) (sha256 3)) -(define %nix-state-dir "/nix/var/nix") +(define %nix-state-dir + (or (getenv "NIX_STATE_DIR") "/nix/var/nix")) (define %default-socket-path (string-append %nix-state-dir "/daemon-socket/socket")) @@ -437,7 +438,8 @@ file name. Return #t on success." (define %store-prefix ;; Absolute path to the Nix store. - (make-parameter "/nix/store")) + (make-parameter (or (and=> (getenv "NIX_STORE_DIR") canonicalize-path) + "/nix/store"))) (define (store-path? path) "Return #t if PATH is a store path." diff --git a/tests/derivations.scm b/tests/derivations.scm index bcedfbf948..14e1863a12 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -124,6 +124,29 @@ (string=? (call-with-input-file path read-line) "hello, world")))))) +(test-assert "derivation with local file as input" + (let* ((builder (add-text-to-store + %store "my-builder.sh" + "(while read line ; do echo $line ; done) < $in > $out" + '())) + (input (search-path %load-path "ice-9/boot-9.scm")) + (drv-path (derivation %store "derivation-with-input-file" + (%current-system) + "/bin/sh" `(,builder) + `(("in" + ;; Cheat to pass the actual file + ;; name to the builder. + . ,(add-to-store %store + (basename input) + #t #t "sha256" + input))) + `((,builder) + (,input))))) ; ← local file name + (and (build-derivations %store (list drv-path)) + (let ((p (derivation-path->output-path drv-path))) + (and (call-with-input-file p get-bytevector-all) + (call-with-input-file input get-bytevector-all)))))) + (test-assert "fixed-output derivation" (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) diff --git a/tests/packages.scm b/tests/packages.scm index cb69e4be4e..c89f6e7721 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -29,6 +29,7 @@ #:use-module (distro packages bootstrap) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) + #:use-module (rnrs io ports) #:use-module (ice-9 match)) ;; Test the high-level packaging layer. @@ -89,6 +90,22 @@ (equal? '(hello guix) (call-with-input-file (string-append p "/test") read)))))) +(test-assert "trivial with local file as input" + (let* ((i (search-path %load-path "ice-9/boot-9.scm")) + (p (package (inherit (dummy-package "trivial-with-input-file")) + (build-system trivial-build-system) + (source #f) + (arguments + `(#:guile ,%bootstrap-guile + #:builder (copy-file (assoc-ref %build-inputs "input") + %output))) + (inputs `(("input" ,i))))) + (d (package-derivation %store p))) + (and (build-derivations %store (list d)) + (let ((p (pk 'drv d (derivation-path->output-path d)))) + (equal? (call-with-input-file p get-bytevector-all) + (call-with-input-file i get-bytevector-all)))))) + (test-assert "trivial with system-dependent input" (let* ((p (package (inherit (dummy-package "trivial-system-dependent-input")) (build-system trivial-build-system) |