>From 9a5bc592b13e80d805fb82a3cf9535baff79b196 Mon Sep 17 00:00:00 2001 From: Mario Domenech Goulart Date: Wed, 3 Jan 2024 08:34:46 +0100 Subject: [PATCH] chicken-install: Store cache metadata out of the C include path Store VERSION, TIMESTAMP and STATUS files into egg directories under /.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. --- NEWS | 8 ++++---- chicken-install.scm | 46 +++++++++++++++++++++++++++------------------ chicken-status.scm | 4 +++- egg-environment.scm | 12 +++++++++--- 4 files changed, 44 insertions(+), 26 deletions(-) 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: / and //. - - 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") -- 2.39.2