mirror of
https://github.com/dimitri/el-get.git
synced 2024-09-29 13:08:51 +08:00
Improve support for shallow clones using git
The current algorithm is 1) If the protocol used is not http (file, ssh, git) clone is supported 2) Otherwise check if repo belongs to know smart host, if so assume shallow clone is supported 3) If none of the above work, make a HEAD request and parse response headers to determine the host is smart explained (here)[http://stackoverflow.com/questions/9270488/]
This commit is contained in:
parent
6aafc8a851
commit
16d65943e8
|
@ -14,6 +14,7 @@
|
|||
|
||||
(require 'el-get-core)
|
||||
(require 'el-get-recipes)
|
||||
(require 'url-parse)
|
||||
|
||||
(defcustom el-get-git-clone-hook nil
|
||||
"Hook run after git clone."
|
||||
|
@ -25,6 +26,12 @@
|
|||
:group 'el-get
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom el-get-git-known-smart-domains'("www.github.com" "www.bitbucket.org" "repo.or.cz")
|
||||
"List of domain which are known to support shallow clone, el-get will not make
|
||||
explicit checks for these"
|
||||
:group 'el-get
|
||||
:type 'list)
|
||||
|
||||
(defun el-get-git-executable ()
|
||||
"Return git executable to use, or signal an error when not
|
||||
found."
|
||||
|
@ -38,6 +45,51 @@ found."
|
|||
"or the binary `git' to be found in your PATH")))
|
||||
git-executable))
|
||||
|
||||
(defun el-get-git-url-from-known-smart-domains (url)
|
||||
"Check if URL belongs to know smart domains, it basically
|
||||
looks up domain in `el-get-git-known-smart-domains'
|
||||
|
||||
This is needed since some domains like bitbucket support shallow clone even
|
||||
though they do not indicate this in their response headers see
|
||||
`el-get-git-is-host-smart-http'"
|
||||
(let* ((host (url-host (url-generic-parse-url url)))
|
||||
;; Prepend www to domain, if it consists only of two components
|
||||
(prefix (when (= (length (split-string host "\\.")) 2)
|
||||
"www.")))
|
||||
(member (concat prefix host) el-get-git-known-smart-domains)))
|
||||
|
||||
(defun el-get-git-is-host-smart-http (giturl)
|
||||
"Detect if the host is capable of shallow clones using, http GITURL is url to
|
||||
the git repository, this function is indented to be used only with http urls. It
|
||||
uses the approach described here [http://stackoverflow.com/questions/9270488/]
|
||||
|
||||
Basically it makes a HEAD request and checks the Content-Type for 'smart' MIME
|
||||
type. This approach does not work for some domains like `bitbucket', it returns
|
||||
'text/html' as Content-Type"
|
||||
(let ((url-request-method "HEAD")
|
||||
(req-url (format "%s%s/info/refs\?service\=git-upload-pack"
|
||||
giturl
|
||||
;; The url may not end with ".git" in which case we may
|
||||
;; need to add append ".git" to the url
|
||||
(if (string-match "\\.git\\'" giturl)
|
||||
""
|
||||
".git")))
|
||||
(smart-content-type "Content-Type: application/x-git-upload-pack-advertisement"))
|
||||
|
||||
(with-current-buffer (url-retrieve-synchronously req-url)
|
||||
(goto-char (point-min))
|
||||
(numberp (ignore-errors (search-forward-regexp smart-content-type))))))
|
||||
|
||||
(defun el-get-git-shallow-clone-supported? (url)
|
||||
"Check if shallow clone is supported for given URL"
|
||||
;; All other protocols git, ssh and file support shallow clones
|
||||
(or (not (string-prefix-p "http" url))
|
||||
;; Check if url belongs to one of known smart domains
|
||||
(el-get-git-url-from-known-smart-domains url)
|
||||
;; If all else fails make an explicit call to check if shallow clone is
|
||||
;; supported
|
||||
(el-get-git-is-host-smart-http url)))
|
||||
|
||||
(defun el-get-git-clone (package url post-install-fun)
|
||||
"Clone the given package following the URL."
|
||||
(let* ((git-executable (el-get-executable-find "git"))
|
||||
|
@ -52,10 +104,7 @@ found."
|
|||
(not submodule-prop)))
|
||||
(checkout (or (plist-get source :checkout)
|
||||
(plist-get source :checksum)))
|
||||
;; http may a be a dumb server, not supporting shallow clones
|
||||
;; it's not the case of github
|
||||
(shallow (unless (and (string-prefix-p "http" url)
|
||||
(not (string-prefix-p "http://github.com" url)))
|
||||
(shallow (when (el-get-git-shallow-clone-supported? url)
|
||||
(el-get-plist-get-with-default source :shallow
|
||||
el-get-git-shallow-clone)))
|
||||
(clone-args (append '("--no-pager" "clone")
|
||||
|
|
Loading…
Reference in New Issue
Block a user