(define (file-size file) "Return the size of the regular file FILE in bytes." (stat:size (stat file))) (define (rm-recursive dir) "Deletes the DIR directory recursively." (invoke "rm" "-r" dir)) (define (check-header file header) "Returns a boolean. The return value is true only if the first bytes of the FILE match exactly the content of the bytevector HEADER." (call-with-input-file file (lambda (file) (equal? (get-bytevector-n file (bytevector-length header)) header)))) (define (strip-header file header-length) "Strips off the first HEADER-LENGTH bytes of the FILE." (let ((temp-file (mkstemp! (string-copy "temp-file.XXXXXX")))) (let ((content-length (- (file-size file) header-length))) (send-file temp-file file content-length header-length)) (rename-file temp-file file))) (define (prepend-header file header) "Prepends the content of the bytevector HEADER to FILE." (let ((temp-file (mkstemp! (string-copy "temp-file.XXXXXX")))) (put-bytevector temp-file header) (send-file temp-file file (file-size file) 0) (rename-file temp-file file))) (define (reset-file-timestamp file) "Resets the access and modification times of FILE." (let ((s (lstat file))) (unless (eq? (stat:type s) 'symlink) (format #t "reset ~a~%" file) (utime file 0 0 0 0)))) (define (repack-zip file) "Resets the timestamps of the zip archive FILE." (let ((dir (mkdtemp! "zip-contents.XXXXXX"))) (with-directory-excursion dir (invoke "unzip" file) (delete-file file) (for-each reset-file-timestamp (find-files dir #:directories? #t)) (let ((files (find-files "." ".*" #:directories? #t))) (apply invoke "zip" "-0" "-X" file files))) (rm-recursive dir))) (define (repack-jmod file) "Resets the timestamps of the .jmod FILE." (call-with-input-file file (lambda (file) (let ((header #vu8(#x4a #x4d #x01 #x00))) (if (check-header file header) (let ((header-length (bytevector-length header))) (strip-header file header-length) (repack-zip file) (prepend-header file header)) (throw 'jmod-error "bad magic")))))) (define (reset-zip-timestamps dir) "Resets the timestamps of all zip achives under DIR." (for-each repack-zip (find-files dir ".*.(zip|jar|diz)$"))) (define (reset-jmod-timestamps dir) "Resets the timestamps of all jmod files under DIR." (for-each repack-jmod (find-files dir ".*.jmod$"))) (define (reset-achive-timestamps dir) "Resets the zip and jmod file timestamps of all files under DIR." (reset-zip-timestamps dir) (reset-jmod-timestamps dir)) (define (for-each-output procedure) "Executes the PROCEDURE with the output directory as the sole argument for all outputs." (for-each (compose procedure cdr) outputs)) (define (reset-achive-timepstamps) "Resets the zip and jmod file timestamps for all outputs." (for-each-output reset-archive-timestamps))