[bug#63044] [PATCH 2/4] guix: utils: add `change-file-timestamps-recursively' procedure

[Brian Cully]

There are some packages which use the zip library in `python-setuptools' which
will error and fail to build if it finds files with timestamps before 1980.

Create a new procedure which will update the atime and mtime fields of a
directory to a date and time specified in UTC.

 * guix/utils.scm (change-file-timestamps-recursively): new procedure
---
 guix/utils.scm | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index b9657df292..a6de6a82fb 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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)))
-- 
2.39.2