diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/build.scm | 9 | ||||
| -rw-r--r-- | guix/scripts/describe.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 1 | ||||
| -rw-r--r-- | guix/scripts/import/cran.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 1 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 43 | ||||
| -rw-r--r-- | guix/scripts/pull.scm | 69 | ||||
| -rw-r--r-- | guix/scripts/system.scm | 1 |
8 files changed, 78 insertions, 50 deletions
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index 5a6ba62bc3..13978abb77 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -395,6 +395,8 @@ options handled by 'set-build-options-from-command-line', and listed in #:print-build-trace (assoc-ref opts 'print-build-trace?) #:print-extended-build-trace? (assoc-ref opts 'print-extended-build-trace?) + #:multiplexed-build-output? + (assoc-ref opts 'multiplexed-build-output?) #:verbosity (assoc-ref opts 'verbosity))) (define set-build-options-from-command-line* @@ -505,6 +507,7 @@ options handled by 'set-build-options-from-command-line', and listed in (build-hook? . #t) (print-build-trace? . #t) (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) (verbosity . 0))) (define (show-help) @@ -623,7 +626,7 @@ must be one of 'package', 'all', or 'transitive'~%") "Read the arguments from OPTS and return a list of high-level objects to build---packages, gexps, derivations, and so on." (define (validate-type x) - (unless (or (package? x) (derivation? x) (gexp? x) (procedure? x)) + (unless (or (derivation? x) (file-like? x) (gexp? x) (procedure? x)) (leave (G_ "~s: not something we can build~%") x))) (define (ensure-list x) @@ -700,6 +703,10 @@ package '~a' has no source~%") (set-guile-for-build (default-guile)) (proc)) #:system system))) + ((? file-like? obj) + (list (run-with-store store + (lower-object obj system + #:target (assoc-ref opts 'target))))) ((? gexp? gexp) (list (run-with-store store (mbegin %store-monad diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm index c1a20fe26c..e59502076c 100644 --- a/guix/scripts/describe.scm +++ b/guix/scripts/describe.scm @@ -158,4 +158,4 @@ in the format specified by FMT." (#f (display-checkout-info format)) (profile - (display-profile-info profile format)))))) + (display-profile-info (canonicalize-profile profile) format)))))) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 9fc7edcd36..5965e3426e 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -176,6 +176,7 @@ COMMAND or an interactive shell in that environment.\n")) (graft? . #t) (print-build-trace? . #t) (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) (verbosity . 0))) (define (tag-package-arg opts arg) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index 30ae6d4342..794fb710cd 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -47,6 +47,8 @@ Import and convert the CRAN package for PACKAGE-NAME.\n")) (display (G_ " -h, --help display this help and exit")) (display (G_ " + -r, --recursive import packages recursively")) + (display (G_ " -V, --version display version information and exit")) (newline) (show-bug-report-information)) diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 163f5b1dc1..fb3c50521d 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -541,6 +541,7 @@ please email '~a'~%") (graft? . #t) (print-build-trace? . #t) (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) (verbosity . 0) (symlinks . ()) (compressor . ,(first %compressors)))) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 93a77915fe..5d146b8427 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -68,50 +68,14 @@ (define (ensure-default-profile) "Ensure the default profile symlink and directory exist and are writable." - - (define (rtfm) - (format (current-error-port) - (G_ "Try \"info '(guix) Invoking guix package'\" for \ -more information.~%")) - (exit 1)) + (ensure-profile-directory) ;; Create ~/.guix-profile if it doesn't exist yet. (when (and %user-profile-directory %current-profile (not (false-if-exception (lstat %user-profile-directory)))) - (symlink %current-profile %user-profile-directory)) - - (let ((s (stat %profile-directory #f))) - ;; Attempt to create /…/profiles/per-user/$USER if needed. - (unless (and s (eq? 'directory (stat:type s))) - (catch 'system-error - (lambda () - (mkdir-p %profile-directory)) - (lambda args - ;; Often, we cannot create %PROFILE-DIRECTORY because its - ;; parent directory is root-owned and we're running - ;; unprivileged. - (format (current-error-port) - (G_ "error: while creating directory `~a': ~a~%") - %profile-directory - (strerror (system-error-errno args))) - (format (current-error-port) - (G_ "Please create the `~a' directory, with you as the owner.~%") - %profile-directory) - (rtfm)))) - - ;; Bail out if it's not owned by the user. - (unless (or (not s) (= (stat:uid s) (getuid))) - (format (current-error-port) - (G_ "error: directory `~a' is not owned by you~%") - %profile-directory) - (format (current-error-port) - (G_ "Please change the owner of `~a' to user ~s.~%") - %profile-directory (or (getenv "USER") - (getenv "LOGNAME") - (getuid))) - (rtfm)))) + (symlink %current-profile %user-profile-directory))) (define (delete-generations store profile generations) "Delete GENERATIONS from PROFILE. @@ -332,7 +296,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE." (substitutes? . #t) (build-hook? . #t) (print-build-trace? . #t) - (print-extended-build-trace? . #t))) + (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t))) (define (show-help) (display (G_ "Usage: guix package [OPTION]... diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 803f7cf142..188237aa90 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -64,6 +64,7 @@ (build-hook? . #t) (print-build-trace? . #t) (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) (graft? . #t) (verbosity . 0))) @@ -227,6 +228,60 @@ Download and deploy the latest version of Guix.\n")) ;;; +;;; Profile. +;;; + +(define %current-profile + ;; The "real" profile under /var/guix. + (string-append %profile-directory "/current-guix")) + +(define %user-profile-directory + ;; The user-friendly name of %CURRENT-PROFILE. + (string-append (config-directory #:ensure? #f) "/current")) + +(define (migrate-generations profile directory) + "Migrate the generations of PROFILE to DIRECTORY." + (format (current-error-port) + (G_ "Migrating profile generations to '~a'...~%") + %profile-directory) + (let ((current (generation-number profile))) + (for-each (lambda (generation) + (let ((source (generation-file-name profile generation)) + (target (string-append directory "/current-guix-" + (number->string generation) + "-link"))) + ;; Note: Don't use 'rename-file' as SOURCE and TARGET might + ;; live on different file systems. + (symlink (readlink source) target) + (delete-file source))) + (profile-generations profile)) + (symlink (string-append "current-guix-" + (number->string current) "-link") + (string-append directory "/current-guix")))) + +(define (ensure-default-profile) + (ensure-profile-directory) + + ;; In 0.15.0+ we'd create ~/.config/guix/current-[0-9]*-link symlinks. Move + ;; them to %PROFILE-DIRECTORY. + (unless (string=? %profile-directory + (dirname (canonicalize-profile %user-profile-directory))) + (migrate-generations %user-profile-directory %profile-directory)) + + ;; Make sure ~/.config/guix/current points to /var/guix/profiles/…. + (let ((link %user-profile-directory)) + (unless (equal? (false-if-exception (readlink link)) + %current-profile) + (catch 'system-error + (lambda () + (false-if-exception (delete-file link)) + (symlink %current-profile link)) + (lambda args + (leave (G_ "while creating symlink '~a': ~a~%") + link (strerror (system-error-errno args)))))))) + + +;;; ;;; Queries. ;;; @@ -341,11 +396,8 @@ and ALIST2 differ, display HEADING upfront." (display-new/upgraded-packages (package-alist gen1) (package-alist gen2))) -(define (process-query opts) - "Process any query specified by OPTS." - (define profile - (string-append (config-directory) "/current")) - +(define (process-query opts profile) + "Process any query on PROFILE specified by OPTS." (match (assoc-ref opts 'query) (('list-generations pattern) (define (list-generations profile numbers) @@ -441,11 +493,10 @@ Use '~/.config/guix/channels.scm' instead.")) (list %default-options))) (cache (string-append (cache-directory) "/pull")) (channels (channel-list opts)) - (profile (or (assoc-ref opts 'profile) - (string-append (config-directory) "/current")))) - + (profile (or (assoc-ref opts 'profile) %current-profile))) + (ensure-default-profile) (cond ((assoc-ref opts 'query) - (process-query opts)) + (process-query opts profile)) ((assoc-ref opts 'dry-run?) #t) ;XXX: not very useful (else diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index f9d6b9e5b6..f9af38b7c5 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -1082,6 +1082,7 @@ Some ACTIONS support additional ARGS.\n")) (build-hook? . #t) (print-build-trace? . #t) (print-extended-build-trace? . #t) + (multiplexed-build-output? . #t) (graft? . #t) (verbosity . 0) (file-system-type . "ext4") |