Add test for raco pkg install for authenticated git packages

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""))

pkgs/racket-test/tests/pkg/test-pkgs/pkg-git/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define collection 'multi)

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"

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")))))

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))
+           (with-thread
-                        t)))))]))
+            (λ () (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)