diff options
| -rw-r--r-- | README | 13 | ||||
| -rw-r--r-- | pseudo-meta-egg-info.scm | 38 |
2 files changed, 37 insertions, 14 deletions
@@ -24,8 +24,9 @@ You can use it like this: (use spiffy spiffy-uri-match pseudo-meta-egg-info) ;; Trailing slash is mandatory here! -;; By default this uses the Chicken repo -(egg-repo "http://example.com/your-egg-repo/eggs/release/4/") +;; The {chicken-release} placeholder gets replaced by the major CHICKEN version. +;; By default this uses the Chicken repo. +(egg-repo "http://example.com/your-egg-repo/eggs/release/{chicken-release}/") (vhost-map `((".*" . ,(uri-match/spiffy @@ -34,8 +35,8 @@ You can use it like this: (start-server) -This makes the release-info for egg MY-EGG available under -http://localhost:8080/release-info?egg=MY-EGG +This makes the release-info for the CHICKEN 4 version of egg MY-EGG, available under +http://localhost:8080/release-info?egg=MY-EGG;release=4 -and the files-list for release 1.0 under -http://localhost:8080/files-list?egg=MY-EGG;release=1.0 +and the files-list for release 1.0 for the CHICKEN 5 version of MY-EGG under +http://localhost:8080/files-list?egg=MY-EGG;release=1.0;release=5 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 |