summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorEfraim Flashner <efraim@flashner.co.il>2021-11-08 09:06:14 +0200
committerEfraim Flashner <efraim@flashner.co.il>2021-11-08 09:06:14 +0200
commit1c94392a13cbdf87e03a644633eb775bf45694a1 (patch)
tree74f11038dfc5f9d9db06660b1087253b28c5434f /guix
parentdd87bbb2b78b279248aaff15c0706fcd6d8cd7bb (diff)
parent9d25ee30b188f9202cc14f7cd25ba8a1c3ec1a72 (diff)
Merge remote-tracking branch 'origin/master' into core-updates-frozen
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/r.scm2
-rw-r--r--guix/import/cran.scm4
-rw-r--r--guix/import/egg.scm37
-rw-r--r--guix/import/elpa.scm7
-rw-r--r--guix/profiles.scm110
-rw-r--r--guix/scripts/environment.scm48
-rw-r--r--guix/scripts/home/import.scm24
-rw-r--r--guix/scripts/import/egg.scm34
-rw-r--r--guix/scripts/shell.scm16
-rw-r--r--guix/ui.scm3
10 files changed, 237 insertions, 48 deletions
diff --git a/guix/build-system/r.scm b/guix/build-system/r.scm
index be6a600c28..2c82390ba6 100644
--- a/guix/build-system/r.scm
+++ b/guix/build-system/r.scm
@@ -61,7 +61,7 @@ release corresponding to NAME and VERSION."
"/src/contrib/"
name "_" version ".tar.gz")
;; TODO: use %bioconductor-version from (guix import cran)
- (string-append "https://bioconductor.org/packages/3.13"
+ (string-append "https://bioconductor.org/packages/3.14"
type-url-part
"/src/contrib/"
name "_" version ".tar.gz"))))
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index 9387a82065..420cd3b63a 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -155,9 +155,9 @@ package definition."
(define %cran-canonical-url "https://cran.r-project.org/package=")
(define %bioconductor-url "https://bioconductor.org/packages/")
-;; The latest Bioconductor release is 3.13. Bioconductor packages should be
+;; The latest Bioconductor release is 3.14. Bioconductor packages should be
;; updated together.
-(define %bioconductor-version "3.13")
+(define %bioconductor-version "3.14")
(define* (bioconductor-packages-list-url #:optional type)
(string-append "https://bioconductor.org/packages/"
diff --git a/guix/import/egg.scm b/guix/import/egg.scm
index 75b7659944..0b88020554 100644
--- a/guix/import/egg.scm
+++ b/guix/import/egg.scm
@@ -52,10 +52,10 @@
;;;
;;; The following happens under the hood:
;;;
-;;; * <git://code.call-cc.org/eggs-5-latest> is a Git repository that contains
-;;; the latest version of all CHICKEN eggs. We look clone this repository
-;;; and retrieve the latest version number, and the PACKAGE.egg file, which
-;;; contains a list of lists containing metadata about the egg.
+;;; * <git://code.call-cc.org/eggs-5-all> is a Git repository that contains
+;;; all versions of all CHICKEN eggs. We look clone this repository and, by
+;;; default, retrieve the latest version number, and the PACKAGE.egg file,
+;;; which contains a list of lists containing metadata about the egg.
;;;
;;; * All the eggs are stored as tarballs at
;;; <https://code.call-cc.org/egg-tarballs/5>, so we grab the tarball for
@@ -97,7 +97,7 @@ NAME."
(define (eggs-repository)
"Update or fetch the latest version of the eggs repository and return the path
to the repository."
- (let* ((url "git://code.call-cc.org/eggs-5-latest")
+ (let* ((url "git://code.call-cc.org/eggs-5-all")
(directory commit _ (update-cached-checkout url)))
directory))
@@ -113,12 +113,13 @@ to the repository."
(last directory)
#f)))
-(define* (egg-metadata name #:optional file)
- "Return the package metadata file for the egg NAME, or if FILE is specified,
-return the package metadata in FILE."
+(define* (egg-metadata name #:key (version #f) (file #f))
+ "Return the package metadata file for the egg NAME at version VERSION, or if
+FILE is specified, return the package metadata in FILE."
(call-with-input-file (or file
(string-append (egg-directory name) "/"
- (find-latest-version name)
+ (or version
+ (find-latest-version name))
"/" name ".egg"))
read))
@@ -174,10 +175,11 @@ return the package metadata in FILE."
;;; Egg importer.
;;;
-(define* (egg->guix-package name #:key (file #f) (source #f))
- "Import a CHICKEN egg called NAME from either the given .egg FILE, or from
-the latest NAME metadata downloaded from the official repository if FILE is #f.
-Return a <package> record or #f on failure.
+(define* (egg->guix-package name version #:key (file #f) (source #f))
+ "Import a CHICKEN egg called NAME from either the given .egg FILE, or from the
+latest NAME metadata downloaded from the official repository if FILE is #f.
+Return a <package> record or #f on failure. If VERSION is specified, import
+the particular version from the egg repository.
SOURCE is a ``file-like'' object containing the source code corresponding to
the egg. If SOURCE is not specified, the latest tarball for egg NAME will be
@@ -187,8 +189,8 @@ Specifying the SOURCE argument is mainly useful for developing a CHICKEN egg
locally. Note that if FILE and SOURCE are specified, recursive import will
not work."
(define egg-content (if file
- (egg-metadata name file)
- (egg-metadata name)))
+ (egg-metadata name #:file file)
+ (egg-metadata name #:version version)))
(if (not egg-content)
(values #f '()) ; egg doesn't exist
(let* ((version* (or (assoc-ref egg-content 'version)
@@ -324,10 +326,11 @@ not work."
(define egg->guix-package/m ;memoized variant
(memoize egg->guix-package))
-(define (egg-recursive-import package-name)
+(define* (egg-recursive-import package-name #:optional version)
(recursive-import package-name
+ #:version version
#:repo->guix-package (lambda* (name #:key version repo)
- (egg->guix-package/m name))
+ (egg->guix-package/m name version))
#:guix-name egg-name->guix-name))
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 05b4a45f2f..d20e274db7 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -337,9 +337,10 @@ the package named PACKAGE-NAME."
type '<elpa-package>'."
(define melpa-recipe
- (if (eq? repo 'melpa)
- (package-name->melpa-recipe (elpa-package-name pkg))
- #f))
+ ;; XXX: Call 'identity' to work around a Guile 3.0.[5-7] compiler bug:
+ ;; <https://bugs.gnu.org/48368>.
+ (and (eq? (identity repo) 'melpa)
+ (package-name->melpa-recipe (elpa-package-name pkg))))
(define name (elpa-package-name pkg))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index aad23c0c0e..dcd0d30de1 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1682,11 +1682,119 @@ the entries in MANIFEST."
`((type . profile-hook)
(hook . manual-database))))
+(define (manual-database/optional manifest)
+ "Return a derivation to build the manual database of MANIFEST, but only if
+MANIFEST contains the \"man-db\" package. Otherwise, return #f."
+ ;; Building the man database (for "man -k") is expensive and rarely used.
+ ;; Build it only if the profile also contains "man-db".
+ (mlet %store-monad ((man-db (manifest-lookup-package manifest "man-db")))
+ (if man-db
+ (manual-database manifest)
+ (return #f))))
+
+(define (texlive-configuration manifest)
+ "Return a derivation that builds a TeXlive configuration for the entries in
+MANIFEST."
+ (define entry->texlive-input
+ (match-lambda
+ (($ <manifest-entry> name version output thing deps)
+ (if (string-prefix? "texlive-" name)
+ (cons (gexp-input thing output)
+ (append-map entry->texlive-input deps))
+ '()))))
+ (define texlive-bin
+ (module-ref (resolve-interface '(gnu packages tex)) 'texlive-bin))
+ (define coreutils
+ (module-ref (resolve-interface '(gnu packages base)) 'coreutils))
+ (define sed
+ (module-ref (resolve-interface '(gnu packages base)) 'sed))
+ (define updmap.cfg
+ (module-ref (resolve-interface '(gnu packages tex))
+ 'texlive-default-updmap.cfg))
+ (define build
+ (with-imported-modules '((guix build utils)
+ (guix build union))
+ #~(begin
+ (use-modules (guix build utils)
+ (guix build union)
+ (ice-9 popen))
+
+ ;; Build a modifiable union of all texlive inputs. We do this so
+ ;; that TeX live can resolve the parent and grandparent directories
+ ;; correctly. There might be a more elegant way to accomplish this.
+ (union-build #$output
+ '#$(append-map entry->texlive-input
+ (manifest-entries manifest))
+ #:create-all-directories? #t
+ #:log-port (%make-void-port "w"))
+ (let ((texmf.cnf (string-append
+ #$output
+ "/share/texmf-dist/web2c/texmf.cnf")))
+ (when (file-exists? texmf.cnf)
+ (substitute* texmf.cnf
+ (("^TEXMFROOT = .*")
+ (string-append "TEXMFROOT = " #$output "/share\n"))
+ (("^TEXMF = .*")
+ "TEXMF = $TEXMFROOT/share/texmf-dist\n"))
+
+ ;; XXX: This is annoying, but it's necessary because texlive-bin
+ ;; does not provide wrapped executables.
+ (setenv "PATH"
+ (string-append #$(file-append coreutils "/bin")
+ ":"
+ #$(file-append sed "/bin")))
+ (setenv "PERL5LIB" #$(file-append texlive-bin "/share/tlpkg"))
+ (setenv "TEXMF" (string-append #$output "/share/texmf-dist"))
+
+ ;; Remove invalid maps from config file.
+ (let* ((web2c (string-append #$output "/share/texmf-config/web2c/"))
+ (maproot (string-append #$output "/share/texmf-dist/fonts/map/"))
+ (updmap.cfg (string-append web2c "updmap.cfg")))
+ (mkdir-p web2c)
+
+ ;; Some profiles may already have this file, which prevents us
+ ;; from copying it. Since we need to generate it from scratch
+ ;; anyway, we delete it here.
+ (when (file-exists? updmap.cfg)
+ (delete-file updmap.cfg))
+ (copy-file #$updmap.cfg updmap.cfg)
+ (make-file-writable updmap.cfg)
+ (let* ((port (open-pipe* OPEN_WRITE
+ #$(file-append texlive-bin "/bin/updmap-sys")
+ "--syncwithtrees"
+ "--nohash"
+ "--force"
+ (string-append "--cnffile=" web2c "updmap.cfg"))))
+ (display "Y\n" port)
+ (when (not (zero? (status:exit-val (close-pipe port))))
+ (error "failed to filter updmap.cfg")))
+
+ ;; Generate font maps.
+ (invoke #$(file-append texlive-bin "/bin/updmap-sys")
+ (string-append "--cnffile=" web2c "updmap.cfg")
+ (string-append "--dvipdfmxoutputdir="
+ maproot "updmap/dvipdfmx/")
+ (string-append "--dvipsoutputdir="
+ maproot "updmap/dvips/")
+ (string-append "--pdftexoutputdir="
+ maproot "updmap/pdftex/")))))
+ #t)))
+
+ (mlet %store-monad ((texlive-base (manifest-lookup-package manifest "texlive-base")))
+ (if texlive-base
+ (gexp->derivation "texlive-configuration" build
+ #:substitutable? #f
+ #:local-build? #t
+ #:properties
+ `((type . profile-hook)
+ (hook . texlive-configuration)))
+ (return #f))))
+
(define %default-profile-hooks
;; This is the list of derivation-returning procedures that are called by
;; default when making a non-empty profile.
(list info-dir-file
- manual-database
+ manual-database/optional
fonts-dir-file
ghc-package-cache-file
ca-certificate-bundle
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index cca0ad991b..8176de4a5e 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -34,6 +34,7 @@
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (guix transformations)
+ #:autoload (ice-9 ftw) (scandir)
#:autoload (gnu build linux-container) (call-with-container %namespaces
user-namespace-supported?
unprivileged-user-namespace-supported?
@@ -401,7 +402,12 @@ regexps in WHITE-LIST."
(match command
((program . args)
- (apply execlp program program args))))
+ (catch 'system-error
+ (lambda ()
+ (apply execlp program program args))
+ (lambda _
+ ;; Following established convention, exit with 127 upon ENOENT.
+ (primitive-_exit 127))))))
(define (child-shell-environment shell profile manifest)
"Create a child process, load PROFILE and MANIFEST, and then run SHELL in
@@ -552,6 +558,38 @@ running in a \"container\", immune to the issue described above."))
(info (G_ "All is good! The shell gets correct environment \
variables.~%")))))
+(define (suggest-command-name profile command)
+ "COMMAND was not found in PROFILE so display a hint suggesting the closest
+command name."
+ (define not-dot?
+ (match-lambda
+ ((or "." "..") #f)
+ (_ #t)))
+
+ (match (scandir (string-append profile "/bin") not-dot?)
+ (() #f)
+ (available
+ (match command
+ ((executable _ ...)
+ ;; Look for a suggestion with a high threshold: a suggestion is
+ ;; usually better than no suggestion.
+ (let ((closest (string-closest executable available
+ #:threshold 12)))
+ (unless (or (not closest) (string=? closest executable))
+ (display-hint (format #f (G_ "Did you mean '~a'?~%")
+ closest)))))))))
+
+(define (validate-exit-status profile command status)
+ "When STATUS, an integer as returned by 'waitpid', is 127, raise a \"command
+not found\" error. Otherwise return STATUS."
+ ;; Most likely, exit value 127 means ENOENT.
+ (when (eqv? (status:exit-val status) 127)
+ (report-error (G_ "~a: command not found~%")
+ (first command))
+ (suggest-command-name profile command)
+ (exit 1))
+ status)
+
(define* (launch-environment/fork command profile manifest
#:key pure? (white-list '()))
"Run COMMAND in a new process with an environment containing PROFILE, with
@@ -563,7 +601,8 @@ regexps in WHITE-LIST."
#:pure? pure?
#:white-list white-list))
(pid (match (waitpid pid)
- ((_ . status) status)))))
+ ((_ . status)
+ (validate-exit-status profile command status))))))
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
@@ -584,6 +623,9 @@ WHILE-LIST."
(and (file-exists? (file-system-mapping-source mapping))
(file-system-mapping->bind-mount mapping)))
+ (define (exit/status* status)
+ (exit/status (validate-exit-status profile command status)))
+
(mlet %store-monad ((reqs (inputs->requisites
(list (direct-store-path bash) profile))))
(return
@@ -640,7 +682,7 @@ WHILE-LIST."
'())
(map file-system-mapping->bind-mount
mappings))))
- (exit/status
+ (exit/status*
(call-with-container file-systems
(lambda ()
;; Setup global shell.
diff --git a/guix/scripts/home/import.scm b/guix/scripts/home/import.scm
index 7a7712dd96..fbf89069a7 100644
--- a/guix/scripts/home/import.scm
+++ b/guix/scripts/home/import.scm
@@ -27,6 +27,9 @@
#:use-module (gnu packages)
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 popen)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:export (import-manifest
@@ -56,12 +59,33 @@ FILE-NAME with \"-\", and return the basename of it."
(define (destination-append path)
(string-append destination-directory "/" path))
+ (define (bash-alias->pair line)
+ (if (string-prefix? "alias" line)
+ (let ((matched (string-match "alias (.+)=\"?'?([^\"']+)\"?'?" line)))
+ `(,(match:substring matched 1) . ,(match:substring matched 2)))
+ '()))
+
+ (define (parse-aliases input)
+ (let loop ((line (read-line input))
+ (result '()))
+ (if (eof-object? line)
+ (reverse result)
+ (loop (read-line input)
+ (cons (bash-alias->pair line) result)))))
+
(let ((rc (destination-append ".bashrc"))
(profile (destination-append ".bash_profile"))
(logout (destination-append ".bash_logout")))
`((service home-bash-service-type
(home-bash-configuration
,@(if (file-exists? rc)
+ `((aliases
+ ',(let* ((port (open-pipe* OPEN_READ "bash" "-i" "-c" "alias"))
+ (alist (parse-aliases port)))
+ (close-port port)
+ (filter (negate null?) alist))))
+ '())
+ ,@(if (file-exists? rc)
`((bashrc
(list (local-file ,rc
,(basename+remove-dots rc)))))
diff --git a/guix/scripts/import/egg.scm b/guix/scripts/import/egg.scm
index 829cdc2ca0..6a9657d12c 100644
--- a/guix/scripts/import/egg.scm
+++ b/guix/scripts/import/egg.scm
@@ -26,6 +26,7 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-37)
+ #:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (guix-import-egg))
@@ -83,21 +84,24 @@ Import and convert the egg package for PACKAGE-NAME.\n"))
(_ #f))
(reverse opts))))
(match args
- ((package-name)
- (if (assoc-ref opts 'recursive)
- ;; Recursive import
- (map (match-lambda
- ((and ('package ('name name) . rest) pkg)
- `(define-public ,(string->symbol name)
- ,pkg))
- (_ #f))
- (egg-recursive-import package-name))
- ;; Single import
- (let ((sexp (egg->guix-package package-name)))
- (unless sexp
- (leave (G_ "failed to download meta-data for package '~a'~%")
- package-name))
- sexp)))
+ ((spec)
+ (let ((name version (package-name->name+version spec)))
+ (if (assoc-ref opts 'recursive)
+ ;; Recursive import
+ (map (match-lambda
+ ((and ('package ('name name) . rest) pkg)
+ `(define-public ,(string->symbol name)
+ ,pkg))
+ (_ #f))
+ (egg-recursive-import name version))
+ ;; Single import
+ (let ((sexp (egg->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/shell.scm b/guix/scripts/shell.scm
index 5749485a44..bd62803cb1 100644
--- a/guix/scripts/shell.scm
+++ b/guix/scripts/shell.scm
@@ -387,8 +387,14 @@ echo ~a >> ~a
(display-hint (G_ "Consider passing the @option{--check} option once
to make sure your shell does not clobber environment variables."))) )
- (let ((result (guix-environment* opts)))
- (maybe-remove-expired-cache-entries (%profile-cache-directory)
- cache-entries
- #:entry-expiration entry-expiration)
- result))
+ ;; Clean the cache in EXIT-HOOK so that (1) it happens after potential use
+ ;; of cached profiles, and (2) cleanup actually happens, even when
+ ;; 'guix-environment*' calls 'exit'.
+ (add-hook! exit-hook
+ (lambda _
+ (maybe-remove-expired-cache-entries
+ (%profile-cache-directory)
+ cache-entries
+ #:entry-expiration entry-expiration)))
+
+ (guix-environment* opts))
diff --git a/guix/ui.scm b/guix/ui.scm
index b01bb3d587..bd999103ff 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -377,7 +377,8 @@ ARGS is the list of arguments received by the 'throw' handler."
(+ 2 (string-contains message ": ")))))
(format (current-error-port) (G_ "~amissing closing parenthesis~%")
location))
- (apply throw args)))
+ (report-error (G_ "read error while loading '~a': ~a~%")
+ file (apply format #f message args))))
(('syntax-error proc message properties form subform . rest)
(let ((loc (source-properties->location properties)))
(report-error loc (G_ "~s: ~a~%")