summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/gexp.scm49
-rw-r--r--guix/import/crate.scm29
-rw-r--r--guix/inferior.scm4
-rw-r--r--guix/scripts/environment.scm19
-rw-r--r--guix/scripts/import/crate.scm36
-rw-r--r--guix/scripts/pull.scm2
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))))