Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix for git shallow clones #1921

Merged
merged 3 commits into from
Oct 5, 2014
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
57 changes: 53 additions & 4 deletions methods/el-get-git.el
Original file line number Diff line number Diff line change
Expand Up @@ -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."
Expand All @@ -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 domains 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."
Expand All @@ -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-p (url)
"Check if URL belongs to known smart domains, it basically looks up the url's
domain in `el-get-git-known-smart-domains'

This is needed because 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-p'"
(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-p (giturl)
"Detect if the host supports shallow clones using http(s). GITURL is url to
the git repository, this function is intended to be used only with http(s)
urls. The function 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', which do
not return 'smart' headers despite supporting shallow clones"
(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
;; 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-p (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-p url)
;; If all else fails make an explicit call to check if shallow clone is
;; supported
(el-get-git-is-host-smart-http-p 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"))
Expand All @@ -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-p url)
(el-get-plist-get-with-default source :shallow
el-get-git-shallow-clone)))
(clone-args (append '("--no-pager" "clone")
Expand Down
35 changes: 35 additions & 0 deletions test/el-get-issue-1920.el
Original file line number Diff line number Diff line change
@@ -0,0 +1,35 @@
;; Test for testing `el-get-git-shallow-clone-supported-p' function
;; the function detects whether shallow clone is supported for url

(require 'cl-lib)

;; Tests for lower level function [el-get-git-url-from-known-smart-domains-p]
(cl-assert (el-get-git-shallow-clone-supported-p "https://www.bitbucket.org/alfaromurillo/org-passwords.el.git"))
(cl-assert (el-get-git-url-from-known-smart-domains-p "https://www.github.com/dimitri/el-get"))
(cl-assert (el-get-git-url-from-known-smart-domains-p "https://bitbucket.org/alfaromurillo/org-passwords.el.git"))
(cl-assert (el-get-git-url-from-known-smart-domains-p "https://github.com/dimitri/el-get"))

;; Tests for lower level function [el-get-git-is-host-smart-http-p]
(cl-assert (el-get-git-is-host-smart-http-p "https://github.com/dimitri/el-get.git"))
(cl-assert (el-get-git-is-host-smart-http-p "http://repo.or.cz/r/anything-config.git"))
(cl-assert (not (el-get-git-is-host-smart-http-p "http://www.dr-qubit.org/git/undo-tree.git")))

;; Function should not fail for urls without '.git' prefix
(cl-assert (el-get-git-is-host-smart-http-p "https://github.com/dimitri/el-get"))
(cl-assert (el-get-git-is-host-smart-http-p "http://repo.or.cz/r/anything-config"))
(cl-assert (not (el-get-git-is-host-smart-http-p "http://www.dr-qubit.org/git/undo-tree")))

;; Tests for function [el-get-git-shallow-clone-supported-p]
;; `git', `ssh' and `file' support shallow clones
(cl-assert (el-get-git-shallow-clone-supported-p "git://gitorious.org/evil/evil.git"))
(cl-assert (el-get-git-shallow-clone-supported-p "file:///opt/git/project.git"))
(cl-assert (el-get-git-shallow-clone-supported-p "ssh://some_user@some_server/some_project.git"))

;; The following repos support shallow clones
(cl-assert (el-get-git-shallow-clone-supported-p "http://repo.or.cz/r/anything-config.git"))
(cl-assert (el-get-git-shallow-clone-supported-p "https://github.com/dimitri/el-get"))
(cl-assert (el-get-git-shallow-clone-supported-p "https://bitbucket.org/alfaromurillo/org-passwords.el.git"))

;; The following do not support shallow clones
(cl-assert (not (el-get-git-shallow-clone-supported-p "http://www.dr-qubit.org/git/undo-tree.git/")))
(cl-assert (not (el-get-git-shallow-clone-supported-p "http://michael.orlitzky.com/git/nagios-mode.git")))