diff options
| -rw-r--r-- | guix/build/utils.scm | 77 |
1 files changed, 76 insertions, 1 deletions
diff --git a/guix/build/utils.scm b/guix/build/utils.scm index e99afdfcf3..fbffa8ba43 100644 --- a/guix/build/utils.scm +++ b/guix/build/utils.scm @@ -22,14 +22,20 @@ #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 rdelim) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) #:export (directory-exists? with-directory-excursion set-path-environment-variable + search-path-as-string->list + list->search-path-as-string alist-cons-before alist-cons-after alist-replace substitute - substitute*)) + substitute* + dump-port + patch-shebang)) ;;; @@ -80,6 +86,9 @@ INPUT-DIRS. Example: (define (list->search-path-as-string lst separator) (string-join lst separator)) +(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 @@ -228,6 +237,72 @@ match substring." (display (begin body ...) p)))) ...))) + +;;; +;;; Patching shebangs---e.g., /bin/sh -> /nix/store/xyz...-bash/bin/sh. +;;; + +(define (dump-port in out) + "Read as much data as possible from IN and write it to OUT." + (define buffer-size 4096) + (define buffer + (make-bytevector buffer-size)) + + (let loop ((bytes (get-bytevector-n! in buffer 0 buffer-size))) + (or (eof-object? bytes) + (begin + (put-bytevector out buffer 0 bytes) + (loop (get-bytevector-n! in buffer 0 buffer-size)))))) + +(define patch-shebang + (let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]*)/([[:alnum:]]+)(.*)$"))) + (lambda (file) + "Patch the #! interpreter path in FILE, if FILE actually starts with a +shebang." + (define (patch p interpreter rest-of-line) + (let* ((template (string-append file ".XXXXXX")) + (out (mkstemp! template)) + (mode (stat:mode (stat file)))) + (with-throw-handler #t + (lambda () + (format out "#!~a~a~%" + interpreter rest-of-line) + (dump-port p out) + (close out) + (chmod template mode) + (rename-file template file) + #t) + (lambda (key . args) + (format (current-error-port) + "patch-shebang: ~a: error: ~a ~s~%" + file key args) + (false-if-exception (delete-file template)) + #f)))) + + (with-fluids ((%default-port-encoding #f)) ; ASCII + (call-with-input-file file + (lambda (p) + (and (eq? #\# (read-char p)) + (eq? #\! (read-char p)) + (let ((line (false-if-exception (read-line p)))) + (and=> (and line (regexp-exec shebang-rx line)) + (lambda (m) + (let* ((PATH + (search-path-as-string->list (getenv "PATH"))) + (cmd (match:substring m 2)) + (bin (search-path PATH cmd))) + (if bin + (begin + (format (current-error-port) + "patch-shebang: ~a: changing `~a/~a' to `~a'~%" + file (match:substring m 1) + cmd bin) + (patch p bin (match:substring m 3))) + (begin + (format (current-error-port) + "patch-shebang: ~a: warning: no binary for interpreter `~a' found in $PATH~%" + file cmd) + #f))))))))))))) ;;; Local Variables: ;;; eval: (put 'call-with-output-file/atomic 'scheme-indent-function 1) |