Merge branch 'master' into core-updates

6 files changed, 96 insertions, 43 deletions

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 44db75b7c2..600750e846 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -1504,24 +1504,37 @@ are searched for in PATH.  Return #f when MODULES and EXTENSIONS are empty."
                                                       #:module-path path
                                                       #:system system
                                                       #:target target)))
-        (return (gexp (eval-when (expand load eval)
-                        (set! %load-path
-                          (cons (ungexp modules)
-                                (append (map (lambda (extension)
-                                               (string-append extension
-                                                              "/share/guile/site/"
-                                                              (effective-version)))
-                                             '((ungexp-native-splicing extensions)))
-                                        %load-path)))
-                        (set! %load-compiled-path
-                          (cons (ungexp compiled)
-                                (append (map (lambda (extension)
-                                               (string-append extension
-                                                              "/lib/guile/"
-                                                              (effective-version)
-                                                              "/site-ccache"))
-                                             '((ungexp-native-splicing extensions)))
-                                        %load-compiled-path)))))))))
+        (return
+         (gexp (eval-when (expand load eval)
+                 ;; Augment the load paths and delete duplicates.  Do that
+                 ;; without loading (srfi srfi-1) or anything.
+                 (let ((extensions '((ungexp-native-splicing extensions)))
+                       (prepend (lambda (items lst)
+                                  ;; This is O(N²) but N is typically small.
+                                  (let loop ((items items)
+                                             (lst lst))
+                                    (if (null? items)
+                                        lst
+                                        (loop (cdr items)
+                                              (cons (car items)
+                                                    (delete (car items) lst))))))))
+                   (set! %load-path
+                     (prepend (cons (ungexp modules)
+                                    (map (lambda (extension)
+                                           (string-append extension
+                                                          "/share/guile/site/"
+                                                          (effective-version)))
+                                         extensions))
+                              %load-path))
+                   (set! %load-compiled-path
+                     (prepend (cons (ungexp compiled)
+                                    (map (lambda (extension)
+                                           (string-append extension
+                                                          "/lib/guile/"
+                                                          (effective-version)
+                                                          "/site-ccache"))
+                                         extensions))
+                              %load-compiled-path)))))))))
 
 (define* (gexp->script name exp
                        #:key (guile (default-guile))
diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index fd1974eae8..8dc014d232 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -40,6 +40,7 @@
   #:use-module (srfi srfi-26)
   #:export (crate->guix-package
             guix-package->crate-name
+            crate-recursive-import
             %crate-updater))
 
 
@@ -218,16 +219,24 @@ latest version of CRATE-NAME."
               (cargo-development-inputs
                (sort (map crate-dependency-id dev-dep-crates)
                      string-ci<?)))
-         (make-crate-sexp #:name crate-name
-                          #:version (crate-version-number version*)
-                          #:cargo-inputs cargo-inputs
-                          #:cargo-development-inputs cargo-development-inputs
-                          #:home-page (or (crate-home-page crate)
-                                          (crate-repository crate))
-                          #:synopsis (crate-description crate)
-                          #:description (crate-description crate)
-                          #:license (and=> (crate-version-license version*)
-                                           string->license)))))
+         (values
+          (make-crate-sexp #:name crate-name
+                           #:version (crate-version-number version*)
+                           #:cargo-inputs cargo-inputs
+                           #:cargo-development-inputs cargo-development-inputs
+                           #:home-page (or (crate-home-page crate)
+                                           (crate-repository crate))
+                           #:synopsis (crate-description crate)
+                           #:description (crate-description crate)
+                           #:license (and=> (crate-version-license version*)
+                                            string->license))
+          (append cargo-inputs cargo-development-inputs)))))
+
+(define (crate-recursive-import crate-name)
+  (recursive-import crate-name #f
+                    #:repo->guix-package (lambda (name repo)
+                                           (crate->guix-package name))
+                    #:guix-name crate-name->package-name))
 
 (define (guix-package->crate-name package)
   "Return the crate name of PACKAGE."
diff --git a/guix/inferior.scm b/guix/inferior.scm
index dcbc954432..d6d2053ab8 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -136,8 +136,8 @@ it's an old Guix."
                       (object->string
                        `(begin
                           (primitive-load ,(search-path %load-path
-                                                        "guix/scripts/repl.scm"))
-                          ((@ (guix scripts repl) machine-repl))))))
+                                                        "guix/repl.scm"))
+                          ((@ (guix repl) machine-repl))))))
         pipe)))
 
 (define* (port->inferior pipe #:optional (close close-port))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index cfe0a37c42..d78ca0f303 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -453,7 +453,7 @@ regexps in WHITE-LIST."
 
 (define* (launch-environment/container #:key command bash user user-mappings
                                        profile manifest link-profile? network?
-                                       map-cwd?)
+                                       map-cwd? (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 global shell is BASH, a file name for a GNU Bash binary in the
@@ -462,7 +462,10 @@ USER-MAPPINGS, a list of file system mappings, contains the user-specified
 host file systems to mount inside the container.  If USER is not #f, each
 target of USER-MAPPINGS will be re-written relative to '/home/USER', and USER
 will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
-~/.guix-profile to the environment profile."
+~/.guix-profile to the environment profile.
+
+Preserve environment variables whose name matches the one of the regexps in
+WHILE-LIST."
   (define (optional-mapping->fs mapping)
     (and (file-exists? (file-system-mapping-source mapping))
          (file-system-mapping->bind-mount mapping)))
@@ -488,6 +491,11 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
                             (group-entry (gid 65534) ;the overflow GID
                                          (name "overflow"))))
             (home-dir (password-entry-directory passwd))
+            (environ  (filter (match-lambda
+                                ((variable . value)
+                                 (find (cut regexp-exec <> variable)
+                                       white-list)))
+                              (get-environment-variables)))
             ;; Bind-mount all requisite store items, user-specified mappings,
             ;; /bin/sh, the current working directory, and possibly networking
             ;; configuration files within the container.
@@ -556,6 +564,12 @@ will be used for the passwd entry.  LINK-PROFILE? creates a symbolic link from
                        (override-user-dir user home cwd)
                        home-dir))
 
+            ;; Set environment variables that match WHITE-LIST.
+            (for-each (match-lambda
+                        ((variable . value)
+                         (setenv variable value)))
+                      environ)
+
             (primitive-exit/status
              ;; A container's environment is already purified, so no need to
              ;; request it be purified again.
@@ -759,6 +773,7 @@ message if any test fails."
                                                     #:user-mappings mappings
                                                     #:profile profile
                                                     #:manifest manifest
+                                                    #:white-list white-list
                                                     #:link-profile? link-prof?
                                                     #:network? network?
                                                     #:map-cwd? (not no-cwd?))))
diff --git a/guix/scripts/import/crate.scm b/guix/scripts/import/crate.scm
index 7ae8638911..4690cceb4d 100644
--- a/guix/scripts/import/crate.scm
+++ b/guix/scripts/import/crate.scm
@@ -28,6 +28,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-41)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:export (guix-import-crate))
@@ -44,6 +45,9 @@
   (display (G_ "Usage: guix import crate PACKAGE-NAME
 Import and convert the crate.io package for PACKAGE-NAME.\n"))
   (display (G_ "
+  -r, --recursive        import packages recursively"))
+  (newline)
+  (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -V, --version          display version information and exit"))
@@ -59,6 +63,9 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix import crate")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
          %standard-import-options))
 
 
@@ -79,22 +86,31 @@ Import and convert the crate.io package for PACKAGE-NAME.\n"))
 
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
-                            (('argument . value)
-                             value)
-                            (_ #f))
+                             (('argument . value)
+                              value)
+                             (_ #f))
                            (reverse opts))))
     (match args
       ((spec)
        (define-values (name version)
          (package-name->name+version spec))
 
-       (let ((sexp (crate->guix-package name version)))
-         (unless sexp
-           (leave (G_ "failed to download meta-data for package '~a'~%")
-                  (if version
-                      (string-append name "@" version)
-                      name)))
-         sexp))
+       (if (assoc-ref opts 'recursive)
+           (map (match-lambda
+                  ((and ('package ('name name) . rest) pkg)
+                   `(define-public ,(string->symbol name)
+                      ,pkg))
+                  (_ #f))
+                (reverse
+                 (stream->list
+                  (crate-recursive-import name))))
+           (let ((sexp (crate->guix-package name version)))
+             (unless sexp
+               (leave (G_ "failed to download meta-data for package '~a'~%")
+                      (if version
+                          (string-append name "@" version)
+                          name)))
+             sexp)))
       (()
        (leave (G_ "too few arguments~%")))
       ((many ...)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index e018985469..04970cf503 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -314,7 +314,7 @@ to display."
                (removed
                 (let ((count (length removed)))
                   (format (current-error-port)
-                          (N_ "  ~*One channel removed:~%"
+                          (N_ "  ~a channel removed:~%"
                               "  ~a channels removed:~%" count)
                           count)
                   (for-each display-channel removed))))