diff options
| -rw-r--r-- | gnu-system.am | 1 | ||||
| -rw-r--r-- | gnu/packages/base.scm | 32 | ||||
| -rw-r--r-- | gnu/packages/file.scm | 26 | ||||
| -rw-r--r-- | gnu/packages/gawk.scm | 12 | ||||
| -rw-r--r-- | gnu/packages/patches/file-CVE-2014-3587.patch | 16 | ||||
| -rw-r--r-- | gnu/packages/patchutils.scm | 2 | ||||
| -rw-r--r-- | gnu/packages/pkg-config.scm | 4 | ||||
| -rw-r--r-- | gnu/packages/version-control.scm | 2 | ||||
| -rw-r--r-- | guix/build/gnu-build-system.scm | 99 | ||||
| -rw-r--r-- | guix/build/utils.scm | 80 |
10 files changed, 195 insertions, 79 deletions
diff --git a/gnu-system.am b/gnu-system.am index e828c01d7c..f1ebe40703 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -350,7 +350,6 @@ dist_patch_DATA = \ gnu/packages/patches/duplicity-piped-password.patch \ gnu/packages/patches/duplicity-test_selection-tmp.patch \ gnu/packages/patches/eudev-rules-directory.patch \ - gnu/packages/patches/file-CVE-2014-3587.patch \ gnu/packages/patches/findutils-absolute-paths.patch \ gnu/packages/patches/flashrom-use-libftdi1.patch \ gnu/packages/patches/flex-bison-tests.patch \ diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index 85e92aad3b..aec8d8949c 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -65,14 +65,14 @@ command-line arguments, multiple languages, and so on.") (define-public grep (package (name "grep") - (version "2.20") + (version "2.21") (source (origin (method url-fetch) (uri (string-append "mirror://gnu/grep/grep-" version ".tar.xz")) (sha256 (base32 - "0rcs0spsxdmh6yz8y4frkqp6f5iw19mdbdl9s2v6956hq0mlbbzh")))) + "1pp5n15qwxrw1pibwjhhgsibyv5cafhamf8lwzjygs6y00fa2i2j")))) (build-system gnu-build-system) (synopsis "Print lines matching a pattern") (description @@ -382,25 +382,27 @@ included.") ;; users should automatically pull Linux headers as well. (propagated-inputs `(("linux-headers" ,linux-libre-headers))) - ;; Store the locales separately (~100 MiB). Note that "out" retains a - ;; reference to them anyway, so there's no space savings here. - ;; TODO: Eventually we may want to add a $LOCALE_ARCHIVE search path like - ;; Nixpkgs does. - (outputs '("out" "locales" "debug")) + (outputs '("out" "debug")) (arguments `(#:out-of-source? #t #:configure-flags (list "--enable-add-ons" "--sysconfdir=/etc" - (string-append "--localedir=" (assoc-ref %outputs "locales") - "/share/locale") + ;; Installing a locale archive with all the locales is to + ;; expensive (~100 MiB), so we rely on users to install the + ;; locales they really want. + ;; + ;; Set the default locale path. In practice, $LOCPATH may be + ;; defined to point whatever locales users want. However, setuid + ;; binaries don't honor $LOCPATH, so they'll instead look into + ;; $libc_cv_localedir; we choose /run/current-system/locale, with + ;; the idea that it is going to be populated by the sysadmin. + ;; ;; `--localedir' is not honored, so work around it. ;; See <http://sourceware.org/ml/libc-alpha/2013-03/msg00093.html>. - (string-append "libc_cv_localedir=" - (assoc-ref %outputs "locales") - "/share/locale") + (string-append "libc_cv_localedir=/run/current-system/locale") (string-append "--with-headers=" (assoc-ref %build-inputs "linux-headers") @@ -477,11 +479,7 @@ included.") "") (("exec @PERL@") "exec perl")))) - (alist-cons-after - 'install 'install-locales - (lambda _ - (zero? (system* "make" "localedata/install-locales"))) - %standard-phases)))) + %standard-phases))) (inputs `(("static-bash" ,(static-package bash-light)))) diff --git a/gnu/packages/file.scm b/gnu/packages/file.scm index 070695ec2c..7d8504b74a 100644 --- a/gnu/packages/file.scm +++ b/gnu/packages/file.scm @@ -27,14 +27,14 @@ (define-public file (package (name "file") - (version "5.19") - (source (origin - (method url-fetch) - (uri (string-append "ftp://ftp.astron.com/pub/file/file-" - version ".tar.gz")) - (sha256 (base32 - "0z1sgrcfy6d285kj5izy1yypf371bjl3247plh9ppk0svaxv714l")) - (patches (list (search-patch "file-CVE-2014-3587.patch"))))) + (version "5.20") + (source (origin + (method url-fetch) + (uri (string-append "ftp://ftp.astron.com/pub/file/file-" + version ".tar.gz")) + (sha256 + (base32 + "0iyjs9z8kp43gz7gva4j67h4p0n53f7q8x3ibai9s01sp3xnphsv")))) (build-system gnu-build-system) ;; When cross-compiling, this package depends upon a native install of @@ -50,13 +50,3 @@ of the file.") (license bsd-2) (home-page "http://www.darwinsys.com/file/"))) -(define-public file-5.20 ;fix for CVE-2014-3710 - (package (inherit file) - (version "5.20") - (source (origin - (method url-fetch) - (uri (string-append "ftp://ftp.astron.com/pub/file/file-" - version ".tar.gz")) - (sha256 - (base32 - "0iyjs9z8kp43gz7gva4j67h4p0n53f7q8x3ibai9s01sp3xnphsv")))))) diff --git a/gnu/packages/gawk.scm b/gnu/packages/gawk.scm index 10506197f3..996be7af4a 100644 --- a/gnu/packages/gawk.scm +++ b/gnu/packages/gawk.scm @@ -64,7 +64,17 @@ '((substitute* "extension/configure" (("/usr/bin/file") (which "file")))) '()))) - %standard-phases))) + + (alist-cons-before + 'check 'install-locales + (lambda _ + ;; A bunch of tests require the availability of a UTF-8 + ;; locale and otherwise fail. Give them what they want. + (setenv "LOCPATH" (getcwd)) + (zero? (system* "localedef" "--no-archive" + "--prefix" (getcwd) "-i" "en_US" + "-f" "UTF-8" "./en_US.UTF-8"))) + %standard-phases)))) (inputs `(("libsigsegv" ,libsigsegv) ,@(if (%current-target-system) diff --git a/gnu/packages/patches/file-CVE-2014-3587.patch b/gnu/packages/patches/file-CVE-2014-3587.patch deleted file mode 100644 index cf88bf5f3e..0000000000 --- a/gnu/packages/patches/file-CVE-2014-3587.patch +++ /dev/null @@ -1,16 +0,0 @@ -Fixes CVE-2014-3587. Copied from upstream commit -0641e56be1af003aa02c7c6b0184466540637233. - ---- file-5.19/src/cdf.c.orig 2014-06-09 09:04:37.000000000 -0400 -+++ file-5.19/src/cdf.c 2014-08-26 11:55:23.887118898 -0400 -@@ -824,6 +824,10 @@ - q = (const uint8_t *)(const void *) - ((const char *)(const void *)p + ofs - - 2 * sizeof(uint32_t)); -+ if (q < p) { -+ DPRINTF(("Wrapped around %p < %p\n", q, p)); -+ goto out; -+ } - if (q > e) { - DPRINTF(("Ran of the end %p > %p\n", q, e)); - goto out; diff --git a/gnu/packages/patchutils.scm b/gnu/packages/patchutils.scm index 3dbf72435e..48f4d29584 100644 --- a/gnu/packages/patchutils.scm +++ b/gnu/packages/patchutils.scm @@ -96,7 +96,7 @@ listing the files modified by a patch.") (build-system gnu-build-system) (inputs `(("perl" ,perl) ("less" ,less) - ("file" ,file-5.20) ;work around CVE-2014-3710 + ("file" ,file) ("ed" ,ed))) (arguments '(#:parallel-tests? #f diff --git a/gnu/packages/pkg-config.scm b/gnu/packages/pkg-config.scm index 62b0d5f65c..dc4905a271 100644 --- a/gnu/packages/pkg-config.scm +++ b/gnu/packages/pkg-config.scm @@ -30,7 +30,7 @@ (define-public %pkg-config (package (name "pkg-config") - (version "0.27.1") + (version "0.28") (source (origin (method url-fetch) (uri (string-append @@ -38,7 +38,7 @@ version ".tar.gz")) (sha256 (base32 - "05wc5nwkqz7saj2v33ydmz1y6jdg659dll4jjh91n41m63gx0qsg")))) + "0igqq5m204w71m11y0nipbdf5apx87hwfll6axs12hn4dqfb6vkb")))) (build-system gnu-build-system) (arguments `(#:configure-flags '("--with-internal-glib"))) (native-search-paths diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm index f5e9a27736..4f9ed54d56 100644 --- a/gnu/packages/version-control.scm +++ b/gnu/packages/version-control.scm @@ -649,7 +649,7 @@ accessed and migrated on modern systems.") (inputs `(("e2fsprogs" ,e2fsprogs) ("curl" ,curl) - ("file" ,file-5.20) ;work around CVE-2014-3710 + ("file" ,file) ("libxml2" ,libxml2) ("zlib" ,zlib) ("gettext" ,gnu-gettext))) diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index 17fa7afd8d..d3de92b724 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -20,6 +20,7 @@ #:use-module (guix build utils) #:use-module (ice-9 ftw) #:use-module (ice-9 match) + #:use-module (ice-9 regex) #:use-module (ice-9 format) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -236,18 +237,11 @@ makefiles." (string-append srcdir "/configure") flags)))) -(define %parallel-job-count - ;; String to be passed next to GNU Make's `-j' argument. - (match (getenv "NIX_BUILD_CORES") - (#f "1") - ("0" (number->string (current-processor-count))) - (x x))) - (define* (build #:key (make-flags '()) (parallel-build? #t) #:allow-other-keys) (zero? (apply system* "make" `(,@(if parallel-build? - `("-j" ,%parallel-job-count) + `("-j" ,(number->string (parallel-job-count))) '()) ,@make-flags)))) @@ -257,7 +251,7 @@ makefiles." (if tests? (zero? (apply system* "make" test-target `(,@(if parallel-tests? - `("-j" ,%parallel-job-count) + `("-j" ,(number->string (parallel-job-count))) '()) ,@make-flags))) (begin @@ -350,7 +344,9 @@ makefiles." debug-output objcopy-command)) (file-system-fold (const #t) (lambda (path stat result) ; leaf - (and (or (not debug-output) + (and (file-exists? path) ;discard dangling symlinks + (or (elf-file? path) (ar-file? path)) + (or (not debug-output) (make-debug-file path)) (zero? (apply system* strip-command (append strip-flags (list path)))) @@ -377,6 +373,85 @@ makefiles." strip-directories))) outputs)))) +(define* (validate-documentation-location #:key outputs + #:allow-other-keys) + "Documentation should go to 'share/info' and 'share/man', not just 'info/' +and 'man/'. This phase moves directories to the right place if needed." + (define (validate-sub-directory output sub-directory) + (let ((directory (string-append output "/" sub-directory))) + (when (directory-exists? directory) + (let ((target (string-append output "/share/" sub-directory))) + (format #t "moving '~a' to '~a'~%" directory target) + (mkdir-p (dirname target)) + (rename-file directory target))))) + + (define (validate-output output) + (for-each (cut validate-sub-directory output <>) + '("man" "info"))) + + (match outputs + (((names . directories) ...) + (for-each validate-output directories))) + #t) + +(define* (compress-documentation #:key outputs + (compress-documentation? #t) + (documentation-compressor "gzip") + (documentation-compressor-flags + '("--best" "--no-name")) + (compressed-documentation-extension ".gz") + #:allow-other-keys) + "When COMPRESS-DOCUMENTATION? is true, compress man pages and Info files +found in OUTPUTS using DOCUMENTATION-COMPRESSOR, called with +DOCUMENTATION-COMPRESSOR-FLAGS." + (define (retarget-symlink link) + (let ((target (readlink link))) + (delete-file link) + (symlink (string-append target compressed-documentation-extension) + link))) + + (define (has-links? file) + ;; Return #t if FILE has hard links. + (> (stat:nlink (lstat file)) 1)) + + (define (maybe-compress-directory directory regexp) + (or (not (directory-exists? directory)) + (match (find-files directory regexp) + (() ;nothing to compress + #t) + ((files ...) ;one or more files + (format #t + "compressing documentation in '~a' with ~s and flags ~s~%" + directory documentation-compressor + documentation-compressor-flags) + (call-with-values + (lambda () + (partition symbolic-link? files)) + (lambda (symlinks regular-files) + ;; Compress the non-symlink files, and adjust symlinks to refer + ;; to the compressed files. Leave files that have hard links + ;; unchanged ('gzip' would refuse to compress them anyway.) + (and (zero? (apply system* documentation-compressor + (append documentation-compressor-flags + (remove has-links? regular-files)))) + (every retarget-symlink + (filter (cut string-match regexp <>) + symlinks))))))))) + + (define (maybe-compress output) + (and (maybe-compress-directory (string-append output "/share/man") + "\\.[0-9]+$") + (maybe-compress-directory (string-append output "/share/info") + "\\.info(-[0-9]+)?$"))) + + (if compress-documentation? + (match outputs + (((names . directories) ...) + (every maybe-compress directories))) + (begin + (format #t "not compressing documentation~%") + #t))) + (define %standard-phases ;; Standard build phases, as a list of symbol/procedure pairs. (let-syntax ((phases (syntax-rules () @@ -385,7 +460,9 @@ makefiles." patch-usr-bin-file patch-source-shebangs configure patch-generated-file-shebangs build check install - patch-shebangs strip))) + patch-shebangs strip + validate-documentation-location + compress-documentation))) (define* (gnu-build #:key (source #f) (outputs #f) (inputs #f) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index cda4fb12ef..9b1e098c6b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -31,9 +31,14 @@ #:re-export (alist-cons alist-delete) #:export (%store-directory + parallel-job-count + directory-exists? executable-file? + symbolic-link? call-with-ascii-input-file + elf-file? + ar-file? with-directory-excursion mkdir-p copy-recursively @@ -69,6 +74,14 @@ (or (getenv "NIX_STORE") "/gnu/store")) +(define parallel-job-count + ;; Number of processes to be passed next to GNU Make's `-j' argument. + (make-parameter + (match (getenv "NIX_BUILD_CORES") ;set by the daemon + (#f 1) + ("0" (current-processor-count)) + (x (or (string->number x) 1))))) + (define (directory-exists? dir) "Return #t if DIR exists and is a directory." (let ((s (stat dir #f))) @@ -81,6 +94,10 @@ (and s (not (zero? (logand (stat:mode s) #o100)))))) +(define (symbolic-link? file) + "Return #t if FILE is a symbolic link (aka. \"symlink\".)" + (eq? (stat:type (lstat file)) 'symlink)) + (define (call-with-ascii-input-file file proc) "Open FILE as an ASCII or binary file, and pass the resulting port to PROC. FILE is closed when PROC's dynamic extent is left. Return the @@ -96,6 +113,42 @@ return values of applying PROC to the port." (lambda () (close-input-port port))))) +(define (file-header-match header) + "Return a procedure that returns true when its argument is a file starting +with the bytes in HEADER, a bytevector." + (define len + (bytevector-length header)) + + (lambda (file) + "Return true if FILE starts with the right magic bytes." + (define (get-header) + (call-with-input-file file + (lambda (port) + (get-bytevector-n port len)) + #:binary #t #:guess-encoding #f)) + + (catch 'system-error + (lambda () + (equal? (get-header) header)) + (lambda args + (if (= EISDIR (system-error-errno args)) + #f ;FILE is a directory + (apply throw args)))))) + +(define %elf-magic-bytes + ;; Magic bytes of ELF files. See <elf.h>. + (u8-list->bytevector (map char->integer (string->list "\x7FELF")))) + +(define elf-file? + (file-header-match %elf-magic-bytes)) + +(define %ar-magic-bytes + ;; Magic bytes of archives created by 'ar'. See <ar.h>. + (u8-list->bytevector (map char->integer (string->list "!<arch>\n")))) + +(define ar-file? + (file-header-match %ar-magic-bytes)) + (define-syntax-rule (with-directory-excursion dir body ...) "Run BODY with DIR as the process's current directory." (let ((init (getcwd))) @@ -365,10 +418,11 @@ PROC's result is returned." (false-if-exception (delete-file template)))))) (define (substitute file pattern+procs) - "PATTERN+PROCS is a list of regexp/two-argument procedure. For each line -of FILE, and for each PATTERN that it matches, call the corresponding PROC -as (PROC LINE MATCHES); PROC must return the line that will be written as a -substitution of the original line." + "PATTERN+PROCS is a list of regexp/two-argument-procedure pairs. For each +line of FILE, and for each PATTERN that it matches, call the corresponding +PROC as (PROC LINE MATCHES); PROC must return the line that will be written as +a substitution of the original line. Be careful about using '$' to match the +end of a line; by itself it won't match the terminating newline of a line." (let ((rx+proc (map (match-lambda (((? regexp? pattern) . proc) (cons pattern proc)) @@ -428,7 +482,10 @@ When one of the MATCH-VAR is `_', no variable is bound to the corresponding match substring. Alternatively, FILE may be a list of file names, in which case they are -all subject to the substitutions." +all subject to the substitutions. + +Be careful about using '$' to match the end of a line; by itself it won't +match the terminating newline of a line." ((substitute* file ((regexp match-var ...) body ...) ...) (let () (define (substitute-one-file file-name) @@ -572,9 +629,7 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged." ;; XXX: Unlike with `patch-shebang', FILE is always touched. (define (find-shell name) - (let ((shell - (search-path (search-path-as-string->list (getenv "PATH")) - name))) + (let ((shell (which name))) (unless shell (format (current-error-port) "patch-makefile-SHELL: warning: no binary for shell `~a' found in $PATH~%" @@ -583,7 +638,7 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged." (let ((st (stat file))) (substitute* file - (("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$" + (("^ *SHELL[[:blank:]]*:?=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)(.*)$" _ dir shell args) (let* ((old (string-append dir shell)) (new (or (find-shell shell) old))) @@ -707,7 +762,7 @@ contents: #!location/of/bin/bash export PATH=\"/gnu/.../bar/bin\" export CERT_PATH=\"$CERT_PATH${CERT_PATH:+:}/gnu/.../baz/certs:/qux/certs\" - exec location/of/.foo-real + exec -a location/of/foo location/of/.foo-real \"$@\" This is useful for scripts that expect particular programs to be in $PATH, for programs that expect particular shared libraries to be in $LD_LIBRARY_PATH, or @@ -731,6 +786,7 @@ the previous wrapper." (copy-file prog prog-real) prog-real) (wrapper-file-name number))) + (let* ((number (next-wrapper-number)) (target (wrapper-target number)) (wrapper (wrapper-file-name (1+ number))) @@ -760,10 +816,11 @@ the previous wrapper." (with-output-to-file prog-tmp (lambda () (format #t - "#!~a~%~a~%exec \"~a\" \"$@\"~%" + "#!~a~%~a~%exec -a \"~a\" \"~a\" \"$@\"~%" (which "bash") (string-join (map export-variable vars) "\n") + (canonicalize-path prog) (canonicalize-path target)))) (chmod prog-tmp #o755) @@ -773,6 +830,7 @@ the previous wrapper." ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) +;;; eval: (put 'call-with-ascii-input-file 'scheme-indent-function 1) ;;; eval: (put 'with-throw-handler 'scheme-indent-function 1) ;;; eval: (put 'let-matches 'scheme-indent-function 3) ;;; eval: (put 'with-atomic-file-replacement 'scheme-indent-function 1) |