diff --git a/pkgs/distro-build-pkgs/distro-build-server/pack-built.rkt b/pkgs/distro-build-pkgs/distro-build-server/pack-built.rkt index 8cfa45b..6b458b4 100644 --- a/pkgs/distro-build-pkgs/distro-build-server/pack-built.rkt +++ b/pkgs/distro-build-pkgs/distro-build-server/pack-built.rkt @@ -5,6 +5,7 @@ net/url racket/set racket/file + racket/path openssl/sha1 racket/cmdline) @@ -23,7 +24,8 @@ (define dest-dir (build-path build-dir (~a create-mode))) (define native-dir (build-path build-dir "native" "pkgs")) (define pkg-dest-dir (path->complete-path (build-path dest-dir "pkgs"))) -(define catalog-dir (build-path dest-dir "catalog" "pkg")) +(define catalog-dir (build-path dest-dir "catalog")) +(define catalog-pkg-dir (build-path catalog-dir "pkg")) (make-directory* pkg-dest-dir) (make-directory* catalog-dir) @@ -36,10 +38,12 @@ #:dest pkg-dest-dir #:mode create-mode) (call-with-output-file* - (build-path catalog-dir pkg) + (build-path catalog-pkg-dir pkg) #:exists 'truncate (lambda (o) - (write (hash 'source (path->string dest-zip) + (write (hash 'source (path->string (find-relative-path + (simple-form-path catalog-dir) + (simple-form-path dest-zip))) 'checksum (call-with-input-file* dest-zip sha1) 'name pkg 'author "plt@racket-lang.org" diff --git a/pkgs/distro-build-pkgs/distro-build-server/serve-catalog.rkt b/pkgs/distro-build-pkgs/distro-build-server/serve-catalog.rkt index 11ad01f..3e36907 100644 --- a/pkgs/distro-build-pkgs/distro-build-server/serve-catalog.rkt +++ b/pkgs/distro-build-pkgs/distro-build-server/serve-catalog.rkt @@ -47,37 +47,20 @@ (define dirs (list built-dir native-dir)) (define (pkg-name->info req name) - (define (extract-host-header sel) - (for/or ([h (in-list (request-headers/raw req))]) - (and (equal? (header-field h) #"Host") - (let ([m (regexp-match #rx#"^(.*):([0-9]+)$" - (header-value h))]) - (and m - (sel (list (bytes->string/utf-8 (cadr m)) - (string->number (bytes->string/utf-8 (caddr m)))))))))) (for/or ([d (in-list dirs)]) (define f (build-path d "catalog" "pkg" name)) (and (file-exists? f) - (let ([h (call-with-input-file* + ;; Change leading "../" to "./" in source, because + ;; we've shifted "pkg" relative to the site root + ;; by skipping over "catalog" in the URL. + (let ([ht (call-with-input-file* f read)]) - (define s (hash-ref h 'source)) - (hash-set h + (hash-set ht 'source - (url->string - (url "http" - #f - (or (extract-host-header car) - (let ([h (request-host-ip req)]) - (if (equal? h "::1") - "localhost" - h))) - (or (extract-host-header cadr) - (request-host-port req)) - #t - (list (path/param (~a name ".zip") null)) - null - #f))))))) + (regexp-replace #rx"^[.][.]/" + (hash-ref ht 'source) + "./")))))) (define (response/sexpr v) (response 200 #"Okay" (current-seconds) @@ -160,8 +143,9 @@ (append (list (build-path build-dir "origin")) (list readmes-dir) + ;; for "pkgs" directories: (for/list ([d (in-list dirs)]) - (path->complete-path (build-path d "pkgs"))) + (path->complete-path d)) ;; for ".git": (list (current-directory))) #:servlet-regexp #rx""