diff options
| -rw-r--r-- | pseudo-meta-egg-info.meta | 10 | ||||
| -rw-r--r-- | pseudo-meta-egg-info.release-info | 2 | ||||
| -rw-r--r-- | pseudo-meta-egg-info.scm | 63 | ||||
| -rw-r--r-- | pseudo-meta-egg-info.setup | 3 |
4 files changed, 78 insertions, 0 deletions
diff --git a/pseudo-meta-egg-info.meta b/pseudo-meta-egg-info.meta new file mode 100644 index 0000000..8056a48 --- /dev/null +++ b/pseudo-meta-egg-info.meta @@ -0,0 +1,10 @@ +;;;; pseudo-meta-egg-info.meta -*- Scheme -*- + +((synopsis "Provide automatically generated release-info and a pseudo-\"meta\"-file for eggs in svn") + (category egg-tools) + (doc-from-wiki) + (author "Peter Bex") + (depends spiffy uri-common svn-client) + (license "BSD") + (files "pseudo-meta-egg-info.meta" "pseudo-meta-egg-info.release-info" + "pseudo-meta-egg-info.scm" "pseudo-meta-egg-info.setup")) diff --git a/pseudo-meta-egg-info.release-info b/pseudo-meta-egg-info.release-info new file mode 100644 index 0000000..2a84311 --- /dev/null +++ b/pseudo-meta-egg-info.release-info @@ -0,0 +1,2 @@ +(repo hg "https://bitbucket.org/sjamaan/{egg-name}") +(uri targz "https://bitbucket.org/sjamaan/{egg-name}/get/{egg-release}.tar.gz") diff --git a/pseudo-meta-egg-info.scm b/pseudo-meta-egg-info.scm new file mode 100644 index 0000000..f104e47 --- /dev/null +++ b/pseudo-meta-egg-info.scm @@ -0,0 +1,63 @@ +(module pseudo-meta-egg-info + (egg-repo release-info files-list) + +(import chicken scheme) +(use extras data-structures spiffy intarweb uri-common svn-client) + +(define egg-repo + (make-parameter "http://anonymous:@code.call-cc.org/svn/chicken-eggs/release/4/")) + +(define (release-info continue) + (or (and-let* ((params (uri-query (request-uri (current-request)))) + (port (response-port (current-response))) + (egg-name (alist-ref 'egg params)) + (tag-dir (update-uri (uri-reference "") + path: (list egg-name "tags"))) + (repo-uri (uri-reference (egg-repo))) + (tags-uri (update-uri (uri-relative-to tag-dir repo-uri) + username: #f password: #f))) + (or (and-let* ((releases (svn-ls (uri->string tags-uri (constantly "")) '() + (uri-username repo-uri) + (uri-password repo-uri))) + (files-list-uri (conc (uri->string + (uri-relative-to + (uri-reference "files-list") + (request-uri (current-request)))) + ;; template, so don't make this a query + "?egg={egg-name};release={egg-release}"))) + (with-headers '((content-type "text/plain")) + (lambda () + (write-logged-response) + (write `(uri files-list ,files-list-uri) port) + (newline port) + (for-each (lambda (r) + (write `(release ,(car r)) port) + (newline port)) + releases) + (close-output-port port)))) + (send-status 500 (sprintf "Egg \"~A\" doesn't exist" egg-name)))) + (send-status 500 "No egg name given"))) + +(define (files-list continue) + (or (and-let* ((params (uri-query (request-uri (current-request)))) + (port (response-port (current-response))) + (egg-name (alist-ref 'egg params)) + (egg-release (alist-ref 'release params)) + (files-dir (update-uri (uri-reference "") + path: (list egg-name "tags" egg-release))) + (repo-uri (uri-reference (egg-repo))) + (files-uri (update-uri (uri-relative-to files-dir repo-uri) + username: #f password: #f))) + (or (and-let* ((files (svn-ls (uri->string files-uri) '() ;; Needs recursion! + (uri-username repo-uri) + (uri-password repo-uri)))) + (with-headers '((content-type "text/plain")) + (lambda () + (write-logged-response) + (for-each (lambda (f) (display (car f) port) (newline port)) files) + (close-output-port port)))) + (send-status 500 + (sprintf "Release \"~A\" for egg \"~A\" doesn't exist" + egg-release egg-name)))) + (send-status 500 "No egg name or release given"))) +)
\ No newline at end of file diff --git a/pseudo-meta-egg-info.setup b/pseudo-meta-egg-info.setup new file mode 100644 index 0000000..d5282fa --- /dev/null +++ b/pseudo-meta-egg-info.setup @@ -0,0 +1,3 @@ +;;;; pseudo-meta-egg-info.setup -*- Scheme -*- + +(standard-extension "pseudo-meta-egg-info" 0.1) |