While playing with ‘wrap-program’, I rewrote it so create a single
wrapper and modify that wrapper when it exists instead of layering an
extra wrapper.
Thoughts? If there are no objections, I’d like to commit this one.
Thanks,
Ludo’.
modified guix/build/utils.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <l...@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016 Ludovic Courtès <l...@gnu.org>
;;; Copyright © 2013 Andreas Enge <andr...@enge.fr>
;;; Copyright © 2013 Nikita Karetnikov <nik...@karetnikov.org>
;;; Copyright © 2015 Mark H Weaver <m...@netris.org>
@@ -946,62 +946,68 @@ modules in $GUILE_LOAD_PATH, etc.
If PROG has previously been wrapped by wrap-program the wrapper will point to
the previous wrapper."
- (define (wrapper-file-name number)
- (format #f "~a/.~a-wrap-~2'0d" (dirname prog) (basename prog) number))
- (define (next-wrapper-number)
- (let ((wrappers
- (find-files (dirname prog)
- (string-append "\\." (basename prog) "-wrap-.*"))))
- (if (null? wrappers)
- 0
- (string->number (string-take-right (last wrappers) 2)))))
- (define (wrapper-target number)
- (if (zero? number)
- (let ((prog-real (string-append (dirname prog) "/."
- (basename prog) "-real")))
- (rename-file prog prog-real)
- prog-real)
- (wrapper-file-name number)))
+ (define wrapped-file
+ (string-append (dirname prog) "/." (basename prog) "-real"))
- (let* ((number (next-wrapper-number))
- (target (wrapper-target number))
- (wrapper (wrapper-file-name (1+ number)))
- (prog-tmp (string-append target "-tmp")))
- (define (export-variable lst)
- ;; Return a string that exports an environment variable.
- (match lst
- ((var sep '= rest)
- (format #f "export ~a=\"~a\""
- var (string-join rest sep)))
- ((var sep 'prefix rest)
- (format #f "export ~a=\"~a${~a~a+~a}$~a\""
- var (string-join rest sep) var sep sep var))
- ((var sep 'suffix rest)
- (format #f "export ~a=\"$~a${~a~a+~a}~a\""
- var var var sep sep (string-join rest sep)))
- ((var '= rest)
- (format #f "export ~a=\"~a\""
- var (string-join rest ":")))
- ((var 'prefix rest)
- (format #f "export ~a=\"~a${~a:+:}$~a\""
- var (string-join rest ":") var var))
- ((var 'suffix rest)
- (format #f "export ~a=\"$~a${~a:+:}~a\""
- var var var (string-join rest ":")))))
+ (define already-wrapped?
+ (file-exists? wrapped-file))
- (with-output-to-file prog-tmp
- (lambda ()
- (format #t
- "#!~a~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%"
- (which "bash")
- (string-join (map export-variable vars)
- "\n")
- (canonicalize-path target))))
+ (define (last-line port)
+ (let loop ((previous-line-offset 0)
+ (previous-line "")
+ (position (seek port 0 SEEK_CUR)))
+ (match (read-line port 'concat)
+ ((? eof-object?)
+ (seek port previous-line-offset SEEK_SET)
+ previous-line)
+ ((? string? line)
+ (loop position line (+ (string-length line) position))))))
- (chmod prog-tmp #o755)
- (rename-file prog-tmp wrapper)
- (symlink wrapper prog-tmp)
- (rename-file prog-tmp prog)))
+ (define (export-variable lst)
+ ;; Return a string that exports an environment variable.
+ (match lst
+ ((var sep '= rest)
+ (format #f "export ~a=\"~a\""
+ var (string-join rest sep)))
+ ((var sep 'prefix rest)
+ (format #f "export ~a=\"~a${~a~a+~a}$~a\""
+ var (string-join rest sep) var sep sep var))
+ ((var sep 'suffix rest)
+ (format #f "export ~a=\"$~a${~a~a+~a}~a\""
+ var var var sep sep (string-join rest sep)))
+ ((var '= rest)
+ (format #f "export ~a=\"~a\""
+ var (string-join rest ":")))
+ ((var 'prefix rest)
+ (format #f "export ~a=\"~a${~a:+:}$~a\""
+ var (string-join rest ":") var var))
+ ((var 'suffix rest)
+ (format #f "export ~a=\"$~a${~a:+:}~a\""
+ var var var (string-join rest ":")))))
+
+ (if already-wrapped?
+ (let* ((port (open-file prog "r+"))
+ (last (last-line port)))
+ (for-each (lambda (var)
+ (display (export-variable var) port)
+ (newline port))
+ vars)
+ (display last port)
+ (close-port port))
+ (let ((prog-tmp (string-append wrapped-file "-tmp")))
+ (copy-file prog wrapped-file)
+
+ (call-with-output-file prog-tmp
+ (lambda (port)
+ (format port
+ "#!~a --~%~a~%exec -a \"$0\" \"~a\" \"$@\"~%"
+ (which "bash")
+ (string-join (map export-variable vars)
+ "\n")
+ (canonicalize-path wrapped-file))))
+
+ (chmod prog-tmp #o755)
+ (rename-file prog-tmp prog))))
