raco pkg: add support for "git+http[s]://" package sources
When referring to a Git repo with a "https://" URL, the URL must end with ".git" to distinguish the URL for directory and file URLs. A "git+https://" URL specifies that the Git-over-HTTP protocol should be where the URL cannot contain ".git". For example, SourceHut URLs do not include ".git" (while hosting services like GitHub or BitBucket allow ".git" to be in the URL). When using `raco pkg`, it was possible to specify `--type git` for an "https://" reference, but for consistency and internal tracking, a ".git" would be added to the URL, anyway. Using `--type git-url` can similarly force the interpretation of an "https://" reference without triggering the addition of ".git". The new state is mostly internal, but it is reflected in the output of `raco pkg show`, which shows `git` for such references (as opposed to `url` as shown for others).
This commit is contained in:
Matthew Flatt
parent
45ecb8a99d
commit
2606ae3d8e
|
|
@ -45,7 +45,10 @@ link, the Racket package manager keeps track of the repository
|
|||
connection. The @nonterm{git-pkg-source} must be a Git or GitHub
|
||||
package source, or it must be a package name that the catalog maps to
|
||||
a Git or GitHub package source; if the source URL includes a fragment,
|
||||
it must name a branch or tag (as opposed to a raw commit).
|
||||
it must name a branch or tag (as opposed to a raw commit). If
|
||||
@nonterm{git-pkg-source} refers to a repository over HTTPS but has
|
||||
no @litchar{.git} suffix, use @litchar{git+https://} to refer to the
|
||||
repository.
|
||||
|
||||
When the repository at @nonterm{git-pkg-source} is changed so that the
|
||||
source has a new checksum, then @command-ref{update} for the package pulls
|
||||
|
|
|
|||
|
|
@ -160,7 +160,7 @@ scope}.}
|
|||
@defproc[(pkg-desc? [v any/c]) boolean?]
|
||||
@defproc[(pkg-desc [source string?]
|
||||
[type (or/c #f 'name 'file 'dir 'link 'static-link
|
||||
'file-url 'dir-url 'git 'github 'clone)]
|
||||
'file-url 'dir-url 'git 'git-url 'github 'clone)]
|
||||
[name (or/c string? #f)]
|
||||
[checksum (or/c string? #f)]
|
||||
[auto? boolean?]
|
||||
|
|
@ -179,7 +179,8 @@ directory containing the repository clone (where the repository itself
|
|||
is a directory within @racket[path]).
|
||||
|
||||
@history[#:changed "6.1.1.1" @elem{Added @racket['git] as a @racket[type].}
|
||||
#:changed "6.1.1.5" @elem{Added @racket['clone] as a @racket[type].}]}
|
||||
#:changed "6.1.1.5" @elem{Added @racket['clone] as a @racket[type].}
|
||||
#:changed "8.0.0.13" @elem{Added @racket['git-url] as a @racket[type].}]}
|
||||
|
||||
|
||||
@defproc[(pkg-stage [desc pkg-desc?]
|
||||
|
|
|
|||
|
|
@ -14,18 +14,20 @@ extracting a package name.}
|
|||
@defproc[(package-source-format? [v any/c]) boolean?]{
|
||||
|
||||
Returns @racket[#t] if @racket[v] is @racket['name] , @racket['file],
|
||||
@racket['dir], @racket['git], @racket['github], @racket['clone], @racket['file-url],
|
||||
@racket['dir], @racket['git], @racket['git-url],
|
||||
@racket['github], @racket['clone], @racket['file-url],
|
||||
@racket['dir-url], @racket['link], or @racket['static-link], and
|
||||
returns @racket[#f] otherwise.
|
||||
|
||||
The @racket['link] and @racket['static-link] formats are the same as
|
||||
@racket['dir] in terms of parsing, but they are treated differently
|
||||
for tasks such as package installation. The @racket['clone] format
|
||||
is similarly the same as @racket['github] or @racket['git] in terms of
|
||||
parsing.
|
||||
for tasks such as package installation. The @racket['clone] and
|
||||
@racket['git-url] formats are similarly the same as
|
||||
@racket['github] or @racket['git] in terms of parsing.
|
||||
|
||||
@history[#:changed "6.1.1.1" @elem{Added @racket['git].}
|
||||
#:changed "6.1.1.5" @elem{Added @racket['clone].}]}
|
||||
#:changed "6.1.1.5" @elem{Added @racket['clone].}
|
||||
#:changed "8.0.0.13" @elem{Added @racket['git-url].}]}
|
||||
|
||||
|
||||
@defproc[(package-source->name [source string?]
|
||||
|
|
|
|||
|
|
@ -18,6 +18,7 @@ databases.}
|
|||
@defstruct*[pkg-info ([orig-pkg (or/c (list/c 'catalog string?)
|
||||
(list/c 'catalog string? string?)
|
||||
(list/c 'url string?)
|
||||
(list/c 'git string?)
|
||||
(list/c 'file string?)
|
||||
(list/c 'dir string?)
|
||||
(list/c 'link string?)
|
||||
|
|
@ -36,9 +37,16 @@ two-element @racket['catalog] form records a URL for a Git or GitHub
|
|||
package source when the catalog reported such a source, and the URL is
|
||||
used for operations that adjust @racket['clone]-form installations.
|
||||
|
||||
The @racket['git] form is used for URLs that start
|
||||
@litchar{git+https://} or @litchar{git+http://} or where the
|
||||
@racket['git-url] type was specified for parsing the URL. Other Git
|
||||
references (including ones that start @litchar{git://}) use
|
||||
@racket['url].
|
||||
|
||||
@history[#:changed "6.1.1.5" @elem{Added @racket['clone] and two-level
|
||||
@racket['catalog] variants for
|
||||
@racket[orig-pkg].}]}
|
||||
@racket[orig-pkg].}
|
||||
#:changed "8.0.0.13" @elem{Added @racket['git].}]}
|
||||
|
||||
|
||||
@defstruct*[(sc-pkg-info pkg-info) ()]{
|
||||
|
|
|
|||
|
|
@ -243,8 +243,9 @@ URLs is:
|
|||
@optional{@exec{.git}}@optional{@exec{/}}@optional{@exec{?path=}@nonterm{path}}@;
|
||||
@optional{@exec{#}@nonterm{rev}}}
|
||||
|
||||
where @nonterm{scheme} is @litchar{git}, @litchar{http}, or
|
||||
@litchar{https}, except when @nonterm{scheme} is @litchar{git} and
|
||||
where @nonterm{scheme} is @litchar{git}, @litchar{http},
|
||||
@litchar{https}, @litchar{git+http}, or @litchar{git+https},
|
||||
except when @nonterm{scheme} is @litchar{git} and
|
||||
@nonterm{host} is @litchar{github.com} (which is treated more specifically as a GitHub
|
||||
reference). The @nonterm{path} can contain multiple
|
||||
@litchar{/}-separated elements to form a path within the repository,
|
||||
|
|
@ -258,7 +259,7 @@ tag (even if it is written as a commit). In those cases, the content
|
|||
typically can be obtained without downloading irrelevant history.}
|
||||
|
||||
For example, @filepath{http://bitbucket.org/game/tic-tac-toe#main}
|
||||
is a Git package source.
|
||||
is a Git package source.
|
||||
|
||||
A checkout of the repository at @nonterm{rev} provides the content of
|
||||
the package, and @nonterm{scheme} determines the protocol
|
||||
|
|
@ -271,11 +272,17 @@ A package source is inferred to be a Git reference when it starts with
|
|||
source is also inferred to be a Git reference when it starts with
|
||||
@litchar{http://} or @litchar{https://} and the last non-empty path
|
||||
element ends in @litchar{.git}; a @litchar{.git} suffix is added if
|
||||
the source is otherwise specified to be a Git reference. The inferred
|
||||
package name is the last element of @nonterm{path} if it is non-empty,
|
||||
otherwise the inferred name is @nonterm{repo}.
|
||||
the source is otherwise specified to be a Git reference. Finally, a
|
||||
package source is inferred to be a Git reference when it starts with
|
||||
@litchar{git+https://} or @litchar{git+http://}, in which case no
|
||||
@litchar{.git} suffix in the path is needed to designate the source as
|
||||
a Git reference (and no @litchar{.git} suffix is implicitly added).
|
||||
The inferred package name is the last element of @nonterm{path} if it
|
||||
is non-empty, otherwise the inferred name is @nonterm{repo}.
|
||||
|
||||
@history[#:changed "6.1.1.1" @elem{Added Git repository support.}]}
|
||||
@history[#:changed "6.1.1.1" @elem{Added Git repository support.}
|
||||
#:changed "8.0.0.13" @elem{Added @litchar{git+https://}
|
||||
and @litchar{git+http://} support.}]}
|
||||
|
||||
@; ----------------------------------------
|
||||
@item{a remote URL naming a GitHub repository --- The format for such
|
||||
|
|
@ -453,8 +460,10 @@ sub-commands.
|
|||
@itemlist[
|
||||
|
||||
@item{@DFlag{type} @nonterm{type} or @Flag{t} @nonterm{type} --- Specifies an interpretation of the package source,
|
||||
where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{file-url}, @exec{dir-url}, @exec{git}, @exec{github},
|
||||
or @exec{name}. The type is normally inferred for each @nonterm{pkg-source}.}
|
||||
where @nonterm{type} is either @exec{file}, @exec{dir}, @exec{file-url}, @exec{dir-url}, @exec{git},
|
||||
@exec{git-url}, @exec{github}, or @exec{name}. The difference between @exec{git} and @exec{git-url}
|
||||
is that a @litchar{.git} suffix is added to a @litchar{http} or @litchar{https} URL for type @exec{git}, but
|
||||
not for type @exec{git-url}. The type is normally inferred for each @nonterm{pkg-source}.}
|
||||
|
||||
@item{@DFlag{name} @nonterm{pkg} or @Flag{n} @nonterm{pkg} --- Specifies the name of the package,
|
||||
which makes sense only when a single @nonterm{pkg-source} is provided. The name is normally
|
||||
|
|
@ -658,7 +667,8 @@ sub-commands.
|
|||
#:changed "6.4.0.14" @elem{Added the @DFlag{dry-run} flag.}
|
||||
#:changed "7.2.0.8" @elem{Added the @DFlag{recompile-only} flag.}
|
||||
#:changed "7.4.0.4" @elem{Added the @DFlag{no-docs}, @Flag{D} flags.}
|
||||
#:changed "7.6.0.14" @elem{Allowed multiple @DFlag{catalog} flags.}]}
|
||||
#:changed "7.6.0.14" @elem{Allowed multiple @DFlag{catalog} flags.}
|
||||
#:changed "8.0.0.13" @elem{Added @litchar{git-url} as a @DFlag{type} option.}]}
|
||||
|
||||
|
||||
@subcommand{@command/toc{update} @nonterm{option} ... @nonterm{pkg-source} ...
|
||||
|
|
|
|||
|
|
@ -143,6 +143,18 @@
|
|||
(check-equal-values? (parse "http://racket-lang.org/racket/fish.git?path=catfish" #f #f) (values "catfish" 'git #t))
|
||||
(check-equal-values? (parse "http://racket-lang.org/racket/.." 'git #rx"indicator") (values #f 'git #f))
|
||||
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish" 'git-url #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+https://racket-lang.org/racket/fish" 'git-url #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+https://racket-lang.org/racket/fish?path=catfish" 'git-url #f) (values "catfish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish.git" 'git-url #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish.git" #f #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+https://racket-lang.org/racket/fish.git" #f #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish.git/" 'git-url #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish.git/" #f #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish.git#release" #f #f) (values "fish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/fish.git?path=catfish" #f #f) (values "catfish" 'git-url #t))
|
||||
(check-equal-values? (parse "git+http://racket-lang.org/racket/.." 'git-url #rx"indicator") (values #f 'git-url #f))
|
||||
|
||||
(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))
|
||||
|
|
@ -169,6 +181,7 @@
|
|||
(check-equal-values? (parse "" 'file-url) (values #f 'file-url #f))
|
||||
(check-equal-values? (parse "" 'dir-url) (values #f 'dir-url #f))
|
||||
(check-equal-values? (parse "" 'git) (values #f 'git #f))
|
||||
(check-equal-values? (parse "" 'git-url) (values #f 'git-url #f))
|
||||
(check-equal-values? (parse "" 'github #rx"two path elements") (values #f 'github #f))
|
||||
|
||||
(void))
|
||||
|
|
|
|||
|
|
@ -55,7 +55,9 @@
|
|||
|
||||
(test-remote "git://github.com/racket/test-pkg-1")
|
||||
(test-remote "https://github.com/racket/test-pkg-1.git")
|
||||
(test-remote "git+https://github.com/racket/test-pkg-1")
|
||||
(test-remote "https://bitbucket.org/mflatt/pkg-test.git")
|
||||
(test-remote "git+https://bitbucket.org/mflatt/pkg-test")
|
||||
|
||||
(define (try-git-repo label type+repo)
|
||||
(define tmp-dir (make-temporary-file "~a-clone" 'directory))
|
||||
|
|
@ -76,6 +78,9 @@
|
|||
(try-git-repo
|
||||
"remote/git type"
|
||||
"--type git https://bitbucket.org/mflatt/pkg-test?path=pkg-test1#alt")
|
||||
(try-git-repo
|
||||
"remote/git-url type"
|
||||
"--type git-url https://bitbucket.org/mflatt/pkg-test?path=pkg-test1#alt")
|
||||
|
||||
(define (try-git-repo-using-default-branch label repo)
|
||||
(define tmp-dir (make-temporary-file "~a-clone" 'directory))
|
||||
|
|
|
|||
|
|
@ -429,7 +429,6 @@
|
|||
(begin
|
||||
(status "Commit id ~s matches ~a" ref (car a-ref))
|
||||
(cadr a-ref))))))))
|
||||
|
||||
(define want-commits
|
||||
(cond
|
||||
[ref-commit (list ref-commit)]
|
||||
|
|
|
|||
|
|
@ -77,7 +77,7 @@
|
|||
[rename
|
||||
pkg-desc/opt pkg-desc
|
||||
(->* (string?
|
||||
(or/c #f 'file 'dir 'link 'static-link 'file-url 'dir-url 'git 'github 'clone 'name)
|
||||
(or/c #f 'file 'dir 'link 'static-link 'file-url 'dir-url 'git 'git-url 'github 'clone 'name)
|
||||
(or/c string? #f)
|
||||
(or/c string? #f)
|
||||
boolean?)
|
||||
|
|
|
|||
|
|
@ -720,9 +720,9 @@
|
|||
([(#:str catalog #f) catalog () "Use <catalog>s instead of configured catalogs"
|
||||
(catalog-list (cons catalog (catalog-list)))])
|
||||
#:install-type-flags
|
||||
([(#:sym type [file dir file-url dir-url git github name] #f) type ("-t")
|
||||
([(#:sym type [file dir file-url dir-url git git-url github name] #f) type ("-t")
|
||||
("Specify type of <pkg-source>, instead of inferred;"
|
||||
"valid <types>s are: file, dir, file-url, dir-url, git, github, or name")]
|
||||
"valid <types>s are: file, dir, file-url, dir-url, git, git-url, github, or name")]
|
||||
[(#:str name #f) name ("-n") ("Specify name of package, instead of inferred;"
|
||||
"makes sense only when a single <pkg-source> is given")]
|
||||
[(#:str checksum #f) checksum () ("Checksum of package, either expected or selected;"
|
||||
|
|
@ -777,11 +777,11 @@
|
|||
link-type
|
||||
(not (memq type
|
||||
(case link-type
|
||||
[(clone) '(git github)]
|
||||
[(clone) '(git git-url github)]
|
||||
[else '(dir)]))))
|
||||
((current-pkg-error) (format "-t/--type value must be ~a with --~a"
|
||||
(cond
|
||||
[clone "`git' or `github'"]
|
||||
[clone "`git', `git-url', or `github'"]
|
||||
[else "`dir'"])
|
||||
(cond
|
||||
[link "link"]
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
racket/format
|
||||
racket/string
|
||||
racket/path
|
||||
net/url)
|
||||
net/url
|
||||
"private/git-url-scheme.rkt")
|
||||
|
||||
(provide
|
||||
package-source-format?
|
||||
|
|
@ -26,7 +27,7 @@
|
|||
(define rx:git #rx"[.]git$")
|
||||
|
||||
(define package-source-format?
|
||||
(or/c 'name 'file 'dir 'git 'github 'clone 'file-url 'dir-url 'link 'static-link))
|
||||
(or/c 'name 'file 'dir 'git 'github 'clone 'file-url 'dir-url 'git-url 'link 'static-link))
|
||||
|
||||
(define (validate-name name complain inferred?)
|
||||
(and name
|
||||
|
|
@ -136,8 +137,8 @@
|
|||
(regexp-match? rx:package-name s))
|
||||
(values (validate-name s complain #f) 'name)]
|
||||
[(and (eq? type 'clone)
|
||||
(not (regexp-match? #rx"^(?:https?|git(?:hub)?)://" s)))
|
||||
(complain "repository URL must start 'http', 'https', 'git', or 'github'")
|
||||
(not (regexp-match? #rx"^(?:https?|git(?:hub|[+]https?)?)://" s)))
|
||||
(complain "repository URL must start 'http', 'https', 'git', 'git+http', 'git+https', or 'github'")
|
||||
(values #f 'clone)]
|
||||
[(and (eq? type 'github)
|
||||
(not (regexp-match? #rx"^git(?:hub)?://" s)))
|
||||
|
|
@ -150,10 +151,11 @@
|
|||
[(if type
|
||||
(or (eq? type 'github)
|
||||
(eq? type 'git)
|
||||
(eq? type 'git-url)
|
||||
(eq? type 'clone)
|
||||
(eq? type 'file-url)
|
||||
(eq? type 'dir-url))
|
||||
(regexp-match? #rx"^(https?|github|git)://" s))
|
||||
(regexp-match? #rx"^(https?|github|git([+]https?)?)://" s))
|
||||
(define url (with-handlers ([exn:fail? (lambda (exn)
|
||||
(complain "cannot parse URL")
|
||||
#f)])
|
||||
|
|
@ -239,10 +241,12 @@
|
|||
(values name 'file-url)]
|
||||
[(if type
|
||||
(or (eq? type 'git)
|
||||
(eq? type 'git-url)
|
||||
(eq? type 'clone))
|
||||
(and (last-non-empty p)
|
||||
(string-and-regexp-match? rx:git (last-non-empty p))
|
||||
((num-empty p) . < . 2)))
|
||||
(or (git-url-scheme? (url-scheme url))
|
||||
(and (last-non-empty p)
|
||||
(string-and-regexp-match? rx:git (last-non-empty p))
|
||||
((num-empty p) . < . 2))))
|
||||
(define name
|
||||
(and (cor (last-non-empty p)
|
||||
(complain "URL path is empty"))
|
||||
|
|
@ -251,7 +255,9 @@
|
|||
(cor (string? (last-non-empty p))
|
||||
(complain "URL path ends with a directory indicator"))
|
||||
(extract-git-name url p complain-name)))
|
||||
(values name 'git)]
|
||||
(values name (if (git-url-scheme? (url-scheme url))
|
||||
'git-url
|
||||
'git))]
|
||||
[else
|
||||
(define name
|
||||
(and (cor (pair? p)
|
||||
|
|
|
|||
|
|
@ -9,6 +9,7 @@
|
|||
"pkg-db.rkt"
|
||||
"catalog.rkt"
|
||||
"repo-path.rkt"
|
||||
"git-url-scheme.rkt"
|
||||
"desc.rkt"
|
||||
"dirs.rkt"
|
||||
"print.rkt")
|
||||
|
|
@ -259,7 +260,7 @@
|
|||
(define-values (new-name new-type)
|
||||
(package-source->name+type src #f))
|
||||
(case new-type
|
||||
[(git github)
|
||||
[(git git-url github)
|
||||
(pkg-desc src 'clone name
|
||||
(pkg-desc-checksum desc)
|
||||
(pkg-desc-auto? desc)
|
||||
|
|
@ -392,7 +393,7 @@
|
|||
#:prefetch? prefetch?
|
||||
#:prefetch-group prefetch-group))]
|
||||
[else #f])]
|
||||
[(git github clone)
|
||||
[(git git-url github clone)
|
||||
(define pkg-url (string->url (pkg-desc-source d)))
|
||||
(define-values (transport host port repo branch path)
|
||||
(split-git-or-hub-url #:type type pkg-url))
|
||||
|
|
@ -418,9 +419,11 @@
|
|||
[`(catalog ,lookup-name ,url-str)
|
||||
(pkg-desc url-str (if reject-existing?
|
||||
'clone
|
||||
(if (equal? "github" (url-scheme (string->url url-str)))
|
||||
'github
|
||||
'git))
|
||||
(let ([scheme (url-scheme (string->url url-str))])
|
||||
(cond
|
||||
[(equal? "github" scheme) 'github]
|
||||
[(git-url-scheme? scheme) 'git-url]
|
||||
[else 'git])))
|
||||
name
|
||||
checksum auto? extra-path)]
|
||||
[`(url ,url-str)
|
||||
|
|
@ -432,6 +435,11 @@
|
|||
(pkg-desc url-str (if reject-existing? 'clone current-type) name
|
||||
checksum auto? extra-path)]
|
||||
[else #f])]
|
||||
[`(git ,url-str)
|
||||
(define-values (current-name current-type)
|
||||
(package-source->name+type url-str 'git-url))
|
||||
(pkg-desc url-str (if reject-existing? 'clone current-type) name
|
||||
checksum auto? extra-path)]
|
||||
[_ #f]))
|
||||
|
||||
;; For a `desc`, extract it's clone location, if it's a clone
|
||||
|
|
|
|||
8
racket/collects/pkg/private/git-url-scheme.rkt
Normal file
8
racket/collects/pkg/private/git-url-scheme.rkt
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide git-url-scheme?)
|
||||
|
||||
(define (git-url-scheme? s)
|
||||
(or (equal? s "git+http")
|
||||
(equal? s "git+https")))
|
||||
|
||||
|
|
@ -48,7 +48,7 @@
|
|||
#:catalog-lookup-cache [catalog-lookup-cache #f] ; [prefetch-shared]
|
||||
#:remote-checksum-cache [remote-checksum-cache #f]) ; [prefetch-shared]
|
||||
(case type
|
||||
[(file-url dir-url github git clone)
|
||||
[(file-url dir-url github git git-url clone)
|
||||
(or given-checksum
|
||||
(remote-package-checksum `(url ,pkg-source) download-printf pkg-name
|
||||
#:type type
|
||||
|
|
@ -1210,17 +1210,20 @@
|
|||
(skip/update-dependencies "package installed locally"))]
|
||||
[_
|
||||
(define-values (orig-pkg-source orig-pkg-type orig-pkg-dir)
|
||||
(if (eq? 'clone (car orig-pkg))
|
||||
(values (caddr orig-pkg)
|
||||
'clone
|
||||
(enclosing-path-for-repo (caddr orig-pkg)
|
||||
(path->complete-path
|
||||
(cadr orig-pkg)
|
||||
(pkg-installed-dir))))
|
||||
;; It would be better if the type were preseved
|
||||
;; from install time, but we always make the
|
||||
;; URL unambigious:
|
||||
(values (cadr orig-pkg) #f #f)))
|
||||
(case (car orig-pkg)
|
||||
[(clone)
|
||||
(values (caddr orig-pkg)
|
||||
'clone
|
||||
(enclosing-path-for-repo (caddr orig-pkg)
|
||||
(path->complete-path
|
||||
(cadr orig-pkg)
|
||||
(pkg-installed-dir))))]
|
||||
[(git) (values (cadr orig-pkg) 'git-url #f)]
|
||||
[else
|
||||
;; It would be better if the type were preseved
|
||||
;; from install time, but we always make the
|
||||
;; URL unambigious:
|
||||
(values (cadr orig-pkg) #f #f)]))
|
||||
(define new-checksum
|
||||
(hash-ref update-cache pkg-name
|
||||
(lambda ()
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@
|
|||
#:more-than-root? #t))
|
||||
,src)]
|
||||
[(file dir) `(,type ,(simple-form-path* src))]
|
||||
[(git-url) `(git ,src)]
|
||||
[else `(url ,src)]))
|
||||
|
||||
;; Ignore URL that is potentially recorded for a 'catalog kind:
|
||||
|
|
|
|||
|
|
@ -35,7 +35,12 @@
|
|||
|
||||
;; returns: (values host repo branch path)
|
||||
(define (split-git-url pkg-url)
|
||||
(values (string->symbol (url-scheme pkg-url))
|
||||
(values (let ([scheme (string->symbol (url-scheme pkg-url))])
|
||||
;; convert scheme to transport
|
||||
(case scheme
|
||||
[(git+http) 'http]
|
||||
[(git+https) 'https]
|
||||
[else scheme]))
|
||||
(url-host pkg-url)
|
||||
(url-port pkg-url)
|
||||
(string-join (map (compose ~a path/param-path)
|
||||
|
|
|
|||
|
|
@ -48,7 +48,9 @@
|
|||
(if (and (eq? type 'github)
|
||||
use-git-for-github?)
|
||||
'git
|
||||
type))
|
||||
(if (eq? type 'git-url)
|
||||
'git
|
||||
type)))
|
||||
|
||||
(define (remote-package-checksum pkg download-printf pkg-name
|
||||
#:type [type #f]
|
||||
|
|
@ -69,6 +71,11 @@
|
|||
#:type type
|
||||
#:download-printf download-printf
|
||||
#:pkg-name pkg-name)]
|
||||
[`(git ,pkg-url-str)
|
||||
(package-url->checksum pkg-url-str
|
||||
#:type (or type 'git-url)
|
||||
#:download-printf download-printf
|
||||
#:pkg-name pkg-name)]
|
||||
[`(clone ,_ ,pkg-url-str)
|
||||
(package-url->checksum pkg-url-str
|
||||
#:type 'clone
|
||||
|
|
@ -269,7 +276,8 @@
|
|||
[(or (eq? type 'file-url)
|
||||
(eq? type 'dir-url)
|
||||
(eq? type 'github)
|
||||
(eq? type 'git))
|
||||
(eq? type 'git)
|
||||
(eq? type 'git-url))
|
||||
(define pkg-url-str (normalize-url type pkg (string->url pkg)))
|
||||
(define pkg-url (string->url pkg-url-str))
|
||||
(define scheme (url-scheme pkg-url))
|
||||
|
|
@ -301,7 +309,7 @@
|
|||
(make-temporary-file
|
||||
(string-append
|
||||
"~a-"
|
||||
(regexp-replace* #rx"[:/\\.]" (format "~a.~a" repo branch) "_"))
|
||||
(regexp-replace* #rx"[:/\\.~]" (format "~a.~a" repo branch) "_"))
|
||||
'directory))
|
||||
|
||||
(define staged? #f)
|
||||
|
|
@ -689,8 +697,9 @@
|
|||
(when check-sums?
|
||||
(check-checksum given-checksum checksum "unexpected" pkg #f)
|
||||
(check-checksum checksum (install-info-checksum info) "incorrect" pkg #f))
|
||||
(define-values (new-name new-type) (package-source->name+type source #f))
|
||||
(define-values (new-name new-type) (package-source->name+type source #f))
|
||||
(define repo-url (and (or (eq? new-type 'git)
|
||||
(eq? new-type 'git-url)
|
||||
(eq? new-type 'github))
|
||||
source))
|
||||
(case new-type
|
||||
|
|
@ -859,7 +868,7 @@
|
|||
;; `type` in the future.
|
||||
(define (normalize-url type str as-url)
|
||||
(case type
|
||||
[(git)
|
||||
[(git) ; not git-url, which should not be normalized by adding ".git"
|
||||
(cond
|
||||
[(equal? "git" (url-scheme as-url))
|
||||
str]
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user