From: jgart via Guix-patches via <guix-patches@gnu.org>
To: 50274@debbugs.gnu.org
Cc: Julien Lepiller <julien@lepiller.eu>
Subject: [bug#50274] [PATCH] guix: git: Adds feature to download git repository to the store.
Date: Mon, 30 Aug 2021 12:39:19 -0400 [thread overview]
Message-ID: <20210830163918.19419-1-jgart@dismail.de> (raw)
From: Julien Lepiller <julien@lepiller.eu>
* 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.
Examples:
guix download --git-commit=v0.1.1 github.com/anaseto/gruid-tcell
guix download -c v0.1.1 https://github.com/anaseto/gruid-tcell
---
guix/git.scm | 24 +++++++++++++++++-
guix/scripts/download.scm | 51 ++++++++++++++++++++++++++++++++-------
2 files changed, 65 insertions(+), 10 deletions(-)
diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..4c70782b97 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -28,6 +28,7 @@
#: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)
@@ -43,6 +44,7 @@
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
+ #:use-module (web uri)
#:export (%repository-cache-directory
honor-system-x509-certificates!
@@ -61,7 +63,9 @@
git-checkout-url
git-checkout-branch
git-checkout-commit
- 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
#:recursive? recursive?
#: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'."
+ (define uri
+ (string->uri url))
+
+ (call-with-temporary-directory
+ (lambda (temp)
+ (let ((result
+ (parameterize ((current-output-port log))
+ (git-fetch url commit temp
+ #:recursive? recursive?))))
+ (and result
+ (add-to-store store name #t "sha256" temp))))))
+
;; Local Variables:
;; eval: (put 'with-repository 'scheme-indent-function 2)
;; End:
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
@@ -26,15 +26,19 @@
#: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)
#:select (url-fetch))
#:use-module ((guix progress)
#:select (current-terminal-columns))
+ #:use-module ((guix serialization)
+ #:select (write-file))
#:use-module ((guix build syscalls)
#:select (terminal-columns))
#:use-module (web uri)
#: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)
@@ -76,12 +80,20 @@
(ensure-valid-store-file-name (basename url))
#:verify-certificate? verify-certificate?)))
+(define* (download-git-to-store* url commit #:key recursive?)
+ (with-store store
+ (download-git-to-store store url commit
+ (ensure-valid-store-file-name (basename url))
+ #:recursive? recursive?)))
+
(define %default-options
;; 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*)
+ (commit . #f)))
(define (show-help)
(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 "))
(format #t (G_ "
-o, --output=FILE download to FILE"))
+ (format #t (G_ "
+ -c, --git-commit=COMMIT
+ download a Git repository"))
(newline)
(display (G_ "
-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
(lambda args
@@ -182,16 +200,31 @@ and 'base16' ('hex' and 'hexadecimal' can be used as well).\n"))
(leave (G_ "~a: failed to parse URI~%")
arg)))
(fetch (assq-ref opts 'download-proc))
+ (git-fetch (assq-ref opts 'git-download-proc))
+ (commit (assq-ref opts 'commit))
(path (parameterize ((current-terminal-columns
(terminal-columns)))
- (fetch (uri->string uri)
- #:verify-certificate?
- (assq-ref opts 'verify-certificate?))))
- (hash (call-with-input-file
- (or path
- (leave (G_ "~a: download failed~%")
- arg))
- (cute port-hash (assoc-ref opts 'hash-algorithm) <>)))
+ (if commit
+ (git-fetch (uri->string uri) commit)
+ (fetch (uri->string uri)
+ #:verify-certificate?
+ (assq-ref opts 'verify-certificate?)))))
+ (hash (if (or (assq-ref opts 'recursive) commit)
+ (let-values (((port get-hash)
+ (open-hash-port
+ (assoc-ref opts 'hash-algorithm))))
+ (write-file path port
+ #:select?
+ (if commit
+ (lambda (file stat) (not (equal? (basename file) ".git")))
+ (const #t)))
+ (force-output port)
+ (get-hash))
+ (call-with-input-file
+ (or path
+ (leave (G_ "~a: download failed~%")
+ arg))
+ (cute port-hash (assoc-ref opts 'hash-algorithm) <>))))
(fmt (assq-ref opts 'format)))
(format #t "~a~%~a~%" path (fmt hash))
#t)))
--
2.33.0
next reply other threads:[~2021-08-30 16:41 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-08-30 16:39 jgart via Guix-patches via [this message]
2021-08-31 18:50 ` [bug#50274] [PATCH] guix: git: Adds feature to download git repository to the store Sarah Morgensen
2021-08-31 22:28 ` Maxime Devos
2021-08-31 19:08 ` Sarah Morgensen
2021-08-31 19:30 ` jgart via Guix-patches via
2021-08-31 20:06 ` jgart via Guix-patches via
2021-09-03 1:37 ` Sarah Morgensen
2021-09-24 12:25 ` Ludovic Courtès
2021-09-26 6:24 ` Sarah Morgensen
2021-09-30 20:03 ` Ludovic Courtès
2023-08-01 1:21 ` TakeV via Guix-patches via
2023-08-18 17:55 ` Simon Tournier
2023-08-18 21:02 ` TakeV via Guix-patches via
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20210830163918.19419-1-jgart@dismail.de \
--to=guix-patches@gnu.org \
--cc=50274@debbugs.gnu.org \
--cc=jgart@dismail.de \
--cc=julien@lepiller.eu \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).