diff options
Diffstat (limited to 'pseudo-meta-egg-info.scm')
| -rw-r--r-- | pseudo-meta-egg-info.scm | 38 |
1 files changed, 30 insertions, 8 deletions
diff --git a/pseudo-meta-egg-info.scm b/pseudo-meta-egg-info.scm index d1ff8d8..3dd406a 100644 --- a/pseudo-meta-egg-info.scm +++ b/pseudo-meta-egg-info.scm @@ -10,23 +10,39 @@ (import chicken scheme) (use extras data-structures spiffy intarweb uri-common svn-client) +(define *default-chicken-release* "4") + (define egg-repo - (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/4/")) + (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/{chicken-release}/")) + +;; This works on raw URI strings, not URI objects (for now?) +(define (replace-uri-patterns uri patterns) + (string-translate* uri (map (lambda (pattern) + (cons (conc "{" (car pattern) "}") + (uri-encode-string (->string (cdr pattern))))) + patterns))) (define (release-info continue) (or (and-let* ((params (uri-query (request-uri (current-request)))) (port (response-port (current-response))) + (chicken-release (string->number + (alist-ref 'release params eq? + *default-chicken-release*))) (egg-name (alist-ref 'egg params)) ((not (string=? egg-name ""))) (tag-dir (update-uri (uri-reference "") path: (list egg-name "tags"))) - (repo-uri (uri-reference (egg-repo))) + (uri-string (replace-uri-patterns + (egg-repo) + `((chicken-release . ,chicken-release)))) + (repo-uri (uri-reference uri-string)) (tags-uri (update-uri (uri-relative-to tag-dir repo-uri) username: #f password: #f))) - (or (and-let* ((releases (svn-client-list (uri->string tags-uri (constantly "")) - svn-opt-revision-head 2 - (uri-username repo-uri) - (uri-password repo-uri))) + (or (and-let* ((egg-releases + (svn-client-list (uri->string tags-uri (constantly "")) + svn-opt-revision-head 2 + (uri-username repo-uri) + (uri-password repo-uri))) (files-list-uri (conc (uri->string (uri-relative-to (uri-reference "files-list") @@ -43,7 +59,7 @@ (not (string=? (svn-file-path r) ""))) (write `(release ,(svn-file-path r)) port) (newline port))) - releases) + egg-releases) (close-output-port port)))) (send-status 404 (sprintf "Egg \"~A\" doesn't exist or has no tags dir" egg-name)))) (send-status 400 "No egg name given"))) @@ -51,13 +67,19 @@ (define (files-list continue) (or (and-let* ((params (uri-query (request-uri (current-request)))) (port (response-port (current-response))) + (chicken-release (string->number + (alist-ref 'release params eq? + *default-chicken-release*))) (egg-name (alist-ref 'egg params)) ((not (string=? egg-name ""))) (egg-release (alist-ref 'release params)) ((not (string=? egg-release ""))) (files-dir (update-uri (uri-reference "") path: (list egg-name "tags" egg-release))) - (repo-uri (uri-reference (egg-repo))) + (uri-string (replace-uri-patterns + (egg-repo) + `((chicken-release . ,chicken-release)))) + (repo-uri (uri-reference uri-string)) (files-uri (update-uri (uri-relative-to files-dir repo-uri)))) (or (and-let* ((files (svn-client-list (uri->string files-uri (constantly "")) svn-opt-revision-head #t |