diff options
| author | Peter Bex <peter@more-magic.net> | 2011-06-02 16:05:02 +0200 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2011-06-02 16:05:02 +0200 |
| commit | 02a209c7df11c7c53166499ed3caf630c3d8e7f9 (patch) | |
| tree | e19c28fbc6010b20886409cd491628d757fd8aac | |
| parent | fbaeb27b6b9530fca9104edd9073a6efeb646058 (diff) | |
| download | henrietta-cache-02a209c7df11c7c53166499ed3caf630c3d8e7f9.tar.gz | |
Update to ensure path is always taken as a dir
| -rw-r--r-- | henrietta-cache.scm | 13 |
1 files changed, 10 insertions, 3 deletions
diff --git a/henrietta-cache.scm b/henrietta-cache.scm index 2f1c7cf..3a67189 100644 --- a/henrietta-cache.scm +++ b/henrietta-cache.scm @@ -1,4 +1,4 @@ -(use utils posix http-client matchable uri-common) +(use utils posix http-client matchable uri-common srfi-1) (define (usage code) (print #<#EOF @@ -128,8 +128,15 @@ EOF (let ((lines (call-with-input-request uri #f read-lines))) (when (null? lines) (error "Empty files-list file" uri)) - (download-files-from-list (uri-reference (car lines)) - (cdr lines) cache-dir)) + (let* ((original-uri (uri-reference (car lines))) + (path (uri-path original-uri)) + ;; Ensure base URI is seen as a directory so relative refs + ;; are always appended + (base-uri (update-uri original-uri + path: (if (string=? "" (last path)) + path + `(,@path ""))))) + (download-files-from-list base-uri (cdr lines) cache-dir))) (e (exn http) (error (sprintf "Could not download files-list \"~A\" -- ~A\n" uri (get-condition-property e 'exn 'message)))))) |