From 6f58d582432fe46c163f61ddf8f653584f4f7be8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 10 Mar 2014 23:58:40 +0100 Subject: [PATCH 01/14] More /gnu/store replacements. * gnu/packages/gcc.scm (gcc-4.7): Change /nix/store in comment. * gnu/system/vm.scm (operating-system-default-contents): Use (%store-prefix) instead of "/nix/store". * guix/derivations.scm (derivation-path->output-path, derivation-path->output-paths): Change to /gnu/store in docstring. --- gnu/packages/gcc.scm | 4 ++-- gnu/system/vm.scm | 4 ++-- guix/derivations.scm | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index 279cc8d950..cb7817c084 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -186,7 +186,7 @@ where the OS part is overloaded to denote a specific ABI---into GCC 'configure 'post-configure (lambda _ ;; Don't store configure flags, to avoid retaining references to - ;; build-time dependencies---e.g., `--with-ppl=/nix/store/xxx'. + ;; build-time dependencies---e.g., `--with-ppl=/gnu/store/xxx'. (substitute* "Makefile" (("^TOPLEVEL_CONFIGURE_ARGUMENTS=(.*)$" _ rest) "TOPLEVEL_CONFIGURE_ARGUMENTS=\n"))) diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index b6a777353f..a23289a30b 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -373,7 +373,7 @@ such as /etc files." ;; (not 'futime'), so the timestamp of ;; symlinks cannot be changed, and there ;; are symlinks here pointing to - ;; /nix/store, which is the host, + ;; /gnu/store, which is the host, ;; read-only store. (unless (eq? (stat:type s) 'symlink) (utime file 0 0 0 0)))) @@ -448,7 +448,7 @@ basic contents of the root file system of OS." (os-dir -> (derivation->output-path os-drv)) (build-gid (operating-system-build-gid os)) (profile (operating-system-profile-directory os))) - (return `((directory "/nix/store" 0 ,(or build-gid 0)) + (return `((directory ,(%store-prefix) 0 ,(or build-gid 0)) (directory "/etc") (directory "/var/log") ; for dmd (directory "/var/run/nscd") diff --git a/guix/derivations.scm b/guix/derivations.scm index 82a0173232..f26075f84a 100644 --- a/guix/derivations.scm +++ b/guix/derivations.scm @@ -451,13 +451,13 @@ that form." ;; This procedure is called frequently, so memoize it. (memoize (lambda* (path #:optional (output "out")) - "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the store + "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the store path of its output OUTPUT." (derivation->output-path (call-with-input-file path read-derivation) output)))) (define (derivation-path->output-paths path) - "Read the derivation from PATH (`/nix/store/xxx.drv'), and return the + "Read the derivation from PATH (`/gnu/store/xxx.drv'), and return the list of name/path pairs of its outputs." (derivation->output-paths (call-with-input-file path read-derivation))) From d91a879121485b079796ab5174468bf4c034ae40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 11 Mar 2014 22:09:31 +0100 Subject: [PATCH 02/14] download: 'download-to-store' accepts plain file names. * guix/download.scm (download-to-store): When URI is #f, assume that URL is a file name, and handle it. --- guix/download.scm | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/guix/download.scm b/guix/download.scm index 0889928d3a..2cb0740897 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -255,8 +255,9 @@ omitted. Write progress reports to LOG." (define uri (string->uri url)) - (if (memq (uri-scheme uri) '(file #f)) - (add-to-store store name #f "sha256" (uri-path uri)) + (if (or (not uri) (memq (uri-scheme uri) '(file #f))) + (add-to-store store name #f "sha256" + (if uri (uri-path uri) url)) (call-with-temporary-output-file (lambda (temp port) (let ((result From 7f3673f21d1bf1d40a587ffbca7ced7de33a8535 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 11 Mar 2014 22:08:40 +0100 Subject: [PATCH 03/14] guix build: Add '--with-source'. * guix/scripts/build.scm (package-with-source): New procedure. (show-help): Add '--with-source'. (%options): Likewise. (options->derivations): Call 'options/with-source' and 'options/resolve-packages'. (options/resolve-packages, options/with-source): New procedures. * doc/guix.texi (Invoking guix build): Document '--with-source'. --- doc/guix.texi | 28 +++++++++++ guix/scripts/build.scm | 108 +++++++++++++++++++++++++++++++++++------ 2 files changed, 122 insertions(+), 14 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 701b5400f8..d2a21a0f4a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -1840,6 +1840,34 @@ Cross-build for @var{triplet}, which must be a valid GNU triplet, such as @code{"mips64el-linux-gnu"} (@pxref{Configuration Names, GNU configuration triplets,, configure, GNU Configure and Build System}). +@item --with-source=@var{source} +Use @var{source} as the source of the corresponding package. +@var{source} must be a file name or a URL, as for @command{guix +download} (@pxref{Invoking guix download}). + +The ``corresponding package'' is taken to be one specified on the +command line whose name matches the base of @var{source}---e.g., if +@var{source} is @code{/src/guile-2.0.10.tar.gz}, the corresponding +package is @code{guile}. Likewise, the version string is inferred from +@var{source}; in the previous example, it's @code{2.0.10}. + +This option allows users to try out versions of packages other than the +one provided by the distribution. The example below downloads +@file{ed-1.7.tar.gz} from a GNU mirror and uses that as the source for +the @code{ed} package: + +@example +guix build ed --with-source=mirror://gnu/ed/ed-1.7.tar.gz +@end example + +As a developer, @code{--with-source} makes it easy to test release +candidates: + +@example +guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz +@end example + + @item --derivations @itemx -d Return the derivation paths, not the output paths, of the given diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 618015e9ba..8f6ba192c2 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -33,6 +33,7 @@ #:use-module (srfi srfi-34) #:use-module (srfi srfi-37) #:autoload (gnu packages) (find-best-packages-by-name) + #:autoload (guix download) (download-to-store) #:export (derivation-from-expression %standard-build-options @@ -104,6 +105,31 @@ present, return the preferred newest version." (leave (_ "failed to create GC root `~a': ~a~%") root (strerror (system-error-errno args))))))) +(define (package-with-source store p uri) + "Return a package based on P but with its source taken from URI. Extract +the new package's version number from URI." + (define (numeric-extension? file-name) + ;; Return true if FILE-NAME ends with digits. + (string-every char-set:hex-digit (file-extension file-name))) + + (define (tarball-base-name file-name) + ;; Return the "base" of FILE-NAME, removing '.tar.gz' or similar + ;; extensions. + ;; TODO: Factorize. + (cond ((numeric-extension? file-name) + file-name) + ((string=? (file-extension file-name) "tar") + (file-sans-extension file-name)) + (else + (tarball-base-name (file-sans-extension file-name))))) + + (let ((base (tarball-base-name (basename uri)))) + (let-values (((name version) + (package-name->name+version base))) + (package (inherit p) + (version (or version (package-version p))) + (source (download-to-store store uri)))))) + ;;; ;;; Standard command-line build options. @@ -221,6 +247,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) -s, --system=SYSTEM attempt to build for SYSTEM--e.g., \"i686-linux\"")) (display (_ " --target=TRIPLET cross-build for TRIPLET--e.g., \"armel-linux-gnu\"")) + (display (_ " + --with-source=SOURCE + use SOURCE when building the corresponding package")) (display (_ " -d, --derivations return the derivation paths of the given packages")) (display (_ " @@ -274,6 +303,9 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n")) (option '("log-file") #f #f (lambda (opt name arg result) (alist-cons 'log-file? #t result))) + (option '("with-source") #t #f + (lambda (opt name arg result) + (alist-cons 'with-source arg result))) %standard-build-options)) @@ -289,23 +321,71 @@ build." (define src? (assoc-ref opts 'source?)) (define sys (assoc-ref opts 'system)) - (filter-map (match-lambda - (('expression . str) - (derivation-from-expression store str package->derivation - sys src?)) - (('argument . (? derivation-path? drv)) - (call-with-input-file drv read-derivation)) - (('argument . (? store-path?)) - ;; Nothing to do; maybe for --log-file. - #f) - (('argument . (? string? x)) - (let ((p (specification->package x))) + (let ((opts (options/with-source store + (options/resolve-packages opts)))) + (filter-map (match-lambda + (('expression . str) + (derivation-from-expression store str package->derivation + sys src?)) + (('argument . (? package? p)) (if src? (let ((s (package-source p))) (package-source-derivation store s)) - (package->derivation store p sys)))) - (_ #f)) - opts)) + (package->derivation store p sys))) + (('argument . (? derivation-path? drv)) + (call-with-input-file drv read-derivation)) + (('argument . (? store-path?)) + ;; Nothing to do; maybe for --log-file. + #f) + (_ #f)) + opts))) + +(define (options/resolve-packages opts) + "Return OPTS with package specification strings replaced by actual +packages." + (map (match-lambda + (('argument . (? string? spec)) + (if (store-path? spec) + `(argument . ,spec) + `(argument . ,(specification->package spec)))) + (opt opt)) + opts)) + +(define (options/with-source store opts) + "Process with 'with-source' options in OPTS, replacing the relevant package +arguments with packages that use the specified source." + (define new-sources + (filter-map (match-lambda + (('with-source . uri) + (cons (package-name->name+version (basename uri)) + uri)) + (_ #f)) + opts)) + + (let loop ((opts opts) + (sources new-sources) + (result '())) + (match opts + (() + (unless (null? sources) + (warning (_ "sources do not match any package:~{ ~a~}~%") + (match sources + (((name . uri) ...) + uri)))) + (reverse result)) + ((('argument . (? package? p)) tail ...) + (let ((source (assoc-ref sources (package-name p)))) + (loop tail + (alist-delete (package-name p) sources) + (alist-cons 'argument + (if source + (package-with-source store p source) + p) + result)))) + ((('with-source . _) tail ...) + (loop tail sources result)) + ((head tail ...) + (loop tail sources (cons head result)))))) ;;; From ed7485886e26028dfe9bdeb91b4422d9ec461b7c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 12 Mar 2014 15:11:30 +0100 Subject: [PATCH 04/14] gnu: unionfs-fuse: Add statically-linked variant. * gnu/packages/linux.scm (unionfs-fuse/static): New variable. --- gnu/packages/linux.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index e1668b1d6b..9f202781bf 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -945,3 +945,19 @@ space, using the FUSE library. Mounting a union file system allows you to \"aggregate\" the contents of several directories into a single mount point. UnionFS-FUSE additionally supports copy-on-write.") (license bsd-3))) + +(define-public unionfs-fuse/static + (package (inherit unionfs-fuse) + (synopsis "User-space union file system (statically linked)") + (name (string-append (package-name unionfs-fuse) "-static")) + (source (origin (inherit (package-source unionfs-fuse)) + (modules '((guix build utils))) + (snippet + ;; Add -ldl to the libraries, because libfuse.a needs that. + '(substitute* "src/CMakeLists.txt" + (("target_link_libraries(.*)\\)" _ libs) + (string-append "target_link_libraries" + libs " dl)")))))) + (arguments + '(#:tests? #f + #:configure-flags '("-DCMAKE_EXE_LINKER_FLAGS=-static"))))) From 68276f164f7ec543ae11496ee52f8e05bc4fbfd9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 12 Mar 2014 22:55:48 +0100 Subject: [PATCH 05/14] gnu: linux-libre: Build the FUSE module. * gnu/packages/linux.scm (linux-libre): Set CONFIG_FUSE_FS=m. --- gnu/packages/linux.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 9f202781bf..28a21c1e38 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -165,6 +165,8 @@ (substitute* ".config" (("^# CONFIG_CIFS.*$") "CONFIG_CIFS=m\n") + (("^# CONFIG_FUSE_FS.*$") + "CONFIG_FUSE_FS=m\n") (("^# CONFIG_([[:graph:]]*)VIRTIO([[:graph:]]*) .*$" _ before after) (string-append "CONFIG_" before "VIRTIO" From 9037ea2c123eb5ad351fdc108bbd2ced7f1a81a8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 13 Mar 2014 00:04:07 +0100 Subject: [PATCH 06/14] gnu: guile-xcb: Upgrade to 1.3. * gnu/packages/guile-wm.scm (guile-xcb): Upgrade to 1.3. [arguments] Pass --with-guile-site-dir= instead of --datadir=, and pass --with-guile-site-ccache-dir=. Remove #:phases. --- gnu/packages/guile-wm.scm | 26 ++++++++------------------ 1 file changed, 8 insertions(+), 18 deletions(-) diff --git a/gnu/packages/guile-wm.scm b/gnu/packages/guile-wm.scm index b05974c8ae..38c5959340 100644 --- a/gnu/packages/guile-wm.scm +++ b/gnu/packages/guile-wm.scm @@ -29,36 +29,26 @@ (define-public guile-xcb (package (name "guile-xcb") - (version "1.2") + (version "1.3") (source (origin (method url-fetch) (uri (string-append "http://www.markwitmer.com/dist/guile-xcb-" version ".tar.gz")) (sha256 (base32 - "009qrw46ay74z3mw8gz7jqvn90z9ilyhy00801w5vpyias02730y")))) + "04dvbqdrrs67490gn4gkq9zk8mqy3mkls2818ha4p0ckhh0pm149")))) (build-system gnu-build-system) (arguments '(;; Parallel builds fail. #:parallel-build? #f - ;; The '.scm' files go to $(datadir), so set that to the - ;; standard value. #:configure-flags (list (string-append - "--datadir=" + "--with-guile-site-dir=" (assoc-ref %outputs "out") - "/share/guile/site/2.0")) - #:phases (alist-cons-before - 'configure 'set-go-directory - (lambda* (#:key outputs #:allow-other-keys) - ;; The makefile sets the .go directory to Guile's - ;; own .go site directory, which is read-only. - ;; Change it to point to $out/share/guile/site/2.0. - (let ((out (assoc-ref outputs "out"))) - (substitute* "Makefile.in" - (("^godir = .*$") - (string-append "godir = " out - "/share/guile/site/2.0\n"))))) - %standard-phases))) + "/share/guile/site/2.0") + (string-append + "--with-guile-site-ccache-dir=" + (assoc-ref %outputs "out") + "/share/guile/site/2.0")))) (native-inputs `(("pkg-config" ,pkg-config))) (inputs `(("guile" ,guile-2.0) ("xcb" ,xcb-proto))) From 257b93412ad52dc26b53e0dae71a79b9b51ab33f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 13 Mar 2014 19:21:49 +0100 Subject: [PATCH 07/14] guix build: Support '--with-source' along with '-e'. * guix/scripts/build.scm (derivation-from-expression): Remove. (options->derivations): Handle pairs of the form "('argument . (? derivation?))". (options/resolve-packages): Add 'store' parameter; update caller. Add 'system' variable. Add case for 'expression pairs. * guix/scripts/archive.scm (derivation-from-expression): New procedure. --- guix/scripts/archive.scm | 19 +++++++++++++++++++ guix/scripts/build.scm | 41 +++++++++++++++------------------------- 2 files changed, 34 insertions(+), 26 deletions(-) diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index 8280a821c5..0ab7686585 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -23,6 +23,7 @@ #:use-module (guix store) #:use-module (guix packages) #:use-module (guix derivations) + #:use-module (guix monads) #:use-module (guix ui) #:use-module (guix pki) #:use-module (guix pk-crypto) @@ -143,6 +144,24 @@ Export/import one or more packages from/to the store.\n")) %standard-build-options)) +(define (derivation-from-expression store str package-derivation + system source?) + "Read/eval STR and return the corresponding derivation path for SYSTEM. +When SOURCE? is true and STR evaluates to a package, return the derivation of +the package source; otherwise, use PACKAGE-DERIVATION to compute the +derivation of a package." + (match (read/eval str) + ((? package? p) + (if source? + (let ((source (package-source p))) + (if source + (package-source-derivation store source) + (leave (_ "package `~a' has no source~%") + (package-name p)))) + (package-derivation store p system))) + ((? procedure? proc) + (run-with-store store (proc) #:system system)))) + (define (options->derivations+files store opts) "Given OPTS, the result of 'args-fold', return a list of derivations to build and a list of store files to transfer." diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 8f6ba192c2..35b10a0ec2 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -34,32 +34,12 @@ #:use-module (srfi srfi-37) #:autoload (gnu packages) (find-best-packages-by-name) #:autoload (guix download) (download-to-store) - #:export (derivation-from-expression - - %standard-build-options + #:export (%standard-build-options set-build-options-from-command-line show-build-options-help guix-build)) -(define (derivation-from-expression store str package-derivation - system source?) - "Read/eval STR and return the corresponding derivation path for SYSTEM. -When SOURCE? is true and STR evaluates to a package, return the derivation of -the package source; otherwise, use PACKAGE-DERIVATION to compute the -derivation of a package." - (match (read/eval str) - ((? package? p) - (if source? - (let ((source (package-source p))) - (if source - (package-source-derivation store source) - (leave (_ "package `~a' has no source~%") - (package-name p)))) - (package-derivation store p system))) - ((? procedure? proc) - (run-with-store store (proc) #:system system)))) - (define (specification->package spec) "Return a package matching SPEC. SPEC may be a package name, or a package name followed by a hyphen and a version number. If the version number is not @@ -322,16 +302,15 @@ build." (define sys (assoc-ref opts 'system)) (let ((opts (options/with-source store - (options/resolve-packages opts)))) + (options/resolve-packages store opts)))) (filter-map (match-lambda - (('expression . str) - (derivation-from-expression store str package->derivation - sys src?)) (('argument . (? package? p)) (if src? (let ((s (package-source p))) (package-source-derivation store s)) (package->derivation store p sys))) + (('argument . (? derivation? drv)) + drv) (('argument . (? derivation-path? drv)) (call-with-input-file drv read-derivation)) (('argument . (? store-path?)) @@ -340,14 +319,24 @@ build." (_ #f)) opts))) -(define (options/resolve-packages opts) +(define (options/resolve-packages store opts) "Return OPTS with package specification strings replaced by actual packages." + (define system + (or (assoc-ref opts 'system) (%current-system))) + (map (match-lambda (('argument . (? string? spec)) (if (store-path? spec) `(argument . ,spec) `(argument . ,(specification->package spec)))) + (('expression . str) + (match (read/eval str) + ((? package? p) + `(argument . ,p)) + ((? procedure? proc) + (let ((drv (run-with-store store (proc) #:system system))) + `(argument . ,drv))))) (opt opt)) opts)) From cecd72d55ae974f8ebe900e0088071f843866935 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 13 Mar 2014 21:58:04 +0100 Subject: [PATCH 08/14] offload: Allow build machines to specify a port number. * guix/scripts/offload.scm (): Add 'port' field. (remote-pipe, send-files): Use lsh's '-p' option when invoking it. --- doc/guix.texi | 3 +++ guix/scripts/offload.scm | 8 ++++++-- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index d2a21a0f4a..f97051e88c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -345,6 +345,9 @@ A number of optional fields may be specified: @table @code +@item port +Port number of the machine's SSH server (default: 22). + @item private-key The SSH private key file to use when connecting to the machine. diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 4d2f78f711..4a105e946f 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -56,6 +56,8 @@ build-machine make-build-machine build-machine? (name build-machine-name) ; string + (port build-machine-port ; number + (default 22)) (system build-machine-system) ; string (user build-machine-user) ; string (private-key build-machine-private-key ; file name @@ -161,8 +163,9 @@ determined." "Run COMMAND on MACHINE, assuming an lsh gateway has been set up." (catch 'system-error (lambda () - (apply open-pipe* mode %lshg-command - "-l" (build-machine-user machine) "-z" + (apply open-pipe* mode %lshg-command "-z" + "-l" (build-machine-user machine) + "-p" (build-machine-port machine) ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg. "-i" (build-machine-private-key machine) @@ -328,6 +331,7 @@ success, #f otherwise." (missing (filtered-port (list (which %lshg-command) "-l" (build-machine-user machine) + "-p" (build-machine-port machine) "-i" (build-machine-private-key machine) (build-machine-name machine) "guix" "archive" "--missing") From 3c0e6e6080242656104143612ba57bc210779709 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 13 Mar 2014 22:46:32 +0100 Subject: [PATCH 09/14] offload: Convert the port number to a string when invoking lsh. * guix/scripts/offload.scm (remote-pipe, send-files): Pass the result of 'build-machine-port' to 'number->string'. --- guix/scripts/offload.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index 4a105e946f..c9ea457db1 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -165,7 +165,7 @@ determined." (lambda () (apply open-pipe* mode %lshg-command "-z" "-l" (build-machine-user machine) - "-p" (build-machine-port machine) + "-p" (number->string (build-machine-port machine)) ;; XXX: Remove '-i' when %LSHG-COMMAND really is lshg. "-i" (build-machine-private-key machine) @@ -331,7 +331,7 @@ success, #f otherwise." (missing (filtered-port (list (which %lshg-command) "-l" (build-machine-user machine) - "-p" (build-machine-port machine) + "-p" (number->string (build-machine-port machine)) "-i" (build-machine-private-key machine) (build-machine-name machine) "guix" "archive" "--missing") From 1a8ea0a1885ca5fff85eb00fc79d6c6bcd47818a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 13 Mar 2014 22:57:21 +0100 Subject: [PATCH 10/14] offload: Fix 'choose-build-machine' for several machines. * guix/scripts/offload.scm (choose-build-machine)[undecorate]: Turn into a two-argument procedure. --- guix/scripts/offload.scm | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index c9ea457db1..95e35088a1 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -466,10 +466,14 @@ allowed on MACHINE." machines)) (define (undecorate pred) - (match-lambda - ((machine slot) - (and (pred machine) - (list machine slot))))) + (lambda (a b) + (match a + ((machine1 slot1) + (match b + ((machine2 slot2) + (if (pred machine1 machine2) + (list machine1 slot1) + (list machine2 slot2)))))))) (let ((machines+slots (sort machines+slots (undecorate machine-less-loaded-or-faster?)))) From 11e7a6cf4612b83f3fe3ecfcce3e7c0b21ecf953 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Fri, 14 Mar 2014 17:16:10 +0100 Subject: [PATCH 11/14] store: Add 'hash-part->path'. * guix/store.scm (hash-part->path): New procedure. * tests/store.scm ("hash-part->path"): New test. --- guix/store.scm | 13 +++++++++++++ tests/store.scm | 7 ++++++- 2 files changed, 19 insertions(+), 1 deletion(-) diff --git a/guix/store.scm b/guix/store.scm index 909ef195de..58f7e36762 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -57,6 +57,7 @@ set-build-options valid-path? query-path-hash + hash-part->path add-text-to-store add-to-store build-derivations @@ -501,6 +502,18 @@ encoding conversion errors." "Return the SHA256 hash of PATH as a bytevector." base16) +(define hash-part->path + (let ((query-path-from-hash-part + (operation (query-path-from-hash-part (string hash)) + #f + store-path))) + (lambda (server hash-part) + "Return the store path whose hash part is HASH-PART (a nix-base32 +string). Raise an error if no such path exists." + ;; This RPC is primarily used by Hydra to reply to HTTP GETs of + ;; /HASH.narinfo. + (query-path-from-hash-part server hash-part)))) + (define add-text-to-store ;; A memoizing version of `add-to-store', to avoid repeated RPCs with ;; the very same arguments during a given session. diff --git a/tests/store.scm b/tests/store.scm index 8a25c7353b..78023a423d 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -87,7 +87,12 @@ (%store-prefix) "/283gqy39v3g9dxjy26rynl0zls82fmcg-guile-2.0.7/bin/guile"))))) -(test-skip (if %store 0 10)) +(test-skip (if %store 0 11)) + +(test-assert "hash-part->path" + (let ((p (add-text-to-store %store "hello" "hello, world"))) + (equal? (hash-part->path %store (store-path-hash-part p)) + p))) (test-assert "dead-paths" (let ((p (add-text-to-store %store "random-text" (random-text)))) From b148bd714ed975d06bdda0934a30175883a19bb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 16 Mar 2014 23:18:36 +0100 Subject: [PATCH 12/14] gnu: fuse: Refer to the right 'mount' and 'umount' commands. * gnu/packages/linux.scm (fuse)[inputs]: Change to... [native-inputs]: ... this. [arguments]: Add #:phases argument. --- gnu/packages/linux.scm | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index 28a21c1e38..b5e15400e1 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -901,7 +901,7 @@ processes currently causing I/O.") (base32 "071r6xjgssy8vwdn6m28qq1bqxsd2bphcd2mzhq0grf5ybm87sqb")))) (build-system gnu-build-system) - (native-inputs `(("util-linux" ,util-linux))) + (inputs `(("util-linux" ,util-linux))) (arguments '(#:configure-flags (list (string-append "MOUNT_FUSE_PATH=" (assoc-ref %outputs "out") @@ -911,7 +911,20 @@ processes currently causing I/O.") "/etc/init.d") (string-append "UDEV_RULES_PATH=" (assoc-ref %outputs "out") - "/etc/udev")))) + "/etc/udev")) + #:phases (alist-cons-before + 'build 'set-file-names + (lambda* (#:key inputs #:allow-other-keys) + ;; libfuse calls out to mount(8) and umount(8). Make sure + ;; it refers to the right ones. + (substitute* '("lib/mount_util.c" "util/mount_util.c") + (("/bin/(u?)mount" _ maybe-u) + (string-append (assoc-ref inputs "util-linux") + "/bin/" maybe-u "mount"))) + (substitute* '("util/mount.fuse.c") + (("/bin/sh") + (which "sh")))) + %standard-phases))) (home-page "http://fuse.sourceforge.net/") (synopsis "Support file systems implemented in user space") (description From 7c516af64176620d71058f6003ef19209cc20c12 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 17 Mar 2014 18:13:06 +0100 Subject: [PATCH 13/14] gnu: pulseaudio: Upgrade to 5.0. * gnu/packages/pulseaudio.scm (pulseaudio): Upgrade to 5.0. Remove patches. * gnu/packages/patches/pulseaudio-test-timeouts.patch, gnu/packages/patches/pulseaudio-volume-test.patch: Remove. * gnu-system.am (dist_patch_DATA): Adjust accordingly. --- gnu-system.am | 2 -- .../patches/pulseaudio-test-timeouts.patch | 19 ------------ .../patches/pulseaudio-volume-test.patch | 29 ------------------- gnu/packages/pulseaudio.scm | 7 ++--- 4 files changed, 2 insertions(+), 55 deletions(-) delete mode 100644 gnu/packages/patches/pulseaudio-test-timeouts.patch delete mode 100644 gnu/packages/patches/pulseaudio-volume-test.patch diff --git a/gnu-system.am b/gnu-system.am index 2eae1483cc..987c5a6b0a 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -310,8 +310,6 @@ dist_patch_DATA = \ gnu/packages/patches/perl-no-sys-dirs.patch \ gnu/packages/patches/plotutils-libpng-jmpbuf.patch \ gnu/packages/patches/procps-make-3.82.patch \ - gnu/packages/patches/pulseaudio-test-timeouts.patch \ - gnu/packages/patches/pulseaudio-volume-test.patch \ gnu/packages/patches/python-fix-dbm.patch \ gnu/packages/patches/qemu-make-4.0.patch \ gnu/packages/patches/qemu-multiple-smb-shares.patch \ diff --git a/gnu/packages/patches/pulseaudio-test-timeouts.patch b/gnu/packages/patches/pulseaudio-test-timeouts.patch deleted file mode 100644 index ab818ad0aa..0000000000 --- a/gnu/packages/patches/pulseaudio-test-timeouts.patch +++ /dev/null @@ -1,19 +0,0 @@ -Increase the timeout of the thread test. Hydra was intermittedly -failing this test due to premature timeout, and slower machines -consistently fail. - -Patch by Mark H Weaver . - ---- pulseaudio/src/tests/thread-test.c.orig 2012-09-26 07:27:01.000000000 -0400 -+++ pulseaudio/src/tests/thread-test.c 2013-10-31 22:53:23.224000184 -0400 -@@ -152,6 +152,10 @@ - s = suite_create("Thread"); - tc = tcase_create("thread"); - tcase_add_test(tc, thread_test); -+ /* the default timeout is too small, -+ * set it to a reasonable large one. -+ */ -+ tcase_set_timeout(tc, 60 * 60); - suite_add_tcase(s, tc); - - sr = srunner_create(s); diff --git a/gnu/packages/patches/pulseaudio-volume-test.patch b/gnu/packages/patches/pulseaudio-volume-test.patch deleted file mode 100644 index 2cfa0cd6ca..0000000000 --- a/gnu/packages/patches/pulseaudio-volume-test.patch +++ /dev/null @@ -1,29 +0,0 @@ -Fix seemingly random failures of 'volume-test' in particular on 32-bit -machines. See for -details. - -From 27e47c72a25846e107b6e450c3a1480a2742382e Mon Sep 17 00:00:00 2001 -From: Tanu Kaskinen -Date: Sat, 14 Dec 2013 07:21:22 +0000 -Subject: volume-test: Increase the allowed number of rouding errors - -BugLink: https://bugs.freedesktop.org/show_bug.cgi?id=72374 ---- -diff --git a/src/tests/volume-test.c b/src/tests/volume-test.c -index a2daf3e..1ab0b5c 100644 ---- a/src/tests/volume-test.c -+++ b/src/tests/volume-test.c -@@ -138,7 +138,13 @@ START_TEST (volume_test) { - pa_log("max deviation: %lu n=%lu", (unsigned long) md, (unsigned long) mdn); - - fail_unless(md <= 1); -- fail_unless(mdn <= 251); -+ -+ /* mdn counts the times there were rounding errors during the test. The -+ * number of rounding errors seems to vary slightly depending on the -+ * hardware. The original limit was 251 errors, but it was increased to 253 -+ * when the test was failing on Tanu's laptop. -+ * See https://bugs.freedesktop.org/show_bug.cgi?id=72374 */ -+ fail_unless(mdn <= 253); - } - END_TEST diff --git a/gnu/packages/pulseaudio.scm b/gnu/packages/pulseaudio.scm index 8bf48c2a89..db7e752ee6 100644 --- a/gnu/packages/pulseaudio.scm +++ b/gnu/packages/pulseaudio.scm @@ -134,7 +134,7 @@ parse JSON formatted strings back into the C representation of JSON objects.") (define pulseaudio (package (name "pulseaudio") - (version "4.0") + (version "5.0") (source (origin (method url-fetch) (uri (string-append @@ -142,10 +142,7 @@ parse JSON formatted strings back into the C representation of JSON objects.") version ".tar.xz")) (sha256 (base32 - "1bndz4l8jxyq3zq128gzp3gryxl6yjs66j2y1d7yabw2n5mv7kim")) - (patches (map search-patch - '("pulseaudio-test-timeouts.patch" - "pulseaudio-volume-test.patch"))))) + "0fgrr8v7yfh0byhzdv4c87v9lkj8g7gpjm8r9xrbvpa92a5kmhcr")))) (build-system gnu-build-system) (arguments `(#:configure-flags '("--localstatedir=/var" ;"--sysconfdir=/etc" From 9b43a0ffa3869e56063cd4dea054828e53113c4b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 17 Mar 2014 18:24:13 +0100 Subject: [PATCH 14/14] gnu: python: Change URL to https. * gnu/packages/python.scm (python-2, python)[source]: Change URL to https. This makes sure GnuTLS is available in the derivation that downloads the source, which is required since http URLs get redirected to https anyway. Reported by Manolis Ragkousis . --- gnu/packages/python.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index ad1ac5c8f7..7997618fcf 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -46,7 +46,7 @@ (source (origin (method url-fetch) - (uri (string-append "http://www.python.org/ftp/python/" + (uri (string-append "https://www.python.org/ftp/python/" version "/Python-" version ".tar.xz")) (sha256 (base32 @@ -165,7 +165,7 @@ data types.") (source (origin (method url-fetch) - (uri (string-append "http://www.python.org/ftp/python/" + (uri (string-append "https://www.python.org/ftp/python/" version "/Python-" version ".tar.xz")) (sha256 (base32