diff --git a/pkgs/racket-test/tests/pkg/git-http-proxy.rkt b/pkgs/racket-test/tests/pkg/git-http-proxy.rkt new file mode 100644 index 0000000000..aa72124191 --- /dev/null +++ b/pkgs/racket-test/tests/pkg/git-http-proxy.rkt @@ -0,0 +1,82 @@ +#lang racket/base + +(provide serve-git-http-proxy!) + +(require net/base64 + net/uri-codec + net/url + racket/match + racket/port + racket/runtime-path + racket/string + racket/system + web-server/http + web-server/servlet-env) + +(define (url-path-string url) + (string-join (map path/param-path (url-path url)) + "/" #:before-first "/")) + +(define (url-query-string url) + (alist->form-urlencoded (url-query url))) + +(define (verify-authorization header-value) + ; strip #"Basic " off of the header value + (define encoded-value (subbytes header-value 6)) + (equal? (string-split (bytes->string/utf-8 (base64-decode encoded-value)) ":") + '("user" "password"))) + +(define (serve-git-http-proxy req) + ; check if the right Authorization header is provided + (define authorization (headers-assq* #"Authorization" (request-headers/raw req))) + (cond + [(and authorization (verify-authorization (header-value authorization))) + (parameterize ([current-environment-variables (environment-variables-copy + (current-environment-variables))]) + ; git-http-backend depends on these environment variables to find the git repo + (putenv "GIT_PROJECT_ROOT" (path->string (find-system-path 'temp-dir))) + (putenv "GIT_HTTP_EXPORT_ALL" "") + + ; set standard CGI environment variables + (environment-variables-set! (current-environment-variables) + #"REQUEST_METHOD" (request-method req)) + (putenv "PATH_INFO" (url-path-string (request-uri req))) + (putenv "QUERY_STRING" (url-query-string (request-uri req))) + + (let ([content-type (headers-assq* #"Content-Type" (request-headers/raw req))]) + (when content-type + (environment-variables-set! (current-environment-variables) + #"CONTENT_TYPE" (header-value content-type)))) + + ; run git-http-backend + (match-define (list git-response-port git-body-port _ _ _) + (process*/ports #f #f (current-error-port) + (find-executable-path "git") "http-backend")) + + ; pass POST body to git-http-backend + (when (request-post-data/raw req) + (write-bytes (request-post-data/raw req) git-body-port)) + (close-output-port git-body-port) + + ; convert CGI headers to ones the web server can understand + (define headers + (for/list ([line (in-lines git-response-port)] + #:break (zero? (string-length line))) + (apply header (map string->bytes/utf-8 (string-split line ": "))))) + + ; produce a response + (response 200 #"OK" (current-seconds) #f headers + (λ (out) + (copy-port git-response-port out) + (close-input-port git-response-port))))] + ; if authorization fails, return a WWW-Authenticate header + [else (response/full 401 #"Authorization Required" (current-seconds) + #"text/plain; charset=utf-8" + (list (header #"WWW-Authenticate" #"Basic")) + (list #"Repository not found."))])) + +(define (serve-git-http-proxy! #:port port) + (serve/servlet serve-git-http-proxy + #:port port + #:command-line? #t + #:servlet-regexp #rx"")) diff --git a/pkgs/racket-test/tests/pkg/test-pkgs/pkg-git/info.rkt b/pkgs/racket-test/tests/pkg/test-pkgs/pkg-git/info.rkt new file mode 100644 index 0000000000..17a457b55e --- /dev/null +++ b/pkgs/racket-test/tests/pkg/test-pkgs/pkg-git/info.rkt @@ -0,0 +1,3 @@ +#lang info + +(define collection 'multi) diff --git a/pkgs/racket-test/tests/pkg/tests-catalogs.rkt b/pkgs/racket-test/tests/pkg/tests-catalogs.rkt index 9de6dba7f9..4818224cf7 100644 --- a/pkgs/racket-test/tests/pkg/tests-catalogs.rkt +++ b/pkgs/racket-test/tests/pkg/tests-catalogs.rkt @@ -14,6 +14,7 @@ (initialize-catalogs) $ "raco pkg config --set catalogs http://localhost:9990" + $ "raco pkg config --set git-checkout-credentials user:password" $ "racket -l racket/base -l pkg/lib -e '(pkg-config-catalogs)'" =stdout> "'(\"http://localhost:9990\")\n" diff --git a/pkgs/racket-test/tests/pkg/tests-install.rkt b/pkgs/racket-test/tests/pkg/tests-install.rkt index c2cff03092..d49fe287c3 100644 --- a/pkgs/racket-test/tests/pkg/tests-install.rkt +++ b/pkgs/racket-test/tests/pkg/tests-install.rkt @@ -251,4 +251,14 @@ $ "racket -e '(require pkg/lib)' -e '(path->pkg (build-path (pkg-directory \"pkg-test1\") \"pkg-test2\"))'" =stdout> "\"pkg-test1\"\n" $ "raco pkg remove pkg-test2-snd pkg-test1" - $ "racket -e '(require pkg-test1)'" =exit> 1))))) + $ "racket -e '(require pkg-test1)'" =exit> 1)) + + (with-fake-root + (shelly-case + "git package that requires authentication" + $ "raco pkg config --set catalogs http://localhost:9990" + $ "raco pkg install pkg-git" =exit> 1 + $ "raco pkg config --set git-checkout-credentials user:bad-password" + $ "raco pkg install pkg-git" =exit> 1 + $ "raco pkg config --set git-checkout-credentials user:password" + $ "raco pkg install pkg-git"))))) diff --git a/pkgs/racket-test/tests/pkg/util.rkt b/pkgs/racket-test/tests/pkg/util.rkt index 4e20a99fe9..d06ff1c8b7 100644 --- a/pkgs/racket-test/tests/pkg/util.rkt +++ b/pkgs/racket-test/tests/pkg/util.rkt @@ -10,8 +10,10 @@ racket/list racket/format racket/port + racket/string setup/dirs - "shelly.rkt") + "shelly.rkt" + "git-http-proxy.rkt") (define-runtime-path test-source-directory ".") @@ -167,8 +169,11 @@ (with-thread (λ () (start-pkg-server *index-ht-2* 9991)) (λ () - (with-thread (λ () (start-file-server)) - t)))))])) + (with-thread + (λ () (start-file-server)) + (λ () + (with-thread (λ () (serve-git-http-proxy! #:port 9996)) + t)))))))])) (define-syntax-rule (with-servers e ...) (with-servers* (λ () e ...))) @@ -246,7 +251,28 @@ 'source "http://localhost:9997/pkg-test2.zip" 'dependencies - '("pkg-test1")))) + '("pkg-test1"))) + + (initialize-catalogs/git)) + +(define (initialize-catalogs/git) + (define pkg-git.git (make-temporary-file "pkg-git-~a.git")) + (delete-file pkg-git.git) + (parameterize ([current-directory (build-path test-source-directory "test-pkgs")]) + (copy-directory/files (build-path test-source-directory "test-pkgs" "pkg-git") pkg-git.git)) + (define checksum + (parameterize ([current-directory pkg-git.git]) + (system "git init") + (system "git add -A") + (system "git commit -m 'initial commit'") + (string-trim + (with-output-to-string + (λ () (system "git rev-parse HEAD")))))) + + (match-define-values [_ pkg-git.git-filename _] (split-path pkg-git.git)) + (hash-set! *index-ht-1* "pkg-git" + (hasheq 'checksum checksum + 'source (~a "http://localhost:9996/" (path->string pkg-git.git-filename))))) (define (set-file path content) (make-parent-directory* path)