package system: change syntax of a GitHub package source to "git://..."

Besides changing the URL scheme, the tag or branch is optional and
specified as a fragment (inspired by npm). Also, any subpath is expressed
as a "path=..." query (which similarly avoids giving a different meaning
to URLs than `git' itself would). The repository name can have a ".git"
suffix.

The "github://..." format is still supported for compatibility, but
`--type github' adds "git://..." instead of "github://..." if
neither is already present (which is incompatible, since branches
and tags are handled differently for the two forms).

Closes PR 13656

(See the PR for a discussion and my rationale for this choice.)

pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl

@@ -370,10 +370,10 @@ on GitHub, then
 repository for your package}. After that, your @tech{package source}
 is:
 
-@inset{@exec{github://github.com/@nonterm{user}/@nonterm{package}/@nonterm{branch}}}
+@inset{@exec{git://github.com/@nonterm{user}/@nonterm{package}}}
 
-Typically, @nonterm{branch} will be @exec{master}, but you may wish to use
+If you want the package to be @nonterm{branch} instead of @exec{master},
-different branches for releases and development.
+then add @filepath{#@nonterm{branch}} to the end of the package source.
 
 Whenever you
 

pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl

@@ -187,25 +187,33 @@ is the directory name.}
 @item{a remote URL naming a GitHub repository -- The format for such
 URLs is:
 
-@inset{@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@;
+@inset{@exec{git://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@;
-@exec{/}@nonterm{branch-or-tag}@exec{/}@nonterm{subpath}}
+@optional{@exec{.git}}@optional{@exec{/}}@optional{@exec{?path=}@nonterm{path}}@;
+@optional{@exec{#}@nonterm{tag}}}
 
-where @nonterm{subpath} is optional and can contain multiple
+where @nonterm{path} can contain multiple @litchar{/}-separated
-@litchar{/}-separated elements.
+elements to form a path within the repository, and defaults to the
+empty path. The @nonterm{tag} can be a branch or tag, and it
+defaults to @exec{master}.
 
-For example, @filepath{github://github.com/game/tic-tac-toe/master/}
+For example, @filepath{git://github.com/game/tic-tac-toe#master}
 is a GitHub package source.
 
+For backward compatibility, an older format is also supported:
+
+@inset{@exec{github://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@;
+@exec{/}@nonterm{tag}@optional{@exec{/}@nonterm{path}}}
+
 The @exec{zip}-formatted archive for the repository (generated by
 GitHub for every branch and tag) is used as a remote URL archive path,
 except the @tech{checksum} is the hash identifying the branch (or
 tag).
 
 A package source is inferred to be a GitHub reference when it
-starts with @litchar{github://}; a package source that is otherwise
+starts with @litchar{git://} or @litchar{github://}; a package source that is otherwise
 specified as a GitHub reference is automatically prefixed with
-@filepath{github://github.com/}. The inferred package name
+@filepath{git://github.com/}. The inferred package name
-is the last element of @nonterm{subpath} if it is
+is the last element of @nonterm{path} if it is
 non-empty, otherwise the inferred name is @nonterm{repo}.}
 
 @item{a @tech{package name} -- A @tech{package catalog} is

pkgs/racket-pkgs/racket-test/tests/pkg/tests-db.rkt

@@ -37,10 +37,10 @@
                   (list
                    (pkg "p1" "http://a" "" "" "" "")))
     
-    (set-pkg! "p1" "http://a" "github:a" "adam" "123" "the first package")
+    (set-pkg! "p1" "http://a" "adam" "git:a" "123" "the first package")
     (check-equal? (get-pkgs)
                   (list
-                   (pkg "p1" "http://a" "github:a" "adam" "123" "the first package")
+                   (pkg "p1" "http://a" "adam" "git:a" "123" "the first package")
                    (pkg "p2" "http://b" "" "" "" "")))
 
     ;; reverse order of catalogs:
@@ -50,7 +50,7 @@
     (check-equal? (get-pkgs)
                   (list
                    (pkg "p2" "http://b" "" "" "" "")
-                   (pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))
+                   (pkg "p1" "http://a" "adam" "git:a" "123" "the first package")))
 
     (check-equal? (get-pkg-tags "p2" "http://b")
                   '())
@@ -97,6 +97,6 @@
 
     (check-equal? (get-pkgs) 
                   (list
-                   (pkg "p1" "http://a" "github:a" "adam" "123" "the first package")))
+                   (pkg "p1" "http://a" "adam" "git:a" "123" "the first package")))
 
     (delete-file (current-pkg-catalog-file)))

pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt

@@ -91,10 +91,24 @@
   (check-equal-values? (parse "github://github.com/fish/master" 'github #rx"three") (values #f 'github #f))
   (check-equal-values? (parse "github://github.com/racket/fish.more/release" 'github) (values #f 'github #t))
 
-  (check-equal-values? (parse "racket/fish/master" 'github) (values "fish" 'github #t))
+  (check-equal-values? (parse "git://not-github.com/racket/fish" #f #rx"github.com") (values #f 'github #f))
-  (check-equal-values? (parse "racket/fish/master/" 'github) (values "fish" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish" #f) (values "fish" 'github #t))
-  (check-equal-values? (parse "racket/fish" 'github #rx"three") (values #f 'github #f))
+  (check-equal-values? (parse "git://github.com/racket/fish/" #f) (values "fish" 'github #t))
-  (check-equal-values? (parse "fish" 'github #rx"three") (values #f 'github #f))
+  (check-equal-values? (parse "git://github.com/racket/fish.git" #f) (values "fish" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish.git/" #f) (values "fish" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish.rkt" #f) (values #f 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish#release" #f) (values "fish" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish?path=catfish#release" #f) (values "catfish" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish?path=catfish/" #f) (values "catfish" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish?path=catfish/bill" #f) (values "bill" 'github #t))
+  (check-equal-values? (parse "git://github.com/racket/fish/master" 'github #rx"two") (values #f 'github #f))
+  (check-equal-values? (parse "git://github.com/racket/fish.more" 'github) (values #f 'github #t))
+
+  (check-equal-values? (parse "racket/fish" 'github) (values "fish" 'github #t))
+  (check-equal-values? (parse "racket/fish.git" 'github) (values "fish" 'github #t))
+  (check-equal-values? (parse "racket/fish/" 'github) (values "fish" 'github #t))
+  (check-equal-values? (parse "racket/fish/x" 'github #rx"two") (values #f 'github #f))
+  (check-equal-values? (parse "fish" 'github #rx"two") (values #f 'github #f))
 
   (check-equal-values? (parse "file://fish.plt" #f) (values "fish" 'file #t))
   (check-equal-values? (parse "file:///root/fish.plt" #f) (values "fish" 'file #t))

pkgs/racket-pkgs/racket-test/tests/pkg/tests-network.rkt

@@ -16,17 +16,17 @@
 (pkg-tests
  (shelly-begin
   (shelly-install "remote/github"
-                  "github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1")
+                  "git://github.com/jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1")
   (shelly-install "remote/github with slash"
-                  "github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/")
+                  "git://github.com/jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1/")
   (shelly-install "remote/github with auto prefix"
-                  "--type github jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/")
+                  "--type github jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1/")
 
   (hash-set! *index-ht-1* "planet2-test1-github-different-checksum"
              (hasheq 'checksum
                      "23eeaee731e72a39bddbacdf1ed6cce3bcf423a5"
                      'source
-                     "github://github.com/jeapostrophe/galaxy/master/tests/planet2/test-pkgs/planet2-test1/"))
+                     "git://github.com/jeapostrophe/galaxy?path=tests/planet2/test-pkgs/planet2-test1/"))
 
   (with-fake-root
     (shelly-case

racket/collects/pkg/lib.rkt

@@ -838,9 +838,9 @@
                pkg))
   (cond
    [(and (eq? type 'github)
-         (not (regexp-match? #rx"^github://" pkg)))
+         (not (regexp-match? #rx"^git(?:hub)?://" pkg)))
-    ;; Add "github://github.com/"
+    ;; Add "git://github.com/"
-    (stage-package/info (string-append "github://github.com/" pkg) type 
+    (stage-package/info (string-append "git://github.com/" pkg) type 
                         pkg-name 
                         #:given-checksum given-checksum
                         check-sums? download-printf

racket/collects/pkg/name.rkt

@@ -107,15 +107,15 @@
     (validate-name s complain #f)
     (values (and (regexp-match? rx:package-name s) s) 'name)]
    [(and (eq? type 'github)
-         (not (regexp-match? #rx"^github://" s)))
+         (not (regexp-match? #rx"^git(?:hub)?://" s)))
     (package-source->name+type 
-     (string-append "github://github.com/" s)
+     (string-append "git://github.com/" s)
      'github)]
    [(if type
         (or (eq? type 'github)
             (eq? type 'file-url)
             (eq? type 'dir-url))
-        (regexp-match? #rx"^(https?|github)://" s))
+        (regexp-match? #rx"^(https?|github|git)://" s))
     (define url (with-handlers ([exn:fail? (lambda (exn) #f)])
                   (string->url s)))
     (define-values (name name-type)
@@ -124,25 +124,40 @@
             (cond
              [(if type
                   (eq? type 'github)
-                  (equal? (url-scheme url) "github"))
+                  (or (equal? (url-scheme url) "github")
-              (unless (equal? (url-scheme url) "github")
+                      (equal? (url-scheme url) "git")))
-                (complain "URL scheme is not 'github'"))
+              (unless (or (equal? (url-scheme url) "github")
+                          (equal? (url-scheme url) "git"))
+                (complain "URL scheme is not 'git' or 'github'"))
               (define name
                 (and (cor (pair? p)
                           (complain "URL path is empty"))
                      (cor (equal? "github.com" (url-host url))
                           (complain "URL host is not 'github.com'"))
-                     (let ([p (if (equal? "" (path/param-path (last p)))
+                     (if (equal? (url-scheme url) "git")
-                                  (reverse (cdr (reverse p)))
+                         ;; git://
-                                  p)])
+                         (and (cor (or (= (length p) 2)
-                       (and (cor ((length p) . >= . 3)
+                                       (and (= (length p) 3)
-                                 (complain "URL does not have at least three path elements"))
+                                            (equal? "" (path/param-path (caddr p)))))
-                            (validate-name
+                                   (complain "URL does not have two path elements (name and repo)"))
-                             (if (= (length p) 3)
+                              (let ([a (assoc 'path (url-query url))])
-                                 (path/param-path (second (reverse p)))
+                                (define sub (and a (cdr a) (string-split (cdr a) "/")))
-                                 (last-non-empty p))
+                                (if (pair? sub)
-                             complain-name
+                                    (validate-name (last sub) complain-name #t)
-                             #t)))))
+                                    (let ([s (path/param-path (cadr p))])
+                                      (validate-name (regexp-replace #rx"[.]git$" s "") complain-name #t)))))
+                         ;; github://
+                         (let ([p (if (equal? "" (path/param-path (last p)))
+                                      (reverse (cdr (reverse p)))
+                                      p)])
+                           (and (cor ((length p) . >= . 3)
+                                     (complain "URL does not have at least three path elements"))
+                                (validate-name
+                                 (if (= (length p) 3)
+                                     (path/param-path (second (reverse p)))
+                                     (last-non-empty p))
+                                 complain-name
+                                 #t))))))
               (values name (or type 'github))]
              [(if type
                   (eq? type 'file-url)

racket/collects/pkg/util.rkt

@@ -53,7 +53,17 @@
 (define github-client_secret (make-parameter #f))
 
 (define (split-github-url pkg-url)
-  (map path/param-path (url-path/no-slash pkg-url)))
+  (if (equal? (url-scheme pkg-url) "github")
+      ;; github://
+      (map path/param-path (url-path/no-slash pkg-url))
+      ;; git://
+      (let* ([paths (map path/param-path (url-path/no-slash pkg-url))])
+        (list* (car paths)
+               (regexp-replace* #rx"[.]git$" (cadr paths) "")
+               (or (url-fragment pkg-url) "master")
+               (let ([a (assoc 'path (url-query pkg-url))])
+                 (or (and a (cdr a) (string-split (cdr a) "/"))
+                     null))))))
 
 (define (package-url->checksum pkg-url-str [query empty]
                                #:download-printf [download-printf void]
@@ -61,7 +71,7 @@
   (define pkg-url
     (string->url pkg-url-str))
   (match (url-scheme pkg-url)
-    ["github"
+    [(or "github" "git")
      (match-define (list* user repo branch path)
                    (split-github-url pkg-url))
      (define api-u