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:
Iqbal Ansari 2014-10-05 12:28:29 +05:30
parent 6aafc8a851
commit 16d65943e8

View File

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