summary refs log tree commit diff
path: root/guix/scripts
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-04-14 16:57:37 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2023-04-14 17:15:08 -0400
commit3bacd3c76a58ebe70f98be654f09cbd4166093ab (patch)
tree89f687565205971a9925d33400235968a569a069 /guix/scripts
parentdf3391c0309443ac37f9a9a6b1038a85454b8ee6 (diff)
parent97ed675718b948319e6f6e51f2d577971bea1176 (diff)
downloadguix-3bacd3c76a58ebe70f98be654f09cbd4166093ab.tar.gz
Merge branch 'master' into core-updates.
Conflicts:
	gnu/local.mk
	gnu/packages/build-tools.scm
	gnu/packages/certs.scm
	gnu/packages/check.scm
	gnu/packages/compression.scm
	gnu/packages/cups.scm
	gnu/packages/fontutils.scm
	gnu/packages/gnuzilla.scm
	gnu/packages/guile.scm
	gnu/packages/ibus.scm
	gnu/packages/image-processing.scm
	gnu/packages/linux.scm
	gnu/packages/music.scm
	gnu/packages/nss.scm
	gnu/packages/pdf.scm
	gnu/packages/python-xyz.scm
	gnu/packages/qt.scm
	gnu/packages/ruby.scm
	gnu/packages/shells.scm
	gnu/packages/tex.scm
	gnu/packages/video.scm
	gnu/packages/vulkan.scm
	gnu/packages/web.scm
	gnu/packages/webkit.scm
	gnu/packages/wm.scm
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/environment.scm66
-rw-r--r--guix/scripts/import/opam.scm4
-rw-r--r--guix/scripts/refresh.scm4
-rw-r--r--guix/scripts/shell.scm2
4 files changed, 68 insertions, 8 deletions
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index a4939ea63c..ebfc05731c 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -31,6 +31,8 @@
   #:use-module (guix build utils)
   #:use-module (guix monads)
   #:use-module ((guix gexp) #:select (lower-object))
+  #:autoload   (guix describe) (current-profile current-channels)
+  #:autoload   (guix channels) (guix-channel? channel-commit)
   #:use-module (guix scripts)
   #:use-module (guix scripts build)
   #:autoload   (guix scripts pack) (symlink-spec-option-parser)
@@ -49,9 +51,11 @@
   #:autoload   (gnu packages) (specification->package+output)
   #:autoload   (gnu packages bash) (bash)
   #:autoload   (gnu packages bootstrap) (bootstrap-executable %bootstrap-guile)
+  #:autoload   (gnu packages package-management) (guix)
   #:use-module (ice-9 match)
   #:autoload   (ice-9 rdelim) (read-line)
   #:use-module (ice-9 vlist)
+  #:autoload   (web uri) (string->uri uri-scheme)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
@@ -108,6 +112,8 @@ shell'."
   -P, --link-profile     link environment profile to ~/.guix-profile within
                          an isolated container"))
   (display (G_ "
+  -W, --nesting          make Guix available within the container"))
+  (display (G_ "
   -u, --user=USER        instead of copying the name and home of the current
                          user into an isolated container, use the name USER
                          with home directory /home/USER"))
@@ -238,6 +244,9 @@ use '--preserve' instead~%"))
          (option '(#\N "network") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'network? #t result)))
+         (option '(#\W "nesting") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'nesting? #t result)))
          (option '(#\P "link-profile") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'link-profile? #t result)))
@@ -342,6 +351,26 @@ for the corresponding packages."
                      (packages->outputs (load* file module) mode)))
                   (('manifest . file)
                    (manifest-entries (load-manifest file)))
+                  (('nesting? . #t)
+                   (if (assoc-ref opts 'profile)
+                       '()
+                       (let ((profile (and=> (current-profile) readlink*)))
+                         (if (or (not profile) (not (store-path? profile)))
+                             (begin
+                               (warning (G_ "\
+could not add current Guix to the profile~%"))
+                               '())
+                             (list (manifest-entry
+                                     (name "guix")
+                                     (version
+                                      (or (any (lambda (channel)
+                                                 (and (guix-channel? channel)
+                                                      (channel-commit channel)))
+                                               (current-channels))
+                                          "0"))
+                                     (item profile)
+                                     (search-paths
+                                      (package-native-search-paths guix))))))))
                   (_ '()))
                 opts)
     manifest-entry=?)))
@@ -688,7 +717,8 @@ regexps in WHITE-LIST."
 
 (define* (launch-environment/container #:key command bash user user-mappings
                                        profile manifest link-profile? network?
-                                       map-cwd? emulate-fhs? (setup-hook #f)
+                                       map-cwd? emulate-fhs? nesting?
+                                       (setup-hook #f)
                                        (symlinks '()) (white-list '()))
   "Run COMMAND within a container that features the software in PROFILE.
 Environment variables are set according to the search paths of MANIFEST.  The
@@ -704,6 +734,9 @@ Standard and provide a glibc that reads the cache from /etc/ld.so.cache.
 SETUP-HOOK is an additional setup procedure to be called, currently only used
 with the EMULATE-FHS? option.
 
+When NESTING? is true, share all the store with the container and add Guix to
+its profile, allowing its use from within the container.
+
 LINK-PROFILE? creates a symbolic link from ~/.guix-profile to the
 environment profile.
 
@@ -731,8 +764,26 @@ WHILE-LIST."
            ("/libexec" . "/usr/libexec")
            ("/share"   . "/usr/share"))))
 
-  (mlet %store-monad ((reqs (inputs->requisites
-                             (list (direct-store-path bash) profile))))
+  (define (nesting-mappings)
+    ;; Files shared with the host when enabling nesting.
+    (cons* (file-system-mapping
+            (source (%store-prefix))
+            (target source))
+           (file-system-mapping
+            (source (cache-directory))
+            (target source)
+            (writable? #t))
+           (let ((uri (string->uri (%daemon-socket-uri))))
+             (if (or (not uri) (eq? 'file (uri-scheme uri)))
+                 (list (file-system-mapping
+                        (source (%daemon-socket-uri))
+                        (target source)))
+                 '()))))
+
+  (mlet %store-monad ((reqs (if nesting?
+                                (return '())
+                                (inputs->requisites
+                                 (list (direct-store-path bash) profile)))))
     (return
      (let* ((cwd      (getcwd))
             (home     (getenv "HOME"))
@@ -795,11 +846,14 @@ WHILE-LIST."
                                       (filter-map optional-mapping->fs
                                                   %network-file-mappings)
                                       '())
-                                  ;; Mappings for an FHS container.
                                   (if emulate-fhs?
                                       (filter-map optional-mapping->fs
                                                   fhs-mappings)
                                       '())
+                                  (if nesting?
+                                      (filter-map optional-mapping->fs
+                                                  (nesting-mappings))
+                                      '())
                                   (map file-system-mapping->bind-mount
                                        mappings))))
        (exit/status
@@ -1013,6 +1067,7 @@ command-line option processing with 'parse-command-line'."
          (network?     (assoc-ref opts 'network?))
          (no-cwd?      (assoc-ref opts 'no-cwd?))
          (emulate-fhs? (assoc-ref opts 'emulate-fhs?))
+         (nesting?     (assoc-ref opts 'nesting?))
          (user         (assoc-ref opts 'user))
          (bootstrap?   (assoc-ref opts 'bootstrap?))
          (system       (assoc-ref opts 'system))
@@ -1059,6 +1114,8 @@ command-line option processing with 'parse-command-line'."
         (leave (G_ "--no-cwd cannot be used without '--container'~%")))
       (when emulate-fhs?
         (leave (G_ "'--emulate-fhs' cannot be used without '--container~%'")))
+      (when nesting?
+        (leave (G_ "'--nesting' cannot be used without '--container~%'")))
       (when (pair? symlinks)
         (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
 
@@ -1141,6 +1198,7 @@ when using '--container'; doing nothing~%"))
                                                   #:network? network?
                                                   #:map-cwd? (not no-cwd?)
                                                   #:emulate-fhs? emulate-fhs?
+                                                  #:nesting? nesting?
                                                   #:symlinks symlinks
                                                   #:setup-hook
                                                   (and emulate-fhs?
diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm
index 834ac34cb0..5bc7ad2122 100644
--- a/guix/scripts/import/opam.scm
+++ b/guix/scripts/import/opam.scm
@@ -47,8 +47,8 @@ Import and convert the opam package for PACKAGE-NAME.\n"))
   (display (G_ "
   -r, --recursive        import packages recursively"))
   (display (G_ "
-      --repo             import packages from this opam repository (name, URL or local path)
-                         can be used more than once"))
+      --repo=REPOSITORY  import packages from REPOSITORY (name, URL, or
+                         file name); can be used more than once"))
   (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm
index ee94ed29a1..bc6c24967a 100644
--- a/guix/scripts/refresh.scm
+++ b/guix/scripts/refresh.scm
@@ -98,7 +98,7 @@
         (option '(#\r "recursive") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'recursive? #t result)))
-        (option '("list-transitive") #f #f
+        (option '(#\T "list-transitive") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'list-transitive? #t result)))
 
@@ -156,7 +156,7 @@ specified with `--select'.\n"))
   (display (G_ "
   -r, --recursive        check the PACKAGE and its inputs for upgrades"))
   (display (G_ "
-      --list-transitive  list all the packages that PACKAGE depends on"))
+  -T, --list-transitive  list all the packages that PACKAGE depends on"))
   (newline)
   (display (G_ "
       --keyring=FILE     use FILE as the keyring of upstream OpenPGP keys"))
diff --git a/guix/scripts/shell.scm b/guix/scripts/shell.scm
index 92bbfb04d0..1b42cc2af0 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -389,6 +389,8 @@ return #f and #f."
        (if (not file)
            (loop rest system file (cons spec specs))
            (values #f #f)))
+      ((('nesting? . #t) . rest)
+       (loop rest system file (append specs '("nested guix"))))
       ((('load . ('package candidate)) . rest)
        (if (and (not file) (null? specs))
            (loop rest system candidate specs)