~ chicken-core (chicken-5) f27f37f5b9f41f8007fc6447bdff44c27a840c60
commit f27f37f5b9f41f8007fc6447bdff44c27a840c60
Author: Mario Domenech Goulart <mario@parenteses.org>
AuthorDate: Wed Jan 3 08:34:46 2024 +0100
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Thu Jan 4 23:16:01 2024 +0100
chicken-install: Store cache metadata out of the C include path
Store VERSION, TIMESTAMP and STATUS files into egg directories under
<cache-dir>/.cache-metadata/, which is not in the include path of the
C compiler. This avoids the problem of unintended use of those files
by C/C++ code via #include, notably on systems which use
case-insensitive filesystems (like MacOS).
This is a follow-up to the fix for #1753.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/NEWS b/NEWS
index 3fcbbdd4..ffb42e1e 100644
--- a/NEWS
+++ b/NEWS
@@ -45,10 +45,6 @@
- When `location' is specified in setup.defaults, chicken-install
will consider two location layouts when looking for eggs:
<location>/<egg> and <location>/<egg>/<version>.
- - chicken-install now prefixes special files like VERSION, STATUS
- and TIMESTAMP with an underscore to reduce likelihood of
- collisions with source files on case-insensitive file systems
- like on MacOS (#1753, reported by Kon Lovett).
- chicken-install: Fix #1684 (programs that specify
component-dependencies should build-depend on their import
libraries).
@@ -57,6 +53,10 @@
(short: -l) to specify local directories where to get egg sources
from.
- chicken-install now gives a warning on unexpected properties (#1492).
+ - chicken-install now uses a directory specific for cache metadata
+ (VERSION, STATUS and TIMESTAMP files) to avoid collisions with source
+ files on case-insensitive file systems like on MacOS (#1753, reported
+ by Kon Lovett).
- Syntax expander
- When passing a module as an environment to eval, correctly resolve
diff --git a/chicken-install.scm b/chicken-install.scm
index 56c741db..36482755 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -417,13 +417,17 @@
(define (locate-egg name version)
(let* ((cached (make-pathname cache-directory name))
+ (metadata-dir (make-pathname cache-metadata-directory name))
(now (current-seconds))
- (status (make-pathname cached +status-file+))
+ (status (make-pathname metadata-dir +status-file+))
(eggfile (make-pathname cached name +egg-extension+)))
(define (fetch lax)
(when (file-exists? cached)
(delete-directory cached #t))
+ (when (file-exists? metadata-dir)
+ (delete-directory metadata-dir #t))
(create-directory cached #t)
+ (create-directory metadata-dir #t)
(fetch-egg-sources name version cached lax))
(cond ((and (probe-dir cached)
(not (file-exists? status)))
@@ -448,8 +452,8 @@
(error "cached egg does not match CHICKEN version - use `-force' to install anyway" name)))
(else (fetch #f)))))
(let* ((info (validate-egg-info (load-egg-info eggfile)))
- (vfile (make-pathname cached +version-file+))
- (tfile (make-pathname cached +timestamp-file+))
+ (vfile (make-pathname metadata-dir +version-file+))
+ (tfile (make-pathname metadata-dir +timestamp-file+))
(lversion (or (get-egg-property info 'version)
(and (file-exists? vfile)
(with-input-from-file vfile read)))))
@@ -503,14 +507,15 @@
(values (make-pathname egg-dir (->string latest))
latest)))))))))
-(define (write-cache-metadata egg-cache-dir egg-version)
- (when egg-version
- (with-output-to-file (make-pathname egg-cache-dir +version-file+)
- (cut write egg-version)))
- (with-output-to-file (make-pathname egg-cache-dir +timestamp-file+)
- (cut write (current-seconds)))
- (with-output-to-file (make-pathname egg-cache-dir +status-file+)
- (cut write current-status)))
+(define (write-cache-metadata egg egg-version)
+ (let ((metadata-dir (make-pathname cache-metadata-directory egg)))
+ (when egg-version
+ (with-output-to-file (make-pathname metadata-dir +version-file+)
+ (cut write egg-version)))
+ (with-output-to-file (make-pathname metadata-dir +timestamp-file+)
+ (cut write (current-seconds)))
+ (with-output-to-file (make-pathname metadata-dir +status-file+)
+ (cut write current-status))))
(define (fetch-egg-sources name version dest lax)
(print "fetching " name)
@@ -538,7 +543,7 @@
(cond (dir
(copy-egg-sources tmpdir dest)
(delete-directory tmpdir #t)
- (write-cache-metadata dest ver))
+ (write-cache-metadata name ver))
(else (loop (cdr srvs))))))))))
(else
(receive (dir version-from-path)
@@ -560,7 +565,7 @@
(version>=? rversion version))
(begin
(copy-egg-sources dir dest)
- (write-cache-metadata dest (or rversion version)))
+ (write-cache-metadata name (or rversion version)))
(loop (cdr locs))))
(loop (cdr locs))))))))
@@ -865,9 +870,10 @@
(lambda (egg)
(let* ((name (car egg))
(dir (cadr egg))
+ (metadata-dir (make-pathname cache-metadata-directory name))
(eggfile (make-pathname dir name +egg-extension+))
(info (load-egg-info eggfile))
- (vfile (make-pathname dir +version-file+))
+ (vfile (make-pathname metadata-dir +version-file+))
(ver (and (file-exists? vfile)
(with-input-from-file vfile read))))
(when (or host-extension
@@ -1048,10 +1054,14 @@
(for-each
(lambda (egg)
(let* ((name (if (pair? egg) (car egg) egg))
- (dname (make-pathname cache-directory name)))
- (when (file-exists? dname)
- (d "purging ~a from cache at ~a~%" name dname)
- (delete-directory dname #t))))
+ (cache-dir (make-pathname cache-directory name))
+ (metadata-dir (make-pathname cache-metadata-directory name)))
+ (when (file-exists? cache-dir)
+ (d "purging ~a from cache at ~a~%" name cache-dir)
+ (delete-directory cache-dir #t))
+ (when (file-exists? metadata-dir)
+ (d "purging metadata of ~a from cache at ~a~%" name metadata-dir)
+ (delete-directory metadata-dir #t))))
eggs))))
diff --git a/chicken-status.scm b/chicken-status.scm
index 6cbd02bc..ed51d2b0 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -112,7 +112,9 @@
(let ((version
(or (let ((info (read-info egg dir ext)))
(and info (get-egg-property info 'version)))
- (let ((file (chicken.load#find-file +version-file+ dir)))
+ (let ((file (file-exists?
+ (make-pathname (list cache-metadata-directory egg)
+ +version-file+))))
(and file (with-input-from-file file read)))
"unknown")))
(print (format-string (string-append egg " ")
diff --git a/egg-environment.scm b/egg-environment.scm
index fa0235a2..1dbda373 100644
--- a/egg-environment.scm
+++ b/egg-environment.scm
@@ -99,9 +99,6 @@ EOF
(string-append default-runlibdir "/chicken/" (number->string binary-version)))
(define +egg-info-extension+ "egg-info")
-(define +version-file+ "_VERSION")
-(define +timestamp-file+ "_TIMESTAMP")
-(define +status-file+ "_STATUS")
(define +egg-extension+ "egg")
(define (validate-environment)
@@ -126,3 +123,12 @@ EOF
(make-pathname (or (system-cache-directory)
(current-directory))
chicken-install-program)))
+
+(define cache-metadata-directory
+ ;; Directory where the VERSION, TIMESTAMP and STATUS files are
+ ;; stored (under their corresponding egg directory).
+ (make-pathname cache-directory ".cache-metadata"))
+
+(define +version-file+ "VERSION")
+(define +timestamp-file+ "TIMESTAMP")
+(define +status-file+ "STATUS")
Trap