From e6039b9c70c658d648723a2d331f1c9637b49126 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Nov 2014 12:32:32 +0100 Subject: utils: Export 'parallel-job-count'. * guix/build/utils.scm (parallel-job-count): New procedure. * guix/build/gnu-build-system.scm (%parallel-job-count): Remove. (build, check): Use 'parallel-job-count' instead. --- guix/build/utils.scm | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index cda4fb12ef..bfbc4dd43e 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -31,6 +31,8 @@ #:re-export (alist-cons alist-delete) #:export (%store-directory + parallel-job-count + directory-exists? executable-file? call-with-ascii-input-file @@ -69,6 +71,14 @@ (or (getenv "NIX_STORE") "/gnu/store")) +(define (parallel-job-count) + "Return the number of processes to be passed next to GNU Make's `-j' +argument." + (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))) -- cgit v1.2.3 From 99533da50db89318c7ab7ae3e7a28c261fb88e84 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Nov 2014 12:44:56 +0100 Subject: utils: Add 'elf-file?'. * guix/build/utils.scm (elf-file?): New procedure. --- guix/build/utils.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index bfbc4dd43e..fcf6dfc12c 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -36,6 +36,7 @@ directory-exists? executable-file? call-with-ascii-input-file + elf-file? with-directory-excursion mkdir-p copy-recursively @@ -106,6 +107,17 @@ return values of applying PROC to the port." (lambda () (close-input-port port))))) +(define (elf-file? file) + "Return true if FILE starts with the ELF magic bytes." + (define (get-header) + (call-with-input-file file + (lambda (port) + (get-bytevector-n port 4)) + #:binary #t #:guess-encoding #f)) + + (equal? (get-header) + #vu8(#x7f #x45 #x4c #x46))) ;"\177ELF" + (define-syntax-rule (with-directory-excursion dir body ...) "Run BODY with DIR as the process's current directory." (let ((init (getcwd))) @@ -783,6 +795,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) -- cgit v1.2.3 From 91ee959b03e9e45727761823a4fcc1046e0aa450 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Nov 2014 21:44:59 +0100 Subject: utils: Add 'ar-file?'. * guix/build/utils.scm (%ar-magic-bytes): New variable. (ar-file?): New procedure. --- guix/build/utils.scm | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index fcf6dfc12c..0ea22ec657 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -37,6 +37,7 @@ executable-file? call-with-ascii-input-file elf-file? + ar-file? with-directory-excursion mkdir-p copy-recursively @@ -118,6 +119,21 @@ return values of applying PROC to the port." (equal? (get-header) #vu8(#x7f #x45 #x4c #x46))) ;"\177ELF" +(define %ar-magic-bytes + ;; Magic bytes of archives created by 'ar'. See . + (u8-list->bytevector (map char->integer (string->list "!\n")))) + +(define (ar-file? file) + "Return true if FILE starts with the magic bytes of archives as created by +'ar'." + (define (get-header) + (call-with-input-file file + (lambda (port) + (get-bytevector-n port 8)) + #:binary #t #:guess-encoding #f)) + + (equal? (get-header) %ar-magic-bytes)) + (define-syntax-rule (with-directory-excursion dir body ...) "Run BODY with DIR as the process's current directory." (let ((init (getcwd))) -- cgit v1.2.3 From 2bbc6db5e22b0361c166c89210c7a6fd9842db8c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Nov 2014 21:52:57 +0100 Subject: utils: Factorize magic bytes detection. * guix/build/utils.scm (file-header-match): New procedure. (%elf-magic-bytes): New variable. (elf-file?, ar-file?): Define using 'file-header-match'. --- guix/build/utils.scm | 42 +++++++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 19 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 0ea22ec657..c4c3934a5d 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -108,31 +108,35 @@ return values of applying PROC to the port." (lambda () (close-input-port port))))) -(define (elf-file? file) - "Return true if FILE starts with the ELF magic bytes." - (define (get-header) - (call-with-input-file file - (lambda (port) - (get-bytevector-n port 4)) - #:binary #t #:guess-encoding #f)) +(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)) - (equal? (get-header) - #vu8(#x7f #x45 #x4c #x46))) ;"\177ELF" + (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)) + + (equal? (get-header) header))) + +(define %elf-magic-bytes + ;; Magic bytes of ELF files. See . + (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 . (u8-list->bytevector (map char->integer (string->list "!\n")))) -(define (ar-file? file) - "Return true if FILE starts with the magic bytes of archives as created by -'ar'." - (define (get-header) - (call-with-input-file file - (lambda (port) - (get-bytevector-n port 8)) - #:binary #t #:guess-encoding #f)) - - (equal? (get-header) %ar-magic-bytes)) +(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." -- cgit v1.2.3 From 1d1fa9327c839bf7af92dd38d8306df0d456c11e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Nov 2014 21:57:05 +0100 Subject: utils: Turn 'parallel-job-count' into a parameter. * guix/build/utils.scm (parallel-job-count): Turn into a SRFI-39 parameter. --- guix/build/utils.scm | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index c4c3934a5d..a3050b955c 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -73,13 +73,13 @@ (or (getenv "NIX_STORE") "/gnu/store")) -(define (parallel-job-count) - "Return the number of processes to be passed next to GNU Make's `-j' -argument." - (match (getenv "NIX_BUILD_CORES") ;set by the daemon - (#f 1) - ("0" (current-processor-count)) - (x (or (string->number x) 1)))) +(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." -- cgit v1.2.3 From c23d17095db0611d8ee32357f17da441bcb0bc75 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 23 Nov 2014 19:15:21 +0100 Subject: utils: 'elf-file?' and 'ar-file?' return #f for directories. This avoids uncaught exceptions when the 'strip' phase would call these procedures on symlinks to directories, such as 'lib/terminfo' in ncurses (see .) * guix/build/utils.scm (file-header-match): Catch 'system-error', and return #f upon EISDIR. --- guix/build/utils.scm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index a3050b955c..c480dbf8a6 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -122,7 +122,13 @@ with the bytes in HEADER, a bytevector." (get-bytevector-n port len)) #:binary #t #:guess-encoding #f)) - (equal? (get-header) header))) + (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 . -- cgit v1.2.3 From 094b2efc3c672d60c2fbaca68ce632ba6ab54700 Mon Sep 17 00:00:00 2001 From: Taylan Ulrich Bayırlı/Kammer Date: Tue, 25 Nov 2014 21:52:13 +0100 Subject: utils: Improve docstring of 'substitute*' & co. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/utils.scm (substitute): Clarify first sentence of docstring and add warning to the docstring about using '$' to match an end of line. (substitute*): Add warning to the docstring about using '$' to match an end of line. Signed-off-by: Ludovic Courtès --- guix/build/utils.scm | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index c480dbf8a6..737976e8e4 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -413,10 +413,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)) @@ -476,7 +477,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) -- cgit v1.2.3 From 9741aca9a586231423712b99d52346bf3dcdd4e3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 1 Dec 2014 15:46:10 +0100 Subject: utils: Add 'symbolic-link?'. * guix/build/utils.scm (symbolic-link?): New procedure. --- guix/build/utils.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 737976e8e4..de1cfcea42 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -35,6 +35,7 @@ directory-exists? executable-file? + symbolic-link? call-with-ascii-input-file elf-file? ar-file? @@ -93,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 -- cgit v1.2.3 From 5e5deea9529c0ed2e84235d778256cccc1701df9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 13 Dec 2014 00:04:25 +0100 Subject: utils: Use 'which' to find the shell in 'patch-makefile-SHELL'. * guix/build/utils.scm (patch-makefile-SHELL)[find-shell]: Use 'which'. --- guix/build/utils.scm | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index de1cfcea42..01ac8961d8 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -629,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~%" -- cgit v1.2.3 From c809ec94d11f1c7e23cccb988dfb1412aff72636 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 13 Dec 2014 00:06:32 +0100 Subject: utils: Change 'patch-makefile-SHELL' to support ":=" assignments. Reported by Ricardo Wurmus . * guix/build/utils.scm (patch-makefile-SHELL): Update regexp to match ":=" assignments. --- guix/build/utils.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 01ac8961d8..be91fb467b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -638,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))) -- cgit v1.2.3 From 2ed11b3a3e05549ed6ef8a604464f424c0eeae1c Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 14 Dec 2014 11:54:12 +0100 Subject: utils: Change 'wrap-program' to preserve the original argv[0]. Suggested by Mark H Weaver in . * guix/build/utils.scm (wrap-program): Change wrapper to use "exec -a PROG" instead of just "exec". --- guix/build/utils.scm | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index be91fb467b..9b1e098c6b 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -762,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 @@ -786,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))) @@ -815,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) -- cgit v1.2.3 From 6aa47e388390e98bec6caa90fef7f39a60e338a7 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 27 Dec 2014 12:16:18 +0100 Subject: build-system/gnu: Add support for non-directory search paths. Partly fixes . * guix/build/utils.scm (search-path-as-list): Rename 'sub-directories' parameter to 'files'. Add #:type parameter and honor it. (set-path-environment-variable): Likewise. Pass #:type to 'search-path-as-list'. * guix/packages.scm (search-path-specification->sexp): Add 'directory as the last item of the tuple. * guix/build/gnu-build-system.scm (set-paths): Add 'type' to search-path pattern. Pass #:type to 'set-path-environment-variable'. --- guix/build/gnu-build-system.scm | 14 ++++++++------ guix/build/utils.scm | 33 +++++++++++++++++++-------------- guix/packages.scm | 3 ++- 3 files changed, 29 insertions(+), 21 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index d3de92b724..4cc755f3a6 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -73,19 +73,21 @@ input-directories))) (for-each (match-lambda - ((env-var (directories ...) separator) - (set-path-environment-variable env-var directories + ((env-var (files ...) separator type) + (set-path-environment-variable env-var files input-directories - #:separator separator))) + #:separator separator + #:type type))) search-paths) (when native-search-paths ;; Search paths for native inputs, when cross building. (for-each (match-lambda - ((env-var (directories ...) separator) - (set-path-environment-variable env-var directories + ((env-var (files ...) separator type) + (set-path-environment-variable env-var files native-input-directories - #:separator separator))) + #:separator separator + #:type type))) native-search-paths)) #t) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 9b1e098c6b..f22b2c3cb7 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -290,9 +290,10 @@ matches REGEXP." ;;; Search paths. ;;; -(define (search-path-as-list sub-directories input-dirs) - "Return the list of directories among SUB-DIRECTORIES that exist in -INPUT-DIRS. Example: +(define* (search-path-as-list files input-dirs + #:key (type 'directory)) + "Return the list of directories among FILES of the given TYPE (a symbol as +returned by 'stat:type') that exist in INPUT-DIRS. Example: (search-path-as-list '(\"share/emacs/site-lisp\" \"share/emacs/24.1\") (list \"/package1\" \"/package2\" \"/package3\")) @@ -301,12 +302,12 @@ INPUT-DIRS. Example: " (append-map (lambda (input) - (filter-map (lambda (dir) - (let ((dir (string-append input "/" - dir))) - (and (directory-exists? dir) - dir))) - sub-directories)) + (filter-map (lambda (file) + (let* ((file (string-append input "/" file)) + (stat (stat file #f))) + (and stat (eq? type (stat:type stat)) + file))) + files)) input-dirs)) (define (list->search-path-as-string lst separator) @@ -315,16 +316,20 @@ INPUT-DIRS. Example: (define* (search-path-as-string->list path #:optional (separator #\:)) (string-tokenize path (char-set-complement (char-set separator)))) -(define* (set-path-environment-variable env-var sub-directories input-dirs - #:key (separator ":")) - "Look for each of SUB-DIRECTORIES in INPUT-DIRS. Set ENV-VAR to a -SEPARATOR-separated path accordingly. Example: +(define* (set-path-environment-variable env-var files input-dirs + #:key + (separator ":") + (type 'directory)) + "Look for each of FILES of the given TYPE (a symbol as returned by +'stat:type') in INPUT-DIRS. Set ENV-VAR to a SEPARATOR-separated path +accordingly. Example: (set-path-environment-variable \"PKG_CONFIG\" '(\"lib/pkgconfig\") (list package1 package2)) " - (let* ((path (search-path-as-list sub-directories input-dirs)) + (let* ((path (search-path-as-list files input-dirs + #:type type)) (value (list->search-path-as-string path separator))) (if (string-null? value) (begin diff --git a/guix/packages.scm b/guix/packages.scm index a25eab7699..ed9a565dc6 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -180,7 +180,8 @@ representation." corresponds to the arguments expected by `set-path-environment-variable'." (match spec (($ variable directories separator) - `(,variable ,directories ,separator)))) + ;; TODO: Allow other values of TYPE. See . + `(,variable ,directories ,separator directory)))) (define %supported-systems ;; This is the list of system types that are supported. By default, we -- cgit v1.2.3 From 7ec02d374d1fa8a8f4034a996485872fd2aa7b73 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 27 Dec 2014 22:55:34 +0100 Subject: build-support/gnu: Add support for file patterns in search paths. * guix/build/utils.scm (search-path-as-list): Add #:pattern parameter and honor it. (set-path-environment-variable): Likewise, and pass it to 'search-path-as-list'. * guix/packages.scm (search-path-specification->sexp): Add PATTERN slot. * guix/build/gnu-build-system.scm (set-paths): Adjust accordingly. --- guix/build/gnu-build-system.scm | 10 ++++++---- guix/build/utils.scm | 40 ++++++++++++++++++++++++++++++++-------- guix/packages.scm | 3 ++- 3 files changed, 40 insertions(+), 13 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index d661736831..11b43c521f 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -73,21 +73,23 @@ input-directories))) (for-each (match-lambda - ((env-var (files ...) separator type) + ((env-var (files ...) separator type pattern) (set-path-environment-variable env-var files input-directories #:separator separator - #:type type))) + #:type type + #:pattern pattern))) search-paths) (when native-search-paths ;; Search paths for native inputs, when cross building. (for-each (match-lambda - ((env-var (files ...) separator type) + ((env-var (files ...) separator type pattern) (set-path-environment-variable env-var files native-input-directories #:separator separator - #:type type))) + #:type type + #:pattern pattern))) native-search-paths)) #t) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index f22b2c3cb7..47bcb3e8a1 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -291,7 +291,7 @@ matches REGEXP." ;;; (define* (search-path-as-list files input-dirs - #:key (type 'directory)) + #:key (type 'directory) pattern) "Return the list of directories among FILES of the given TYPE (a symbol as returned by 'stat:type') that exist in INPUT-DIRS. Example: @@ -300,13 +300,26 @@ returned by 'stat:type') that exist in INPUT-DIRS. Example: => (\"/package1/share/emacs/site-lisp\" \"/package3/share/emacs/site-lisp\") +When PATTERN is true, it is a regular expression denoting file names to look +for under the directories designated by FILES. For example: + + (search-path-as-list '(\"xml\") (list docbook-xml docbook-xsl) + #:type 'regular + #:pattern \"^catalog\\\\.xml$\") + => (\"/…/xml/dtd/docbook/catalog.xml\" + \"/…/xml/xsl/docbook-xsl-1.78.1/catalog.xml\") " (append-map (lambda (input) - (filter-map (lambda (file) - (let* ((file (string-append input "/" file)) - (stat (stat file #f))) - (and stat (eq? type (stat:type stat)) - file))) + (append-map (lambda (file) + (let ((file (string-append input "/" file))) + ;; XXX: By using 'find-files', we implicitly + ;; assume #:type 'regular. + (if pattern + (find-files file pattern) + (let ((stat (stat file #f))) + (if (and stat (eq? type (stat:type stat))) + (list file) + '()))))) files)) input-dirs)) @@ -319,7 +332,8 @@ returned by 'stat:type') that exist in INPUT-DIRS. Example: (define* (set-path-environment-variable env-var files input-dirs #:key (separator ":") - (type 'directory)) + (type 'directory) + pattern) "Look for each of FILES of the given TYPE (a symbol as returned by 'stat:type') in INPUT-DIRS. Set ENV-VAR to a SEPARATOR-separated path accordingly. Example: @@ -327,9 +341,19 @@ accordingly. Example: (set-path-environment-variable \"PKG_CONFIG\" '(\"lib/pkgconfig\") (list package1 package2)) + +When PATTERN is not #f, it must be a regular expression (really a string) +denoting file names to look for under the directories designated by FILES: + + (set-path-environment-variable \"XML_CATALOG_FILES\" + '(\"xml\") + (list docbook-xml docbook-xsl) + #:type 'regular + #:pattern \"^catalog\\\\.xml$\") " (let* ((path (search-path-as-list files input-dirs - #:type type)) + #:type type + #:pattern pattern)) (value (list->search-path-as-string path separator))) (if (string-null? value) (begin diff --git a/guix/packages.scm b/guix/packages.scm index b375895785..e299962a2e 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -181,7 +181,8 @@ representation." corresponds to the arguments expected by `set-path-environment-variable'." (match spec (($ variable files separator type) - `(,variable ,files ,separator ,type)))) + ;; TODO: Add support for PATTERN. + `(,variable ,files ,separator ,type #f)))) (define %supported-systems ;; This is the list of system types that are supported. By default, we -- cgit v1.2.3 From bd2fc4d81342dc15feba2998835e69dabee08864 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 27 Dec 2014 23:24:35 +0100 Subject: utils: Export 'search-path-as-list'. * guix/build/utils.scm (search-path-as-list): Make public. * guix/scripts/environment.scm (for-each-search-path): Use it. --- guix/build/utils.scm | 1 + guix/scripts/environment.scm | 5 ++--- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 47bcb3e8a1..86b7ca0155 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -45,6 +45,7 @@ delete-file-recursively find-files + search-path-as-list set-path-environment-variable search-path-as-string->list list->search-path-as-string diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 412b8be658..b3a79d9251 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -45,9 +45,8 @@ path value is appended." (($ variable directories separator) (let* ((current (getenv variable)) - (path ((@@ (guix build utils) search-path-as-list) - directories paths)) - (value (list->search-path-as-string path separator))) + (path (search-path-as-list directories paths)) + (value (list->search-path-as-string path separator))) (proc variable (if (and current (not pure?)) (string-append value separator current) -- cgit v1.2.3 From 4eb01e5442aa7bbaa880ae8e72bd5d27434855ef Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 9 Jan 2015 22:35:33 +0100 Subject: build-system/gnu: Patch /usr/bin/file in all 'configure' files. * guix/build/utils.scm (patch-/usr/bin/file): New procedure. * guix/build/gnu-build-system.scm (patch-usr-bin-file): Rewrite using it. Patch all the files returned by 'find-files' that are executable. * gnu/packages/gawk.scm (gawk)[arguments]: Remove use of 'substitute*' for 'extension/configure'. --- gnu/packages/gawk.scm | 10 +--------- guix/build/gnu-build-system.scm | 30 ++++++++---------------------- guix/build/utils.scm | 26 +++++++++++++++++++++++++- 3 files changed, 34 insertions(+), 32 deletions(-) (limited to 'guix/build/utils.scm') diff --git a/gnu/packages/gawk.scm b/gnu/packages/gawk.scm index 74d0720567..e0d3f41ac2 100644 --- a/gnu/packages/gawk.scm +++ b/gnu/packages/gawk.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2014, 2015 Mark H Weaver ;;; ;;; This file is part of GNU Guix. @@ -55,14 +55,6 @@ '((substitute* "extension/Makefile.in" (("^.*: check-for-shared-lib-support" match) (string-append "### " match)))) - '()) - - ;; XXX FIXME prerelease libtool fails on MIPS in the - ;; absence of /usr/bin/file. - ,@(if (string-prefix? "mips64" (or (%current-target-system) - (%current-system))) - '((substitute* "extension/configure" - (("/usr/bin/file") (which "file")))) '()))) (alist-cons-before diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index cdfba2f9b7..2880168273 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -115,29 +115,15 @@ working directory." (define* (patch-usr-bin-file #:key native-inputs inputs (patch-/usr/bin/file? #t) #:allow-other-keys) - "Patch occurrences of /usr/bin/file in configure, if present." + "Patch occurrences of \"/usr/bin/file\" in all the executable 'configure' +files found in the source tree. This works around Libtool's Autoconf macros, +which generates invocations of \"/usr/bin/file\" that are used to determine +things like the ABI being used." (when patch-/usr/bin/file? - (let ((file "configure") - (file-command (or (and=> (assoc-ref (or native-inputs inputs) "file") - (cut string-append <> "/bin/file")) - (which "file")))) - (cond ((not (file-exists? file)) - (format (current-error-port) - "patch-usr-bin-file: warning: `~a' not found~%" - file)) - ((not file-command) - (format (current-error-port) - "patch-usr-bin-file: warning: `file' not found in PATH~%")) - (else - (let ((st (stat file))) - (substitute* file - (("/usr/bin/file") - (begin - (format (current-error-port) - "patch-usr-bin-file: ~a: changing `~a' to `~a'~%" - file "/usr/bin/file" file-command) - file-command))) - (set-file-time file st)))))) + (for-each (lambda (file) + (when (executable-file? file) + (patch-/usr/bin/file file))) + (find-files "." "^configure$"))) #t) (define* (patch-source-shebangs #:key source #:allow-other-keys) diff --git a/guix/build/utils.scm b/guix/build/utils.scm index 86b7ca0155..4407f9af23 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; @@ -61,6 +61,7 @@ set-file-time patch-shebang patch-makefile-SHELL + patch-/usr/bin/file fold-port-matches remove-store-references wrap-program)) @@ -681,6 +682,29 @@ When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged." (when keep-mtime? (set-file-time file st)))) +(define* (patch-/usr/bin/file file + #:key + (file-command (which "file")) + (keep-mtime? #t)) + "Patch occurrences of \"/usr/bin/file\" in FILE, replacing them with +FILE-COMMAND. When KEEP-MTIME? is true, keep FILE's modification time +unchanged." + (if (not file-command) + (format (current-error-port) + "patch-/usr/bin/file: warning: \ +no replacement 'file' command, doing nothing~%") + (let ((st (stat file))) + (substitute* file + (("/usr/bin/file") + (begin + (format (current-error-port) + "patch-/usr/bin/file: ~a: changing `~a' to `~a'~%" + file "/usr/bin/file" file-command) + file-command))) + + (when keep-mtime? + (set-file-time file st))))) + (define* (fold-port-matches proc init pattern port #:optional (unmatched (lambda (_ r) r))) "Read from PORT character-by-character; for each match against -- cgit v1.2.3