diff options
Diffstat (limited to 'guix/git.scm')
| -rw-r--r-- | guix/git.scm | 45 |
1 files changed, 28 insertions, 17 deletions
diff --git a/guix/git.scm b/guix/git.scm index a5103547d3..57fa2ca1ee 100644 --- a/guix/git.scm +++ b/guix/git.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -185,10 +186,9 @@ make sure no empty directory is left behind." (lambda () (mkdir-p directory) - (let ((auth-method (%make-auth-ssh-agent))) - (clone url directory - (make-clone-options - #:fetch-options (make-default-fetch-options))))) + (clone url directory + (make-clone-options + #:fetch-options (make-default-fetch-options)))) (lambda _ (false-if-exception (rmdir directory))))) @@ -210,6 +210,9 @@ corresponding Git object." (let ((oid (reference-target (branch-lookup repository branch BRANCH-REMOTE)))) (object-lookup repository oid))) + (('symref . symref) + (let ((oid (reference-name->oid repository symref))) + (object-lookup repository oid))) (('commit . commit) (let ((len (string-length commit))) ;; 'object-lookup-prefix' appeared in Guile-Git in Mar. 2018, so we @@ -280,13 +283,15 @@ dynamic extent of EXP." (report-git-error err)))) (define* (update-submodules repository - #:key (log-port (current-error-port))) + #:key (log-port (current-error-port)) + (fetch-options #f)) "Update the submodules of REPOSITORY, a Git repository object." (for-each (lambda (name) (let ((submodule (submodule-lookup repository name))) (format log-port (G_ "updating submodule '~a'...~%") name) - (submodule-update submodule) + (submodule-update submodule + #:fetch-options fetch-options) ;; Recurse in SUBMODULE. (let ((directory (string-append @@ -294,6 +299,7 @@ dynamic extent of EXP." "/" (submodule-path submodule)))) (with-repository directory repository (update-submodules repository + #:fetch-options fetch-options #:log-port log-port))))) (repository-submodules repository))) @@ -341,7 +347,7 @@ definitely available in REPOSITORY, false otherwise." (define* (update-cached-checkout url #:key - (ref '(branch . "master")) + (ref '()) recursive? (check-out? #t) starting-commit @@ -357,6 +363,7 @@ provided) as returned by 'commit-relation'. REF is pair whose key is [branch | commit | tag | tag-or-commit ] and value the associated data: [<branch name> | <sha1> | <tag name> | <string>]. +If REF is the empty list, the remote HEAD is used. When RECURSIVE? is true, check out submodules as well, if any. @@ -375,6 +382,7 @@ it unchanged." ;; made little sense since the cache should be transparent to them. So ;; here we append "origin/" if it's missing and otherwise keep it. (match ref + (() '(symref . "refs/remotes/origin/HEAD")) (('branch . branch) `(branch . ,(if (string-prefix? "origin/" branch) branch @@ -389,11 +397,11 @@ it unchanged." ;; Only fetch remote if it has not been cloned just before. (when (and cache-exists? (not (reference-available? repository ref))) - (let ((auth-method (%make-auth-ssh-agent))) - (remote-fetch (remote-lookup repository "origin") - #:fetch-options (make-default-fetch-options)))) + (remote-fetch (remote-lookup repository "origin") + #:fetch-options (make-default-fetch-options))) (when recursive? - (update-submodules repository #:log-port log-port)) + (update-submodules repository #:log-port log-port + #:fetch-options (make-default-fetch-options))) ;; Note: call 'commit-relation' from here because it's more efficient ;; than letting users re-open the checkout later on. @@ -435,12 +443,13 @@ it unchanged." (log-port (%make-void-port "w")) (cache-directory (%repository-cache-directory)) - (ref '(branch . "master"))) + (ref '())) "Return two values: the content of the git repository at URL copied into a store directory and the sha1 of the top level commit in this directory. The reference to be checkout, once the repository is fetched, is specified by REF. REF is pair whose key is [branch | commit | tag] and value the associated -data, respectively [<branch name> | <sha1> | <tag name>]. +data, respectively [<branch name> | <sha1> | <tag name>]. If REF is the empty +list, the remote HEAD is used. When RECURSIVE? is true, check out submodules as well, if any. @@ -550,7 +559,7 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or git-checkout make-git-checkout git-checkout? (url git-checkout-url) - (branch git-checkout-branch (default "master")) + (branch git-checkout-branch (default #f)) (commit git-checkout-commit (default #f)) ;#f | tag | commit (recursive? git-checkout-recursive? (default #f))) @@ -589,9 +598,11 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or (match checkout (($ <git-checkout> url branch commit recursive?) (latest-repository-commit* url - #:ref (if commit - `(tag-or-commit . ,commit) - `(branch . ,branch)) + #:ref (cond (commit + `(tag-or-commit . ,commit)) + (branch + `(branch . ,branch)) + (else '())) #:recursive? recursive? #:log-port (current-error-port))))) |