diff options
Diffstat (limited to 'guix/scripts')
| -rw-r--r-- | guix/scripts/offload.scm | 25 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 41 | ||||
| -rw-r--r-- | guix/scripts/package.scm | 30 |
3 files changed, 58 insertions, 38 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm index eb02672dbf..0c0dd9d516 100644 --- a/guix/scripts/offload.scm +++ b/guix/scripts/offload.scm @@ -236,30 +236,6 @@ instead of '~a' of type '~a'~%") ;;; Synchronization. ;;; -(define (lock-file file) - "Wait and acquire an exclusive lock on FILE. Return an open port." - (mkdir-p (dirname file)) - (let ((port (open-file file "w0"))) - (fcntl-flock port 'write-lock) - port)) - -(define (unlock-file lock) - "Unlock LOCK." - (fcntl-flock lock 'unlock) - (close-port lock) - #t) - -(define-syntax-rule (with-file-lock file exp ...) - "Wait to acquire a lock on FILE and evaluate EXP in that context." - (let ((port (lock-file file))) - (dynamic-wind - (lambda () - #t) - (lambda () - exp ...) - (lambda () - (unlock-file port))))) - (define (machine-slot-file machine slot) "Return the file name of MACHINE's file for SLOT." ;; For each machine we have a bunch of files representing each build slot. @@ -829,7 +805,6 @@ This tool is meant to be used internally by 'guix-daemon'.\n")) (leave (G_ "invalid arguments: ~{~s ~}~%") x)))) ;;; Local Variables: -;;; eval: (put 'with-file-lock 'scheme-indent-function 1) ;;; eval: (put 'with-error-to-port 'scheme-indent-function 1) ;;; eval: (put 'with-timeout 'scheme-indent-function 2) ;;; End: diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index c17b374330..5da23e038b 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -152,6 +152,7 @@ dependencies are registered." #:key target (profile-name "guix-profile") deduplicate? + entry-point (compressor (first %compressors)) localstatedir? (symlinks '()) @@ -275,6 +276,10 @@ added to the pack." (_ #f)) directives))))))))) + (when entry-point + (warning (G_ "entry point not supported in the '~a' format~%") + 'tarball)) + (gexp->derivation (string-append name ".tar" (compressor-extension compressor)) build @@ -284,6 +289,7 @@ added to the pack." #:key target (profile-name "guix-profile") (compressor (first %compressors)) + entry-point localstatedir? (symlinks '()) (archiver squashfs-tools-next)) @@ -315,6 +321,7 @@ added to the pack." (ice-9 match)) (define database #+database) + (define entry-point #$entry-point) (setenv "PATH" (string-append #$archiver "/bin")) @@ -371,6 +378,28 @@ added to the pack." target))))))) '#$symlinks) + ;; Create /.singularity.d/actions, and optionally the 'run' + ;; script, used by 'singularity run'. + "-p" "/.singularity.d d 555 0 0" + "-p" "/.singularity.d/actions d 555 0 0" + ,@(if entry-point + `(;; This one if for Singularity 2.x. + "-p" + ,(string-append + "/.singularity.d/actions/run s 777 0 0 " + (relative-file-name "/.singularity.d/actions" + (string-append #$profile "/" + entry-point))) + + ;; This one is for Singularity 3.x. + "-p" + ,(string-append + "/.singularity.d/runscript s 777 0 0 " + (relative-file-name "/.singularity.d" + (string-append #$profile "/" + entry-point)))) + '()) + ;; Create empty mount points. "-p" "/proc d 555 0 0" "-p" "/sys d 555 0 0" @@ -392,6 +421,7 @@ added to the pack." #:key target (profile-name "guix-profile") (compressor (first %compressors)) + entry-point localstatedir? (symlinks '()) (archiver tar)) @@ -425,6 +455,8 @@ the image." #$profile #:database #+database #:system (or #$target (utsname:machine (uname))) + #:entry-point (string-append #$profile "/" + #$entry-point) #:symlinks '#$symlinks #:compressor '#$(compressor-command compressor) #:creation-time (make-time time-utc 0 1)))))) @@ -689,6 +721,9 @@ please email '~a'~%") (lambda (opt name arg result) (alist-cons 'system arg (alist-delete 'system result eq?)))) + (option '("entry-point") #t #f + (lambda (opt name arg result) + (alist-cons 'entry-point arg result))) (option '("target") #t #f (lambda (opt name arg result) (alist-cons 'target arg @@ -766,6 +801,9 @@ Create a bundle of PACKAGE.\n")) (display (G_ " -m, --manifest=FILE create a pack with the manifest from FILE")) (display (G_ " + --entry-point=PROGRAM + use PROGRAM as the entry point of the pack")) + (display (G_ " --save-provenance save provenance information")) (display (G_ " --localstatedir include /var/guix in the resulting pack")) @@ -889,6 +927,7 @@ Create a bundle of PACKAGE.\n")) (leave (G_ "~a: unknown pack format~%") pack-format)))) (localstatedir? (assoc-ref opts 'localstatedir?)) + (entry-point (assoc-ref opts 'entry-point)) (profile-name (assoc-ref opts 'profile-name)) (gc-root (assoc-ref opts 'gc-root))) (when (null? (manifest-entries manifest)) @@ -919,6 +958,8 @@ Create a bundle of PACKAGE.\n")) symlinks #:localstatedir? localstatedir? + #:entry-point + entry-point #:profile-name profile-name #:archiver diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 06e4cf5b9c..5751123525 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -57,7 +57,6 @@ #:export (build-and-use-profile delete-generations delete-matching-generations - display-search-paths guix-package (%options . %package-options) @@ -169,8 +168,7 @@ hooks\" run when building the profile." "~a packages in profile~%" count) count) - (display-search-paths entries (list profile) - #:kind 'prefix))) + (display-search-path-hint entries profile))) (warn-about-disk-space profile)))))) @@ -289,17 +287,23 @@ symlinks like 'canonicalize-path' would do." file (string-append (getcwd) "/" file))) -(define* (display-search-paths entries profiles - #:key (kind 'exact)) - "Display the search path environment variables that may need to be set for -ENTRIES, a list of manifest entries, in the context of PROFILE." - (let* ((profiles (map (compose user-friendly-profile absolutize) - profiles)) - (settings (search-path-environment-variables entries profiles - #:kind kind))) +(define (display-search-path-hint entries profile) + "Display a hint on how to set environment variables to use ENTRIES, a list +of manifest entries, in the context of PROFILE." + (let* ((profile (user-friendly-profile (absolutize profile))) + (settings (search-path-environment-variables entries (list profile) + #:kind 'prefix))) (unless (null? settings) - (format #t (G_ "The following environment variable definitions may be needed:~%")) - (format #t "~{ ~a~%~}" settings)))) + (display-hint (format #f (G_ "Consider setting the necessary environment +variables by running: + +@example +GUIX_PROFILE=\"~a\" +. \"$GUIX_PROFILE/etc/profile\" +@end example + +Alternately, see @command{guix package --search-paths -p ~s}.") + profile profile))))) ;;; |