summaryrefslogtreecommitdiff
path: root/henrietta-cache.scm
diff options
context:
space:
mode:
Diffstat (limited to 'henrietta-cache.scm')
-rw-r--r--henrietta-cache.scm59
1 files changed, 34 insertions, 25 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index ce2ed93..58d7f90 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -80,34 +80,43 @@ EOF
uri (get-condition-property e 'exn 'message))))))
(define (download-files-from-list base-uri files cache-dir)
- (let ((add-to-uri
+ (let ((tmp-dir (create-temporary-directory))
+ (add-to-uri
(lambda (f)
(let* ((components (string-split f "/"))
(rel (update-uri (uri-reference "") path: components)))
(uri-relative-to rel base-uri)))))
- (create-directory cache-dir #t) ; TODO: Download to tmpdir, then move
- (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)))
- (condition-case
- (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)))))
- (e (exn http)
- (error (sprintf
- (conc "Could not download file \"~A\", "
- "listed in meta-file/files-list (full URI: ~A) -- ~A")
- file (uri->string (add-to-uri file))
- (get-condition-property e 'exn 'message))))))
- files)))
+ (handle-exceptions exn
+ (begin (system (sprintf "rm -rf ~A" (qs tmp-dir)))
+ (signal exn))
+ (for-each
+ (lambda (file)
+ (printf "\t\t~A...\n" file)
+ (flush-output)
+ (and-let* ((dirname (pathname-directory file))
+ (directory (make-pathname tmp-dir dirname)))
+ (unless (file-exists? directory)
+ (create-directory directory #t)))
+ (condition-case
+ (call-with-input-request
+ (add-to-uri file) #f
+ (lambda (i)
+ (call-with-output-file
+ (make-pathname tmp-dir file)
+ (lambda (o) (copy-port i o)))))
+ (e (exn http)
+ (error (sprintf
+ (conc "Could not download file \"~A\", "
+ "listed in meta-file/files-list (full URI: ~A) -- ~A")
+ file (uri->string (add-to-uri file))
+ (get-condition-property e 'exn 'message))))))
+ files)
+ (create-directory cache-dir #t)
+ (let* ((cmd (sprintf "mv ~A/* ~A" (qs tmp-dir) (qs cache-dir)))
+ (status (system cmd)))
+ (unless (zero? status)
+ (error "Got an error executing command" cmd))
+ (system (sprintf "rm -rf ~A" (qs tmp-dir)))))))
;; Make-cmd is a lambda which accepts the temporary file- and dirname
;; and returns a suitable command to execute using SYSTEM
@@ -212,7 +221,7 @@ EOF
(flush-output)
(handle-exceptions exn
(begin
- (system (sprintf "rm -rf ~A" cache-dir))
+ (system (sprintf "rm -rf ~A" (qs cache-dir)))
(fprintf (current-error-port)
"Error downloading or extracting egg '~A' release ~A: "
egg-name egg-release)