diff options
author | Mark H Weaver <mhw@netris.org> | 2015-10-07 23:55:17 -0400 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2015-10-07 23:55:17 -0400 |
commit | 319fe79dd01e03c4ef61311c336bcd77e1133f02 (patch) | |
tree | c169d85b429a801fdc22ce27c25b7e4230eb320a /guix | |
parent | 9511de1ef8c59788f2c93ae6b0cb1e87e30824ab (diff) | |
parent | a606ed89d4e3737beec2f3392bedba61904778f4 (diff) |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r-- | guix/build/download.scm | 9 | ||||
-rw-r--r-- | guix/config.scm.in | 8 | ||||
-rw-r--r-- | guix/import/pypi.scm | 10 | ||||
-rw-r--r-- | guix/import/snix.scm | 14 | ||||
-rw-r--r-- | guix/scripts/publish.scm | 13 | ||||
-rw-r--r-- | guix/utils.scm | 38 |
6 files changed, 28 insertions, 64 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm index 4b7c53d2c6..240e79ee8d 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -110,6 +110,13 @@ column." (padding (make-string num-spaces #\space))) (string-append left padding right))) +(define* (ellipsis #:optional (port (current-output-port))) + "Make a rough guess at whether Unicode's HORIZONTAL ELLIPSIS can be written +in PORT's encoding, and return either that or ASCII dots." + (if (equal? (port-encoding port) "UTF-8") + "…" + "...")) + (define* (store-path-abbreviation store-path #:optional (prefix-length 6)) "If STORE-PATH is the file name of a store entry, return an abbreviation of STORE-PATH for display, showing PREFIX-LENGTH characters of the hash. @@ -117,7 +124,7 @@ Otherwise return STORE-PATH." (if (string-prefix? (%store-directory) store-path) (let ((base (basename store-path))) (string-append (string-take base prefix-length) - "…" + (ellipsis) (string-drop base 32))) store-path)) diff --git a/guix/config.scm.in b/guix/config.scm.in index eaadae9618..764e466bc5 100644 --- a/guix/config.scm.in +++ b/guix/config.scm.in @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -27,7 +27,6 @@ %guix-register-program %system %libgcrypt - %nixpkgs %nix-instantiate %gzip %bzip2 @@ -73,11 +72,6 @@ (define %libgcrypt "@LIBGCRYPT@") -(define %nixpkgs - (if (string=? "@NIXPKGS@" "") - #f - "@NIXPKGS@")) - (define %nix-instantiate "@NIX_INSTANTIATE@") diff --git a/guix/import/pypi.scm b/guix/import/pypi.scm index 06d21fea45..d04a68524d 100644 --- a/guix/import/pypi.scm +++ b/guix/import/pypi.scm @@ -37,16 +37,6 @@ #:use-module (gnu packages python) #:export (pypi->guix-package)) -(define (join lst delimiter) - "Return a list that contains the elements of LST, each separated by -DELIMETER." - (match lst - (() '()) - ((elem) - (list elem)) - ((elem . rest) - (cons* elem delimiter (join rest delimiter))))) - (define (pypi-fetch name) "Return an alist representation of the PyPI metadata for the package NAME, or #f on failure." diff --git a/guix/import/snix.scm b/guix/import/snix.scm index adcea43c88..033b7165d3 100644 --- a/guix/import/snix.scm +++ b/guix/import/snix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2010, 2011, 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2010, 2011, 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -323,12 +323,12 @@ attributes, or #f if NAME cannot be found." ;; licenses. These are listed in lib/licenses.nix. (match (and=> (find-attribute-by-name "shortName" license) attribute-value) - ("AGPL-3.0+" 'agpl3+) - ("GPL-2.0+" 'gpl2+) - ("GPL-3.0+" 'gpl3+) - ("LGPL-2.0+" 'lgpl2.0+) - ("LGPL-2.1+" 'lgpl2.1+) - ("LGPL-3.0+" 'lgpl3+) + ("agpl3Plus" 'agpl3+) + ("gpl2Plus" 'gpl2+) + ("gpl3Plus" 'gpl3+) + ("lgpl2Plus" 'lgpl2.0+) + ("lgpl21Plus" 'lgpl2.1+) + ("lgpl3Plus" 'lgpl3+) ((? string? x) x) (_ license))) (_ license))) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index e352090d2d..fb7b4218e0 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -256,6 +256,16 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")." (response-headers response) eq?))) +(define-syntax-rule (swallow-EPIPE exp ...) + "Swallow EPIPE errors raised by EXP..." + (catch 'system-error + (lambda () + exp ...) + (lambda args + (if (= EPIPE (system-error-errno args)) + (values) + (apply throw args))))) + (define (http-write server client response body) "Write RESPONSE and BODY to CLIENT, possibly in a separate thread to avoid blocking." @@ -274,7 +284,8 @@ blocking." ;; way to avoid building the whole nar in memory, which could ;; quickly become a real problem. As a bonus, we even do ;; sendfile(2) directly from the store files to the socket. - (write-file (utf8->string body) port) + (swallow-EPIPE + (write-file (utf8->string body) port)) (close-port port) (values))))) (_ diff --git a/guix/utils.scm b/guix/utils.scm index b6df5d9cc9..1d4b2ff9b0 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -44,10 +44,6 @@ #:export (bytevector->base16-string base16-string->bytevector - %nixpkgs-directory - nixpkgs-derivation - nixpkgs-derivation* - compile-time-value fcntl-flock memoize @@ -316,40 +312,6 @@ a list of command-line arguments passed to the compression program." ;;; -;;; Nixpkgs. -;;; - -(define %nixpkgs-directory - (make-parameter - ;; Capture the build-time value of $NIXPKGS. - (or %nixpkgs - (and=> (getenv "NIXPKGS") - (lambda (val) - ;; Bail out when passed an empty string, otherwise - ;; `nix-instantiate' will sit there and attempt to read - ;; from its standard input. - (if (string=? val "") - #f - val)))))) - -(define* (nixpkgs-derivation attribute #:optional (system (%current-system))) - "Return the derivation path of ATTRIBUTE in Nixpkgs." - (let* ((p (open-pipe* OPEN_READ (or (getenv "NIX_INSTANTIATE") - %nix-instantiate) - "-A" attribute (%nixpkgs-directory) - "--argstr" "system" system)) - (l (read-line p)) - (s (close-pipe p))) - (and (zero? (status:exit-val s)) - (not (eof-object? l)) - l))) - -(define-syntax-rule (nixpkgs-derivation* attribute) - "Evaluate the given Nixpkgs derivation at compile-time." - (compile-time-value (nixpkgs-derivation attribute))) - - -;;; ;;; Advisory file locking. ;;; |