Merge branch 'master' into staging

3 files changed, 57 insertions, 19 deletions

diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index bfd47a831d..36b3c930d7 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -623,8 +623,7 @@ releases are on gnu.org."
       (package-upstream-name package)
       #:server "mirrors.mit.edu"
       #:directory
-      (string-append "/kde" (dirname (dirname (uri-path uri))))
-      #:file->signature (const #f)))))
+      (string-append "/kde" (dirname (dirname (uri-path uri))))))))
 
 (define (latest-xorg-release package)
   "Return the latest release of PACKAGE, the name of an X.org package."
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 3143ea9281..3966531efa 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -57,20 +57,27 @@
 (define %default-shell
   (or (getenv "SHELL") "/bin/sh"))
 
-(define (purify-environment)
-  "Unset almost all environment variables.  A small number of variables such
-as 'HOME' and 'USER' are left untouched."
+(define (purify-environment white-list)
+  "Unset all environment variables except those that match the regexps in
+WHITE-LIST and those listed in %PRECIOUS-VARIABLES.  A small number of
+variables such as 'HOME' and 'USER' are left untouched."
   (for-each unsetenv
-            (remove (cut member <> %precious-variables)
+            (remove (lambda (variable)
+                      (or (member variable %precious-variables)
+                          (find (cut regexp-exec <> variable)
+                                white-list)))
                     (match (get-environment-variables)
                       (((names . _) ...)
                        names)))))
 
-(define* (create-environment profile manifest #:key pure?)
-  "Set the environment variables specified by MANIFEST for PROFILE.  When PURE?
-is #t, unset the variables in the current environment.  Otherwise, augment
-existing environment variables with additional search paths."
-  (when pure? (purify-environment))
+(define* (create-environment profile manifest
+                             #:key pure? (white-list '()))
+  "Set the environment variables specified by MANIFEST for PROFILE.  When
+PURE?  is #t, unset the variables in the current environment except those that
+match the regexps in WHITE-LIST.  Otherwise, augment existing environment
+variables with additional search paths."
+  (when pure?
+    (purify-environment white-list))
   (for-each (match-lambda
               ((($ <search-path-specification> variable _ separator) . value)
                (let ((current (getenv variable)))
@@ -134,6 +141,8 @@ COMMAND or an interactive shell in that environment.\n"))
   (display (G_ "
       --pure             unset existing environment variables"))
   (display (G_ "
+      --inherit=REGEXP   inherit environment variables that match REGEXP"))
+  (display (G_ "
       --search-paths     display needed environment variable definitions"))
   (display (G_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
@@ -206,6 +215,11 @@ COMMAND or an interactive shell in that environment.\n"))
          (option '("pure") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'pure #t result)))
+         (option '("inherit") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'inherit-regexp
+                               (make-regexp* arg)
+                               result)))
          (option '(#\E "exec") #t #f ; deprecated
                  (lambda (opt name arg result)
                    (alist-cons 'exec (list %default-shell "-c" arg) result)))
@@ -397,25 +411,30 @@ and suitable for 'exit'."
 (define primitive-exit/status (compose primitive-exit status->exit-code))
 
 (define* (launch-environment command profile manifest
-                             #:key pure?)
+                             #:key pure? (white-list '()))
   "Run COMMAND in a new environment containing INPUTS, using the native search
 paths defined by the list PATHS.  When PURE?, pre-existing environment
-variables are cleared before setting the new ones."
+variables are cleared before setting the new ones, except those matching the
+regexps in WHITE-LIST."
   ;; Properly handle SIGINT, so pressing C-c in an interactive terminal
   ;; application works.
   (sigaction SIGINT SIG_DFL)
-  (create-environment profile manifest #:pure? pure?)
+  (create-environment profile manifest
+                      #:pure? pure? #:white-list white-list)
   (match command
     ((program . args)
      (apply execlp program program args))))
 
-(define* (launch-environment/fork command profile manifest #:key pure?)
+(define* (launch-environment/fork command profile manifest
+                                  #:key pure? (white-list '()))
   "Run COMMAND in a new process with an environment containing PROFILE, with
 the search paths specified by MANIFEST.  When PURE?, pre-existing environment
-variables are cleared before setting the new ones."
+variables are cleared before setting the new ones, except those matching the
+regexps in WHITE-LIST."
   (match (primitive-fork)
     (0 (launch-environment command profile manifest
-                           #:pure? pure?))
+                           #:pure? pure?
+                           #:white-list white-list))
     (pid (match (waitpid pid)
            ((_ . status) status)))))
 
@@ -672,7 +691,8 @@ message if any test fails."
                                ;; within the container.
                                '("/bin/sh")
                                (list %default-shell))))
-           (mappings   (pick-all opts 'file-system-mapping)))
+           (mappings   (pick-all opts 'file-system-mapping))
+           (white-list (pick-all opts 'inherit-regexp)))
 
       (when container? (assert-container-features))
 
@@ -741,4 +761,5 @@ message if any test fails."
                     (return
                      (exit/status
                       (launch-environment/fork command profile manifest
+                                               #:white-list white-list
                                                #:pure? pure?))))))))))))))
diff --git a/guix/self.scm b/guix/self.scm
index a45470a0a6..ccff9be5b3 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -390,6 +390,10 @@ that provide Guile modules."
                        guile (guile-version (effective-version)))
   "Return the 'guix' command such that it adds MODULES and DEPENDENCIES in its
 load path."
+  (define glibc-utf8-locales
+    (module-ref (resolve-interface '(gnu packages base))
+                'glibc-utf8-locales))
+
   (define module-directory
     ;; To minimize the number of 'stat' calls needed to locate a module,
     ;; create the union of all the module directories.
@@ -410,6 +414,16 @@ load path."
                                            "/site-ccache")
                             %load-compiled-path))
 
+                    ;; To maximize the chances that locales are set up right
+                    ;; out-of-the-box, bundle "common" UTF-8 locales.
+                    (let ((locpath (getenv "GUIX_LOCPATH")))
+                      (setenv "GUIX_LOCPATH"
+                              (string-append (if locpath
+                                                 (string-append locpath ":")
+                                                 "")
+                                             #$(file-append glibc-utf8-locales
+                                                            "/lib/locale"))))
+
                     (let ((guix-main (module-ref (resolve-interface '(guix ui))
                                                  'guix-main)))
                       #$(if source
@@ -757,7 +771,7 @@ Info manual."
                                ((_ variable rest ...)
                                 (cons `(variable . ,variable)
                                       (variables rest ...))))))
-    (variables %localstatedir %storedir %sysconfdir %system)))
+    (variables %localstatedir %storedir %sysconfdir)))
 
 (define* (make-config.scm #:key zlib gzip xz bzip2
                           (package-name "GNU Guix")
@@ -775,6 +789,7 @@ Info manual."
                                %guix-version
                                %guix-bug-report-address
                                %guix-home-page-url
+                               %system
                                %store-directory
                                %state-directory
                                %store-database-directory
@@ -784,6 +799,9 @@ Info manual."
                                %bzip2
                                %xz))
 
+                   (define %system
+                     #$(%current-system))
+
                    #$@(map (match-lambda
                              ((name . value)
                               #~(define-public #$name #$value)))