ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 13:58:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

utils: Restore the mtime/atime of patched files.

Browse source 
* guix/build/utils.scm (set-file-time): New procedure.
  (patch-shebang): New `keep-mtime?' parameter; call `set-file-time'
  when it's true.
  (patch-makefile-SHELL): Likewise.
This commit is contained in:
Ludovic Courtès 2012-12-31 01:17:43 +01:00
parent f678f6d913
commit bc5bf85fa2
1 changed files with 34 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

48
guix/build/utils.scm
View file

@ -43,6 +43,7 @@ (define-module (guix build utils)
substitute
substitute*
dump-port
set-file-time
patch-shebang
patch-makefile-SHELL
fold-port-matches
@ -408,17 +409,29 @@ (define buffer
(loop total
(get-bytevector-n! in buffer 0 buffer-size))))))))
(define (set-file-time file stat)
"Set the atime/mtime of FILE to that specified by STAT."
(utime file
(stat:atime stat)
(stat:mtime stat)
(stat:atimensec stat)
(stat:mtimensec stat)))
(define patch-shebang
(let ((shebang-rx (make-regexp "^[[:blank:]]*([[:graph:]]+)(.*)$")))
(lambda* (file
#:optional (path (search-path-as-string->list (getenv "PATH"))))
#:optional
(path (search-path-as-string->list (getenv "PATH")))
#:key (keep-mtime? #t))
"Replace the #! interpreter file name in FILE by a valid one found in
PATH, when FILE actually starts with a shebang. Return #t when FILE was
patched, #f otherwise."
patched, #f otherwise. When KEEP-MTIME? is true, the atime/mtime of
FILE are kept unchanged."
(define (patch p interpreter rest-of-line)
(let* ((template (string-append file ".XXXXXX"))
(out (mkstemp! template))
(mode (stat:mode (stat file))))
(st (stat file))
(mode (stat:mode st)))
(with-throw-handler #t
(lambda ()
(format out "#!~a~a~%"
@ -427,6 +440,8 @@ (define (patch p interpreter rest-of-line)
(close out)
(chmod template mode)
(rename-file template file)
(when keep-mtime?
(set-file-time file st))
#t)
(lambda (key . args)
(format (current-error-port)
@ -458,8 +473,9 @@ (define (patch p interpreter rest-of-line)
file (basename cmd))
#f))))))))))))
(define (patch-makefile-SHELL file)
"Patch the `SHELL' variable in FILE, which is supposedly a makefile."
(define* (patch-makefile-SHELL file #:key (keep-mtime? #t))
"Patch the `SHELL' variable in FILE, which is supposedly a makefile.
When KEEP-MTIME? is true, the atime/mtime of FILE are kept unchanged."
;; For instance, Gettext-generated po/Makefile.in.in do not honor $SHELL.
@ -475,15 +491,19 @@ (define (find-shell name)
name))
shell))
(substitute* file
(("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)[[:blank:]]*" _ dir shell)
(let* ((old (string-append dir shell))
(new (or (find-shell shell) old)))
(unless (string=? new old)
(format (current-error-port)
"patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
file old new))
(string-append "SHELL = " new "\n")))))
(let ((st (stat file)))
(substitute* file
(("^ *SHELL[[:blank:]]*=[[:blank:]]*([[:graph:]]*/)([[:graph:]]+)[[:blank:]]*" _ dir shell)
(let* ((old (string-append dir shell))
(new (or (find-shell shell) old)))
(unless (string=? new old)
(format (current-error-port)
"patch-makefile-SHELL: ~a: changing `SHELL' from `~a' to `~a'~%"
file old new))
(string-append "SHELL = " new "\n"))))
(when keep-mtime?
(set-file-time file st))))
(define* (fold-port-matches proc init pattern port
#:optional (unmatched (lambda (_ r) r)))