From 6f58d582432fe46c163f61ddf8f653584f4f7be8 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 10 Mar 2014 23:58:40 +0100 Subject: 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. --- guix/derivations.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'guix') 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))) -- cgit v1.2.3 From d91a879121485b079796ab5174468bf4c034ae40 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 11 Mar 2014 22:09:31 +0100 Subject: 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(-) (limited to 'guix') 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 -- cgit v1.2.3 From 7f3673f21d1bf1d40a587ffbca7ced7de33a8535 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 11 Mar 2014 22:08:40 +0100 Subject: 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(-) (limited to 'guix') 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)))))) ;;; -- cgit v1.2.3 From 257b93412ad52dc26b53e0dae71a79b9b51ab33f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 13 Mar 2014 19:21:49 +0100 Subject: 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(-) (limited to 'guix') 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)) -- cgit v1.2.3 From cecd72d55ae974f8ebe900e0088071f843866935 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 13 Mar 2014 21:58:04 +0100 Subject: 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(-) (limited to 'guix') 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") -- cgit v1.2.3 From 3c0e6e6080242656104143612ba57bc210779709 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 13 Mar 2014 22:46:32 +0100 Subject: 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(-) (limited to 'guix') 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") -- cgit v1.2.3 From 1a8ea0a1885ca5fff85eb00fc79d6c6bcd47818a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 13 Mar 2014 22:57:21 +0100 Subject: 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(-) (limited to 'guix') 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?)))) -- cgit v1.2.3 From 11e7a6cf4612b83f3fe3ecfcce3e7c0b21ecf953 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 14 Mar 2014 17:16:10 +0100 Subject: 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(-) (limited to 'guix') 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)))) -- cgit v1.2.3