* guix/git.scm (download-git-to-store): Download Git repository from
URL at COMMIT to STORE, either under NAME or URL's basename if omitted.
Write progress reports to LOG. RECURSIVE? has the same effect as the
same-named parameter of 'git-fetch'.
* guix/scripts/download.scm (download-git-to-store*): Adds cli option.
guix download --git-commit=v0.1.1 github.com/anaseto/gruid-tcell
guix/git.scm | 24 +++++++++++++++++-
guix/scripts/download.scm | 51 ++++++++++++++++++++++++++++++++-------
2 files changed, 65 insertions(+), 10 deletions(-)
Toggle diff (164 lines)
diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..4c70782b97 100644
#:use-module (gcrypt hash)
#:use-module ((guix build utils)
#:select (mkdir-p delete-file-recursively))
+ #:use-module ((guix build git) #:select (git-fetch))
#:use-module (guix store)
#:use-module (guix utils)
#:use-module (guix records)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (%repository-cache-directory
honor-system-x509-certificates!
- git-checkout-recursive?))
+ git-checkout-recursive?
+ download-git-to-store))
(define %repository-cache-directory
(make-parameter (string-append (cache-directory #:ensure? #f)
@@ -614,6 +618,24 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
#:log-port (current-error-port)))))
+(define* (download-git-to-store store url commit
+ #:optional (name (basename url))
+ #:key (log (current-error-port)) recursive?)
+ "Download Git repository from URL at COMMIT to STORE, either under NAME or
+URL's basename if omitted. Write progress reports to LOG. RECURSIVE? has the
+same effect as the same-named parameter of 'git-fetch'."
+ (call-with-temporary-directory
+ (parameterize ((current-output-port log))
+ (git-fetch url commit temp
+ #:recursive? recursive?))))
+ (add-to-store store name #t "sha256" temp))))))
;; eval: (put 'with-repository 'scheme-indent-function 2)
diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
index 5a91390358..6253ecaa5c 100644
--- a/guix/scripts/download.scm
+++ b/guix/scripts/download.scm
#:use-module (guix base32)
#:autoload (guix base64) (base64-encode)
#:use-module ((guix download) #:hide (url-fetch))
+ #:use-module ((guix git) #:select (download-git-to-store))
#:use-module ((guix build download)
#:use-module ((guix progress)
#:select (current-terminal-columns))
+ #:use-module ((guix serialization)
#:use-module ((guix build syscalls)
#:select (terminal-columns))
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-14)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-37)
(ensure-valid-store-file-name (basename url))
#:verify-certificate? verify-certificate?)))
+(define* (download-git-to-store* url commit #:key recursive?)
+ (download-git-to-store store url commit
+ (ensure-valid-store-file-name (basename url))
+ #:recursive? recursive?)))
;; Alist of default option values.
`((format . ,bytevector->nix-base32-string)
(hash-algorithm . ,(hash-algorithm sha256))
(verify-certificate? . #t)
- (download-proc . ,download-to-store*)))
+ (download-proc . ,download-to-store*)
+ (git-download-proc . ,download-git-to-store*)
(display (G_ "Usage: guix download [OPTION] URL
@@ -100,6 +112,9 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
do not validate the certificate of HTTPS servers "))
-o, --output=FILE download to FILE"))
+ -c, --git-commit=COMMIT
+ download a Git repository"))
-h, --help display this help and exit"))
@@ -143,6 +158,9 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(lambda* (url #:key verify-certificate?)
(download-to-file url arg))
(alist-delete 'download result))))
+ (option '(#\c "git-commit") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'commit arg result)))
(option '(#\h "help") #f #f
@@ -182,16 +200,31 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(leave (G_ "~a: failed to parse URI~%")
(fetch (assq-ref opts 'download-proc))
+ (git-fetch (assq-ref opts 'git-download-proc))
+ (commit (assq-ref opts 'commit))
(path (parameterize ((current-terminal-columns
- (fetch (uri->string uri)
- (assq-ref opts 'verify-certificate?))))
- (hash (call-with-input-file
- (leave (G_ "~a: download failed~%")
- (cute port-hash (assoc-ref opts 'hash-algorithm) <>)))
+ (git-fetch (uri->string uri) commit)
+ (fetch (uri->string uri)
+ (assq-ref opts 'verify-certificate?)))))
+ (hash (if (or (assq-ref opts 'recursive) commit)
+ (let-values (((port get-hash)
+ (assoc-ref opts 'hash-algorithm))))
+ (lambda (file stat) (not (equal? (basename file) ".git")))
+ (leave (G_ "~a: download failed~%")
+ (cute port-hash (assoc-ref opts 'hash-algorithm) <>))))
(fmt (assq-ref opts 'format)))
(format #t "~a~%~a~%" path (fmt hash))