diff options
author | Marius Bakke <mbakke@fastmail.com> | 2019-02-20 17:01:39 +0100 |
---|---|---|
committer | Marius Bakke <mbakke@fastmail.com> | 2019-02-20 17:01:39 +0100 |
commit | 2c76e19df4b0b4aa0171f1edd9f240f7b6ba5b84 (patch) | |
tree | c2e7a7f27dd9c7e704f2e78655328c903a6934d1 /guix | |
parent | e6a668ec7303a71f87e4c9354b1458e555058c63 (diff) | |
parent | 78b2eb1ad3dcf05c25e0ee4980c97aa52de03a2d (diff) | |
download | guix-patches-2c76e19df4b0b4aa0171f1edd9f240f7b6ba5b84.tar guix-patches-2c76e19df4b0b4aa0171f1edd9f240f7b6ba5b84.tar.gz |
Merge branch 'master' into staging
Diffstat (limited to 'guix')
-rw-r--r-- | guix/gnu-maintenance.scm | 3 | ||||
-rw-r--r-- | guix/scripts/environment.scm | 53 | ||||
-rw-r--r-- | guix/self.scm | 20 |
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))) |