[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/07: swh: Support downloads of bare Git repositories.
From: |
guix-commits |
Subject: |
04/07: swh: Support downloads of bare Git repositories. |
Date: |
Sat, 18 Sep 2021 17:09:33 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 6ec81c31c0c6d136ad7366e985083eaee34f7980
Author: Ludovic Courtès <ludovic.courtes@inria.fr>
AuthorDate: Fri Sep 10 15:01:59 2021 +0200
swh: Support downloads of bare Git repositories.
* guix/swh.scm (swh-download-archive): New procedure.
(swh-download-directory): Rewrite in terms of 'swh-download-archive'.
(swh-download): Add #:archive-type and honor it. Use
'swh-download-archive' instead of 'swh-download-directory'.
---
guix/swh.scm | 52 ++++++++++++++++++++++++++++++++++++++++------------
1 file changed, 40 insertions(+), 12 deletions(-)
diff --git a/guix/swh.scm b/guix/swh.scm
index a62567d..5c41685 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -645,20 +645,29 @@ delete it when leaving the dynamic extent of this call."
(lambda ()
(false-if-exception (delete-file-recursively tmp-dir))))))
-(define* (swh-download-directory id output
- #:key (log-port (current-error-port)))
- "Download from Software Heritage the directory with the given ID, and
-unpack it to OUTPUT. Return #t on success and #f on failure"
+(define* (swh-download-archive swhid output
+ #:key
+ (archive-type 'flat)
+ (log-port (current-error-port)))
+ "Download from Software Heritage the directory or revision with the given
+SWID, in the ARCHIVE-TYPE format (one of 'flat or 'git-bare), and unpack it to
+OUTPUT. Return #t on success and #f on failure."
(call-with-temporary-directory
(lambda (directory)
- (match (vault-fetch id 'directory #:log-port log-port)
+ (match (vault-fetch swhid
+ #:archive-type archive-type
+ #:log-port log-port)
(#f
(format log-port
- "SWH: directory ~a could not be fetched from the vault~%"
- id)
+ "SWH: object ~a could not be fetched from the vault~%"
+ swhid)
#f)
((? port? input)
- (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory "-xzvf" "-")))
+ (let ((tar (open-pipe* OPEN_WRITE "tar" "-C" directory
+ (match archive-type
+ ('flat "-xzvf") ;gzipped
+ ('git-bare "-xvf")) ;uncompressed
+ "-")))
(dump-port input tar)
(close-port input)
(let ((status (close-pipe tar)))
@@ -672,6 +681,14 @@ unpack it to OUTPUT. Return #t on success and #f on
failure"
#:log (%make-void-port "w"))
#t))))))))
+(define* (swh-download-directory id output
+ #:key (log-port (current-error-port)))
+ "Download from Software Heritage the directory with the given ID, and
+unpack it to OUTPUT. Return #t on success and #f on failure."
+ (swh-download-archive (string-append "swh:1:dir:" id) output
+ #:archive-type 'flat
+ #:log-port log-port))
+
(define (commit-id? reference)
"Return true if REFERENCE is likely a commit ID, false otherwise---e.g., if
it is a tag name. This is based on a simple heuristic so use with care!"
@@ -679,8 +696,11 @@ it is a tag name. This is based on a simple heuristic so
use with care!"
(string-every char-set:hex-digit reference)))
(define* (swh-download url reference output
- #:key (log-port (current-error-port)))
- "Download from Software Heritage a checkout of the Git tag or commit
+ #:key
+ (archive-type 'flat)
+ (log-port (current-error-port)))
+ "Download from Software Heritage a checkout (if ARCHIVE-TYPE is 'flat) or a
+full Git repository (if ARCHIVE-TYPE is 'git-bare) of the Git tag or commit
REFERENCE originating from URL, and unpack it in OUTPUT. Return #t on success
and #f on failure.
@@ -694,8 +714,16 @@ wait until it becomes available, which could take several
minutes."
(format log-port "SWH: found revision ~a with directory at '~a'~%"
(revision-id revision)
(swh-url (revision-directory-url revision)))
- (swh-download-directory (revision-directory revision) output
- #:log-port log-port))
+ (swh-download-archive (match archive-type
+ ('flat
+ (string-append
+ "swh:1:dir:" (revision-directory revision)))
+ ('git-bare
+ (string-append
+ "swh:1:rev:" (revision-id revision))))
+ output
+ #:archive-type archive-type
+ #:log-port log-port))
(#f
(format log-port
"SWH: revision ~s originating from ~a could not be found~%"
- branch master updated (337b7f5 -> eb6593c), guix-commits, 2021/09/18
- 01/07: gnu: guix: Update to 808f9ff., guix-commits, 2021/09/18
- 04/07: swh: Support downloads of bare Git repositories.,
guix-commits <=
- 07/07: Update NEWS., guix-commits, 2021/09/18
- 06/07: git: 'reference-available?' recognizes 'tag-or-commit'., guix-commits, 2021/09/18
- 05/07: git: 'update-cached-checkout' can fall back to SWH when cloning., guix-commits, 2021/09/18
- 03/07: import: go: Match "go-import" meta tags anywhere., guix-commits, 2021/09/18
- 02/07: import: go: Improve handling of modules in VCS subdirectories., guix-commits, 2021/09/18