summaryrefslogtreecommitdiff
path: root/henrietta-cache.scm
diff options
context:
space:
mode:
Diffstat (limited to 'henrietta-cache.scm')
-rw-r--r--henrietta-cache.scm28
1 files changed, 27 insertions, 1 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index 05d1925..affbb02 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -78,7 +78,33 @@ EOF
(make-pathname tmpdir (car contents))
tmpdir)))
(rename-file contents-dir cache-dir)
- (system (sprintf "rm -rf ~A" (qs tmpdir)))))))))
+ (system (sprintf "rm -rf ~A" (qs tmpdir)))))))
+ (meta-file . ,(lambda (uri cache-dir)
+ (let* ((meta (car (call-with-input-request uri #f read-file)))
+ (uri (uri-reference uri))
+ (add-to-uri
+ (lambda (f)
+ (let ((rel (update-uri (uri-reference "")
+ path: (string-split f "/"))))
+ (uri-relative-to rel uri))))
+ (files (alist-ref 'files meta)))
+ (unless files
+ (error "No \"files\" entry found in meta file" uri))
+ (for-each
+ (lambda (file)
+ (printf "\t\t~A...\n" file)
+ (flush-output)
+ (and-let* ((dirname (pathname-directory file))
+ (directory (make-pathname cache-dir dirname)))
+ (unless (file-exists? directory)
+ (create-directory directory #t)))
+ (call-with-input-request
+ (add-to-uri file) #f
+ (lambda (i)
+ (call-with-output-file
+ (make-pathname cache-dir file)
+ (lambda (o) (copy-port i o))))))
+ files))))))
(define (download-all-release-files egg-name uris/releases uris)
(let ((egg-cache-dir (make-pathname *cache-directory* (->string egg-name))))