From e1efd2d98f8c581eb056aa40bb62ba86869cb1b6 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 22 Aug 2013 08:41:02 -0600 Subject: [PATCH] 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.) --- .../pkg/scribblings/getting-started.scrbl | 6 +-- .../racket-doc/pkg/scribblings/pkg.scrbl | 24 ++++++--- .../racket-test/tests/pkg/tests-db.rkt | 8 +-- .../racket-test/tests/pkg/tests-name.rkt | 22 +++++++-- .../racket-test/tests/pkg/tests-network.rkt | 8 +-- racket/collects/pkg/lib.rkt | 6 +-- racket/collects/pkg/name.rkt | 49 ++++++++++++------- racket/collects/pkg/util.rkt | 14 +++++- 8 files changed, 92 insertions(+), 45 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl index ba30c80d42..27e341b6e3 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/getting-started.scrbl +++ b/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 -different branches for releases and development. +If you want the package to be @nonterm{branch} instead of @exec{master}, +then add @filepath{#@nonterm{branch}} to the end of the package source. Whenever you diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 6618cb3932..2681199e71 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/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}@; -@exec{/}@nonterm{branch-or-tag}@exec{/}@nonterm{subpath}} +@inset{@exec{git://github.com/}@nonterm{user}@exec{/}@nonterm{repo}@; +@optional{@exec{.git}}@optional{@exec{/}}@optional{@exec{?path=}@nonterm{path}}@; +@optional{@exec{#}@nonterm{tag}}} -where @nonterm{subpath} is optional and can contain multiple -@litchar{/}-separated elements. +where @nonterm{path} can contain multiple @litchar{/}-separated +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 -is the last element of @nonterm{subpath} if it is +@filepath{git://github.com/}. The inferred package name +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 diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-db.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-db.rkt index fa2362cd3a..e28d06438e 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-db.rkt +++ b/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))) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt index 7410b77827..e8c2f73744 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-name.rkt +++ b/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 "racket/fish/master/" 'github) (values "fish" 'github #t)) - (check-equal-values? (parse "racket/fish" 'github #rx"three") (values #f 'github #f)) - (check-equal-values? (parse "fish" 'github #rx"three") (values #f 'github #f)) + (check-equal-values? (parse "git://not-github.com/racket/fish" #f #rx"github.com") (values #f 'github #f)) + (check-equal-values? (parse "git://github.com/racket/fish" #f) (values "fish" 'github #t)) + (check-equal-values? (parse "git://github.com/racket/fish/" #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.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)) diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-network.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-network.rkt index 538204c351..c203b7446a 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-network.rkt +++ b/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 diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 0d1561634b..ae0521245e 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -838,9 +838,9 @@ pkg)) (cond [(and (eq? type 'github) - (not (regexp-match? #rx"^github://" pkg))) - ;; Add "github://github.com/" - (stage-package/info (string-append "github://github.com/" pkg) type + (not (regexp-match? #rx"^git(?:hub)?://" pkg))) + ;; Add "git://github.com/" + (stage-package/info (string-append "git://github.com/" pkg) type pkg-name #:given-checksum given-checksum check-sums? download-printf diff --git a/racket/collects/pkg/name.rkt b/racket/collects/pkg/name.rkt index 0ab4ef4fef..08509bd3aa 100644 --- a/racket/collects/pkg/name.rkt +++ b/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")) - (unless (equal? (url-scheme url) "github") - (complain "URL scheme is not 'github'")) + (or (equal? (url-scheme url) "github") + (equal? (url-scheme url) "git"))) + (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))) - (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))))) + (if (equal? (url-scheme url) "git") + ;; git:// + (and (cor (or (= (length p) 2) + (and (= (length p) 3) + (equal? "" (path/param-path (caddr p))))) + (complain "URL does not have two path elements (name and repo)")) + (let ([a (assoc 'path (url-query url))]) + (define sub (and a (cdr a) (string-split (cdr a) "/"))) + (if (pair? sub) + (validate-name (last sub) complain-name #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) diff --git a/racket/collects/pkg/util.rkt b/racket/collects/pkg/util.rkt index f43907c7d1..6f594d1a76 100644 --- a/racket/collects/pkg/util.rkt +++ b/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