From 99aec37a78e7be6a591d0e5b7439896d669a75d1 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 14 Mar 2019 17:02:53 +0100 Subject: pack: "-RR" produces PRoot-enabled relocatable binaries. * gnu/packages/aux-files/run-in-namespace.c (exec_with_proot): New function. (main): When 'clone' fails, call 'rm_rf'. [PROOT_PROGRAM]: When 'clone' fails, call 'exec_with_proot'. * guix/scripts/pack.scm (wrapped-package): Add #:proot?. [proot]: New procedure. [build]: Compile with -DPROOT_PROGRAM when PROOT? is true. * guix/scripts/pack.scm (%options): Set the 'relocatable?' value to 'proot when "-R" is passed several times. (guix-pack): Pass #:proot? to 'wrapped-package'. * tests/guix-pack-relocatable.sh: Use "-RR" on Intel systems that lack user namespace support. * doc/guix.texi (Invoking guix pack): Document -RR. --- guix/scripts/pack.scm | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) (limited to 'guix/scripts/pack.scm') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index e2ecddfbfc..bfb8b85356 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -517,10 +517,14 @@ please email '~a'~%") ;;; (define* (wrapped-package package - #:optional (compiler (c-compiler))) + #:optional (compiler (c-compiler)) + #:key proot?) (define runner (local-file (search-auxiliary-file "run-in-namespace.c"))) + (define (proot) + (specification->package "proot-static")) + (define build (with-imported-modules (source-module-closure '((guix build utils) @@ -550,10 +554,19 @@ please email '~a'~%") (("@STORE_DIRECTORY@") (%store-directory))) (let* ((base (strip-store-prefix program)) - (result (string-append #$output "/" base))) + (result (string-append #$output "/" base)) + (proot #$(and proot? + #~(string-drop + #$(file-append (proot) "/bin/proot") + (+ (string-length (%store-directory)) + 1))))) (mkdir-p (dirname result)) - (invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall" - "run.c" "-o" result) + (apply invoke #$compiler "-std=gnu99" "-static" "-Os" "-g0" "-Wall" + "run.c" "-o" result + (if proot + (list (string-append "-DPROOT_PROGRAM=\"" + proot "\"")) + '())) (delete-file "run.c"))) (setvbuf (current-output-port) 'line) @@ -646,7 +659,12 @@ please email '~a'~%") (exit 0))) (option '(#\R "relocatable") #f #f (lambda (opt name arg result) - (alist-cons 'relocatable? #t result))) + (match (assq-ref result 'relocatable?) + (#f + (alist-cons 'relocatable? #t result)) + (_ + (alist-cons 'relocatable? 'proot + (alist-delete 'relocatable? result)))))) (option '(#\e "expression") #t #f (lambda (opt name arg result) (alist-cons 'expression arg result))) @@ -821,11 +839,14 @@ Create a bundle of PACKAGE.\n")) #:graft? (assoc-ref opts 'graft?)))) (let* ((dry-run? (assoc-ref opts 'dry-run?)) (relocatable? (assoc-ref opts 'relocatable?)) + (proot? (eq? relocatable? 'proot)) (manifest (let ((manifest (manifest-from-args store opts))) ;; Note: We cannot honor '--bootstrap' here because ;; 'glibc-bootstrap' lacks 'libc.a'. (if relocatable? - (map-manifest-entries wrapped-package manifest) + (map-manifest-entries + (cut wrapped-package <> #:proot? proot?) + manifest) manifest))) (pack-format (assoc-ref opts 'format)) (name (string-append (symbol->string pack-format) -- cgit v1.2.3 From 41dfe40f5dbd162558c3954ae8eb991a56a65682 Mon Sep 17 00:00:00 2001 From: "P.C. Shyamshankar" Date: Fri, 22 Feb 2019 22:38:47 -0500 Subject: pack: Construct inferior package names correctly. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/scripts/pack.scm (wrapped-package): now correctly constructs full names of inferior packages. Co-authored-by: Ludovic Courtès --- guix/scripts/pack.scm | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'guix/scripts/pack.scm') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index bfb8b85356..17a166d9d7 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -28,6 +28,7 @@ #:use-module (guix store) #:use-module ((guix status) #:select (with-status-verbosity)) #:use-module (guix grafts) + #:autoload (guix inferior) (inferior-package?) #:use-module (guix monads) #:use-module (guix modules) #:use-module (guix packages) @@ -586,7 +587,15 @@ please email '~a'~%") (find-files #$(file-append package "/sbin")) (find-files #$(file-append package "/libexec"))))))) - (computed-file (string-append (package-full-name package "-") "R") + (computed-file (string-append + (cond ((package? package) + (package-full-name package "-")) + ((inferior-package? package) + (string-append (inferior-package-name package) + "-" + (inferior-package-version package))) + (else "wrapper")) + "R") build)) (define (map-manifest-entries proc manifest) -- cgit v1.2.3 From 427c87d0bdc06cc3ee7fc220fd3ad36084412533 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 19 Mar 2019 11:03:35 +0100 Subject: pack: Produce relative symlinks when using '-f squashfs'. Fixes . * guix/scripts/pack.scm (squashfs-image)[build]: Use 'relative-file-name' when creating SYMLINKS. * guix/scripts/pack.scm (guix-pack): Pass #:relative-symlinks? #t when PACK-FORMAT is 'squashfs. --- guix/scripts/pack.scm | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) (limited to 'guix/scripts/pack.scm') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 17a166d9d7..8685ba1d0a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -306,11 +306,13 @@ added to the pack." (with-imported-modules (source-module-closure '((guix build utils) (guix build store-copy) + (guix build union) (gnu build install)) #:select? not-config?) #~(begin (use-modules (guix build utils) (guix build store-copy) + ((guix build union) #:select (relative-file-name)) (gnu build install) (srfi srfi-1) (srfi srfi-26) @@ -359,12 +361,18 @@ added to the pack." ,@(append-map (match-lambda ((source '-> target) - (list "-p" - (string-join - ;; name s mode uid gid symlink - (list source - "s" "777" "0" "0" - (string-append #$profile "/" target)))))) + ;; Create relative symlinks to work around a bug in + ;; Singularity 2.x: + ;; https://bugs.gnu.org/34913 + ;; https://github.com/sylabs/singularity/issues/1487 + (let ((target (string-append #$profile "/" target))) + (list "-p" + (string-join + ;; name s mode uid gid symlink + (list source + "s" "777" "0" "0" + (relative-file-name (dirname source) + target))))))) '#$symlinks) ;; Create empty mount points. @@ -881,7 +889,14 @@ Create a bundle of PACKAGE.\n")) (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest - #:relative-symlinks? relocatable? + + ;; Always produce relative + ;; symlinks for Singularity (see + ;; ). + #:relative-symlinks? + (or relocatable? + (eq? 'squashfs pack-format)) + #:hooks (if bootstrap? '() %default-profile-hooks) -- cgit v1.2.3 From 6c5e618ca004d3714d9de7676f2a984735bfe17b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 19 Mar 2019 11:14:39 +0100 Subject: pack: Create an empty /home directory for '-f squashfs'. Fixes . * guix/scripts/pack.scm (squashfs-image)[build]: Pass "-p /home d 555 0 0". --- guix/scripts/pack.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/scripts/pack.scm') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 8685ba1d0a..e5502ef9ca 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -378,7 +378,8 @@ added to the pack." ;; Create empty mount points. "-p" "/proc d 555 0 0" "-p" "/sys d 555 0 0" - "-p" "/dev d 555 0 0")) + "-p" "/dev d 555 0 0" + "-p" "/home d 555 0 0")) (when database ;; Initialize /var/guix. -- cgit v1.2.3