@@ -17,6 +17,7 @@
;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
;;; Copyright © 2023 Philip McGrath <philip@philipmcgrath.com>
+;;; Copyright © 2023 Brian Cully <bjc@spork.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -42,6 +43,7 @@ (define-module (guix utils)
#:use-module (rnrs io ports) ;need 'port-position' etc.
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
#:use-module (guix memoization)
+ #:use-module (guix modules)
#:use-module ((guix build utils)
#:select (dump-port mkdir-p delete-file-recursively
call-with-temporary-output-file %xz-parallel-args))
@@ -49,6 +51,7 @@ (define-module (guix utils)
#:use-module ((guix combinators) #:select (fold2))
#:use-module (guix diagnostics) ;<location>, &error-location, etc.
#:use-module (ice-9 format)
+ #:use-module (ice-9 ftw)
#:use-module ((ice-9 iconv) #:prefix iconv:)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
@@ -134,6 +137,8 @@ (define-module (guix utils)
config-directory
cache-directory
+ change-file-timestamps-recursively
+
readlink*
go-to-location
edit-expression
@@ -156,6 +161,30 @@ (define-module (guix utils)
;;; Environment variables.
;;;
+(define (change-file-timestamps-recursively location time)
+ "Recursively Change the atime and mtime of all files in LOCATION to TIME.
+
+TIME is specified in ISO 8601 format (YYYY-mm-dd HH:MM:SS) in UTC."
+
+ (define tm (strptime "%F %H:%M:%S %z" (string-append time " +0000")))
+ (define epoch-seconds (string->number (strftime "%s" (car tm))))
+
+ (let loop ((prefix
+ (substring location
+ 0 (+ 1 (string-rindex location (cut eq? #\/ <>)))))
+ (node (file-system-tree location)))
+ (match node
+ ((name stat) ; flat file
+ (when (not (eq? (stat:type stat) 'symlink))
+ (utime (string-append prefix name) epoch-seconds epoch-seconds)))
+ ((name stat children ...) ; directory
+ (utime (string-append prefix name) epoch-seconds epoch-seconds)
+ (for-each (lambda (child)
+ (loop (string-append prefix name
+ file-name-separator-string)
+ child))
+ children)))))
+
(define (call-with-environment-variables variables thunk)
"Call THUNK with the environment VARIABLES set."
(let ((environment (environ)))