diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/build-system/cmake.scm | 9 | ||||
| -rw-r--r-- | guix/build/linux-initrd.scm | 8 | ||||
| -rw-r--r-- | guix/build/union.scm | 29 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 28 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 6 | ||||
| -rwxr-xr-x | guix/scripts/substitute-binary.scm | 39 | ||||
| -rw-r--r-- | guix/store.scm | 2 | ||||
| -rw-r--r-- | guix/ui.scm | 1 |
8 files changed, 97 insertions, 25 deletions
diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 3347dc502c..76a9a3befe 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -35,13 +35,20 @@ ;; ;; Code: +(define (default-cmake) + "Return the default CMake package." + + ;; Do not use `@' to avoid introducing circular dependencies. + (let ((module (resolve-interface '(gnu packages cmake)))) + (module-ref module 'cmake))) + (define* (cmake-build store name source inputs #:key (guile #f) (outputs '("out")) (configure-flags ''()) (search-paths '()) (make-flags ''()) (patches ''()) (patch-flags ''("--batch" "-p1")) - (cmake (@ (gnu packages cmake) cmake)) + (cmake (default-cmake)) (out-of-source? #f) (tests? #t) (test-target "test") diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 208ad711ef..cbdb363b4e 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -80,13 +80,19 @@ (mknod (scope "dev/vda2") 'block-special #o644 (device-number 8 2)) ;; TTYs. + (mknod (scope "dev/tty") 'char-special #o600 + (device-number 5 0)) (let loop ((n 0)) (and (< n 50) (let ((name (format #f "dev/tty~a" n))) - (mknod (scope name) 'block-special #o644 + (mknod (scope name) 'char-special #o600 (device-number 4 n)) (loop (+ 1 n))))) + ;; Rendez-vous point for syslogd. + (mknod (scope "dev/log") 'socket #o666 0) + (mknod (scope "dev/kmsg") 'char-special #o600 (device-number 1 11)) + ;; Other useful nodes. (mknod (scope "dev/null") 'char-special #o666 (device-number 1 3)) (mknod (scope "dev/zero") 'char-special #o666 (device-number 1 5))) diff --git a/guix/build/union.scm b/guix/build/union.scm index 275746d83e..077b7fe530 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -105,7 +105,22 @@ single leaf." the DIRECTORIES." (define (file-tree dir) ;; Return the contents of DIR as a tree. - (match (file-system-fold (const #t) + + (define (others-have-it? subdir) + ;; Return #t if other elements of DIRECTORIES have SUBDIR. + (let ((subdir (substring subdir (string-length dir)))) + (any (lambda (other) + (and (not (string=? other dir)) + (file-exists? (string-append other "/" subdir)))) + directories))) + + (match (file-system-fold (lambda (subdir stat result) ; enter? + ;; No need to traverse DIR since there's + ;; nothing to union it with. Thus, we avoid + ;; creating a gazillon symlinks (think + ;; share/emacs/24.3, share/texmf, etc.) + (or (string=? subdir dir) + (others-have-it? subdir))) (lambda (file stat result) ; leaf (match result (((siblings ...) rest ...) @@ -117,7 +132,12 @@ the DIRECTORIES." (((leaves ...) (siblings ...) rest ...) `(((,(basename dir) ,@leaves) ,@siblings) ,@rest)))) - (const #f) ; skip + (lambda (dir stat result) ; skip + ;; DIR is not available elsewhere, so treat it + ;; as a leaf. + (match result + (((siblings ...) rest ...) + `((,dir ,@siblings) ,@rest)))) (lambda (file stat errno result) (format (current-error-port) "union-build: ~a: ~a~%" file (strerror errno))) @@ -158,8 +178,9 @@ the DIRECTORIES." (mkdir output) (let loop ((tree (delete-duplicate-leaves (cons "." - (tree-union (append-map (compose tree-leaves file-tree) - directories))) + (tree-union + (append-map (compose tree-leaves file-tree) + (delete-duplicates directories)))) leaf=? resolve-collision)) (dir '())) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 5c3947dd63..1393ca3180 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -95,7 +95,7 @@ (make-regexp (string-append "^" (regexp-quote (basename profile)) "-([0-9]+)"))) -(define (profile-numbers profile) +(define (generation-numbers profile) "Return the list of generation numbers of PROFILE, or '(0) if no former profiles were found." (define* (scandir name #:optional (select? (const #t)) @@ -144,7 +144,7 @@ former profiles were found." (cute regexp-exec (profile-regexp profile) <>)) profiles)))) -(define (previous-profile-number profile number) +(define (previous-generation-number profile number) "Return the number of the generation before generation NUMBER of PROFILE, or 0 if none exists. It could be NUMBER - 1, but it's not the case when generations have been deleted (there are \"holes\")." @@ -153,7 +153,7 @@ case when generations have been deleted (there are \"holes\")." candidate highest)) 0 - (profile-numbers profile))) + (generation-numbers profile))) (define (profile-derivation store packages) "Return a derivation that builds a profile (a user environment) with @@ -205,7 +205,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." packages) #:modules '((guix build union)))) -(define (profile-number profile) +(define (generation-number profile) "Return PROFILE's number or 0. An absolute file name must be used." (or (and=> (false-if-exception (regexp-exec (profile-regexp profile) (basename (readlink profile)))) @@ -214,17 +214,17 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (define (roll-back profile) "Roll back to the previous generation of PROFILE." - (let* ((number (profile-number profile)) - (previous-number (previous-profile-number profile number)) - (previous-profile (format #f "~a-~a-link" - profile previous-number)) - (manifest (string-append previous-profile "/manifest"))) + (let* ((number (generation-number profile)) + (previous-number (previous-generation-number profile number)) + (previous-generation (format #f "~a-~a-link" + profile previous-number)) + (manifest (string-append previous-generation "/manifest"))) (define (switch-link) - ;; Atomically switch PROFILE to the previous profile. + ;; Atomically switch PROFILE to the previous generation. (format #t (_ "switching from generation ~a to ~a~%") number previous-number) - (switch-symlinks profile previous-profile)) + (switch-symlinks profile previous-generation)) (cond ((not (file-exists? profile)) ; invalid profile (leave (_ "profile `~a' does not exist~%") @@ -233,7 +233,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (format (current-error-port) (_ "nothing to do: already at the empty profile~%"))) ((or (zero? previous-number) ; going to emptiness - (not (file-exists? previous-profile))) + (not (file-exists? previous-generation))) (let*-values (((drv-path drv) (profile-derivation (%store) '())) ((prof) @@ -242,7 +242,7 @@ all of PACKAGES, a list of name/version/output/path/deps tuples." (when (not (build-derivations (%store) (list drv-path))) (leave (_ "failed to build the empty profile~%"))) - (switch-symlinks previous-profile prof) + (switch-symlinks previous-generation prof) (switch-link))) (else (switch-link))))) ; anything else @@ -846,7 +846,7 @@ more information.~%")) (%store) (manifest-packages (profile-manifest profile)))) (old-prof (derivation-path->output-path old-drv)) - (number (profile-number profile)) + (number (generation-number profile)) ;; Always use NUMBER + 1 for the new profile, ;; possibly overwriting a "previous future diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index f4135efc99..f3d87a63c0 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -106,6 +106,8 @@ files." (when (string-suffix? ".scm" file) (let ((go (string-append (string-drop-right file 4) ".go"))) + (format (current-error-port) + "compiling '~a'...~%" file) (compile-file file #:output-file go #:opts %auto-compilation-options)))) @@ -114,7 +116,9 @@ files." ;; download), we must build it first to avoid errors since ;; (gnutls) is unavailable. (cons (string-append out "/guix/build/download.scm") - (find-files out "\\.scm"))) + + ;; Sort the file names to get deterministic results. + (sort (find-files out "\\.scm") string<?))) ;; Remove the "fake" (guix config). (delete-file (string-append out "/guix/config.scm")) diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm index 97bbfcbce8..1afc93bbc9 100755 --- a/guix/scripts/substitute-binary.scm +++ b/guix/scripts/substitute-binary.scm @@ -446,6 +446,30 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by ;;; +;;; Help. +;;; + +(define (show-help) + (display (_ "Usage: guix substitute-binary [OPTION]... +Internal tool to substitute a pre-built binary to a local build.\n")) + (display (_ " + --query report on the availability of substitutes for the + store file names passed on the standard input")) + (display (_ " + --substitute STORE-FILE DESTINATION + download STORE-FILE and store it as a Nar in file + DESTINATION")) + (newline) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -V, --version display version information and exit")) + (newline) + (show-bug-report-information)) + + + +;;; ;;; Entry point. ;;; @@ -508,8 +532,13 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by ;; Tell the daemon what the expected hash of the Nar itself is. (format #t "~a~%" (narinfo-hash narinfo)) - (format (current-error-port) "downloading `~a' from `~a'...~%" - store-path (uri->string uri)) + (format (current-error-port) "downloading `~a' from `~a'~:[~*~; (~,1f MiB installed)~]...~%" + store-path (uri->string uri) + + ;; Use the Nar size as an estimate of the installed size. + (narinfo-size narinfo) + (and=> (narinfo-size narinfo) + (cute / <> (expt 2. 20)))) (let*-values (((raw download-size) ;; Note that Hydra currently generates Nars on the fly ;; and doesn't specify a Content-Length, so @@ -531,7 +560,11 @@ PORT. REPORT-PROGRESS is a two-argument procedure such as that returned by (restore-file input destination) (every (compose zero? cdr waitpid) pids)))) (("--version") - (show-version-and-exit "guix substitute-binary"))))) + (show-version-and-exit "guix substitute-binary")) + (("--help") + (show-help)) + (opts + (leave (_ "~a: unrecognized options~%") opts))))) ;;; Local Variables: diff --git a/guix/store.scm b/guix/store.scm index 541c7c848f..0f1e2f9466 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -452,7 +452,7 @@ encoding conversion errors." (string-list references)) #f store-path))) - (lambda (server name text references) + (lambda* (server name text #:optional (references '())) "Add TEXT under file NAME in the store, and return its store path. REFERENCES is the list of store paths referred to by the resulting store path." diff --git a/guix/ui.scm b/guix/ui.scm index 9251d73f18..720d01be02 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -242,6 +242,7 @@ available for download." (substitutable-path-info store download))))) download))) + ;; TODO: Show the installed size of DOWNLOAD. (if dry-run? (begin (format (current-error-port) |