Package: guix-patches;
Reported by: Romain GARBAGE <romain.garbage <at> inria.fr>
Date: Fri, 12 Jan 2024 15:16:01 UTC
Severity: normal
Tags: patch
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Romain GARBAGE <romain.garbage <at> inria.fr> Cc: 68405 <at> debbugs.gnu.org, Ludovic Courtès <ludo <at> gnu.org> Subject: [bug#68405] [PATCH v2] guix: download: Add support for git repositories. Date: Thu, 18 Jan 2024 23:16:42 -0500
Hello,
Romain GARBAGE <romain.garbage <at> inria.fr> writes:
> Added `--recursive' option.
I still see a TODO about supporting recursive repos in the code. Is
that still the case?
> Removed `pk' call.
>
> * guix/scripts/download.scm (git-download-to-store*): Add new variable.
> (copy-recursively-without-dot-git): New variable.
> (git-download-to-file): Add new variable.
> (show-help): Add 'git', 'commit', 'branch' and 'recursive'options
> help message.
> (%default-options): Add default value for 'git-reference' and
> 'recursive' options.
> (%options): Add 'git', 'commit', 'branch' and 'recursive' command
> line options.
> (guix-download) [hash]: Compute hash with 'file-hash*' instead of
> 'port-hash' from (gcrypt hash) module. This allows us to compute
> hashes for directories.
> * doc/guix.texi (Invoking guix-download): Add @item entries for
> `git', `commit', `branch' and `recursive' options. Add a paragraph in
> the introduction.
> * tests/guix-download.sh: New tests.
This sounds good and is something that I'm many many of us have wanted
for some time. Thank you for working on it!
Nitpick about the commit message: the convention seems to be to not use
a hanging indent when writing GNU ChangeLog messages.
> ---
> doc/guix.texi | 23 ++++++
> guix/scripts/download.scm | 146 ++++++++++++++++++++++++++++++++++----
> tests/guix-download.sh | 42 +++++++++++
> 3 files changed, 199 insertions(+), 12 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 3002cdfa13..d3b40e878b 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -13983,6 +13983,9 @@ the certificates of X.509 authorities from the directory pointed to by
> the @env{SSL_CERT_DIR} environment variable (@pxref{X.509
> Certificates}), unless @option{--no-check-certificate} is used.
>
> +Alternatively, @command{guix download} can also retrieve a Git
> +repository, possibly a specific commit, tag, or branch.
> +
> The following options are available:
>
> @table @code
> @@ -14007,6 +14010,26 @@ URL, which makes you vulnerable to ``man-in-the-middle'' attacks.
> @itemx -o @var{file}
> Save the downloaded file to @var{file} instead of adding it to the
> store.
> +
> +@item --git
> +@itemx -g
> +Checkout the Git repository at the latest commit on the default branch.
> +
> +@item --commit=@var{commit-or-tag}
> +Checkout the Git repository at @var{commit-or-tag}.
> +
> +@var{commit-or-tag} can be either a tag or a commit defined in the Git
> +repository.
> +
> +@item --branch=@var{branch}
> +Checkout the Git repository at @var{branch}.
> +
> +The repository will be checked out at the latest commit of @var{branch},
> +which must be a valid branch of the Git repository.
> +
> +@item --recursive
> +@itemx -r
> +Recursively clone the Git repository.
> @end table
>
> @node Invoking guix hash
> diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm
> index 19052d5652..50c9a43791 100644
> --- a/guix/scripts/download.scm
> +++ b/guix/scripts/download.scm
> @@ -22,17 +22,23 @@ (define-module (guix scripts download)
> #:use-module (guix scripts)
> #:use-module (guix store)
> #:use-module (gcrypt hash)
> + #:use-module (guix hash)
> #:use-module (guix base16)
> #:use-module (guix base32)
> #:autoload (guix base64) (base64-encode)
> #:use-module ((guix download) #:hide (url-fetch))
> + #:use-module ((guix git)
> + #:select (latest-repository-commit
> + update-cached-checkout))
> #:use-module ((guix build download)
> #:select (url-fetch))
> + #:use-module (guix build utils)
> #:use-module ((guix progress)
> #:select (current-terminal-columns))
> #:use-module ((guix build syscalls)
> #:select (terminal-columns))
> #:use-module (web uri)
> + #:use-module (ice-9 ftw)
> #:use-module (ice-9 match)
> #:use-module (srfi srfi-1)
> #:use-module (srfi srfi-26)
> @@ -54,6 +60,57 @@ (define (download-to-file url file)
> (url-fetch url file #:mirrors %mirrors)))
> file))
>
> +;; This is a simplified version of 'copy-recursively'.
> +;; It allows us to filter out the ".git" subfolder.
> +;; TODO: Remove when 'copy-recursively' supports '#:select?'.
Is a #:select? planned for copy-recursively? (in the works?)
> +(define (copy-recursively-without-dot-git source destination)
> + (define strip-source
> + (let ((len (string-length source)))
> + (lambda (file)
> + (substring file len))))
> +
> + (file-system-fold (lambda (file stat result) ; enter?
> + (not (string-suffix? "/.git" file)))
> + (lambda (file stat result) ; leaf
> + (let ((dest (string-append destination
> + (strip-source file))))
> + (case (stat:type stat)
> + ((symlink)
> + (let ((target (readlink file)))
> + (symlink target dest)))
> + (else
> + (copy-file file dest)))))
> + (lambda (dir stat result) ; down
> + (let ((target (string-append destination
> + (strip-source dir))))
> + (mkdir-p target)))
> + (const #t) ; up
> + (const #t) ; skip
> + (lambda (file stat errno result)
> + (format (current-error-port) "i/o error: ~a: ~a~%"
> + file (strerror errno))
> + #f)
> + #t
> + source))
> +
> +(define (git-download-to-file url file reference recursive?)
> + "Download the git repo at URL to file, checked out at REFERENCE.
> +REFERENCE must be a pair argument as understood by 'latest-repository-commit'.
> +Return FILE."
> + ;; TODO: Support recursive repos.
> + ;; 'libgit2' doesn't support the URL format generated by 'uri->string' so
> + ;; we have to do a little fixup. Dropping completely the 'file:' protocol
> + ;; part gives better performance.
>
> + (let ((url* (cond ((string-prefix? "file://" url)
> + (string-drop url (string-length "file://")))
> + ((string-prefix? "file:" url)
> + (string-drop url (string-length "file:")))
> + (else url))))
> + (copy-recursively-without-dot-git
> + (update-cached-checkout url* #:ref reference #:recursive? recursive?)
> + file))
> + file)
> +
> (define (ensure-valid-store-file-name name)
> "Replace any character not allowed in a store name by an underscore."
>
> @@ -67,17 +124,36 @@ (define valid
> name))
>
>
> -(define* (download-to-store* url #:key (verify-certificate? #t))
> +(define* (download-to-store* url #:key (verify-certificate? #t) #:allow-other-keys)
> (with-store store
> (download-to-store store url
> (ensure-valid-store-file-name (basename url))
> #:verify-certificate? verify-certificate?)))
>
> +(define* (git-download-to-store* url reference recursive? #:key (verify-certificate? #t))
> + "Download the git repository at URL to the store, checked out at REFERENCE.
> +URL must specify a protocol (i.e https:// or file://), REFERENCE must be a
> +pair argument as understood by 'latest-repository-commit'."
> + ;; Ensure the URL string is properly formatted when using the 'file' protocol:
> + ;; URL is generated using 'uri->string', which returns "file:/path/to/file" instead of
> + ;; "file:///path/to/file", which in turn makes 'git-download-to-store' fail.
> + (let* ((file? (string-prefix? "file:" url))
> + (url* (if (and file?
> + (not (string-prefix? "file:///" url)))
> + (string-append "file://" (string-replace url "" 0 (string-length "file:")))
> + url)))
> + (with-store store
> + ;; TODO: Support recursive repos.
> + ;; TODO: Verify certificate support and deactivation.
> + (latest-repository-commit store url* #:recursive? recursive? #:ref reference))))
> +
Some lines look like > 80 chars here. Please break long lines
accordingly.
> (define %default-options
> ;; Alist of default option values.
> `((format . ,bytevector->nix-base32-string)
> (hash-algorithm . ,(hash-algorithm sha256))
> (verify-certificate? . #t)
> + (git-reference . #f)
> + (recursive? . #f)
> (download-proc . ,download-to-store*)))
>
> (define (show-help)
> @@ -97,6 +173,19 @@ (define (show-help)
> do not validate the certificate of HTTPS servers "))
> (format #t (G_ "
> -o, --output=FILE download to FILE"))
> + (format #t (G_ "
> + -g, --git download the default branch's latest commit of the
> + git repository at URL"))
> + (format #t (G_ "
> + --commit=COMMIT_OR_TAG
> + download the given commit or tag of the git
> + repository at URL"))
> + (format #t (G_ "
> + --branch=BRANCH download the given branch of the git repository
> + at URL"))
> + (format #t (G_ "
> + -r, --recursive download a git repository recursively"))
> +
> (newline)
> (display (G_ "
> -h, --help display this help and exit"))
> @@ -105,6 +194,13 @@ (define (show-help)
> (newline)
> (show-bug-report-information))
>
> +(define (add-git-download-option result)
> + (alist-cons 'download-proc
> + ;; XXX: #:verify-certificate? currently ignored.
> + (lambda* (url #:key verify-certificate? ref recursive?)
> + (git-download-to-store* url ref recursive?))
> + (alist-delete 'download result)))
> +
> (define %options
> ;; Specifications of the command-line options.
> (list (option '(#\f "format") #t #f
> @@ -136,11 +232,36 @@ (define fmt-proc
> (alist-cons 'verify-certificate? #f result)))
> (option '(#\o "output") #t #f
> (lambda (opt name arg result)
> - (alist-cons 'download-proc
> - (lambda* (url #:key verify-certificate?)
> - (download-to-file url arg))
> - (alist-delete 'download result))))
> -
> + (let* ((git
> + (assoc-ref result 'git-reference)))
> + (if git
> + (alist-cons 'download-proc
> + (lambda* (url #:key verify-certificate? ref recursive?)
> + (git-download-to-file url arg (assoc-ref result 'git-reference) recursive?))
> + (alist-delete 'download result))
> + (alist-cons 'download-proc
> + (lambda* (url #:key verify-certificate? #:allow-other-keys)
> + (download-to-file url arg))
> + (alist-delete 'download result))))))
> + (option '(#\g "git") #f #f
> + (lambda (opt name arg result)
> + ;; Ignore this option if 'commit' or 'branch' has
> + ;; already been provided
> + (if (assoc-ref result 'git-reference)
> + result
> + (alist-cons 'git-reference '()
> + (add-git-download-option result)))))
> + (option '("commit") #t #f
> + (lambda (opt name arg result)
> + (alist-cons 'git-reference `(tag-or-commit . ,arg)
> + (add-git-download-option result))))
> + (option '("branch") #t #f
> + (lambda (opt name arg result)
> + (alist-cons 'git-reference `(branch . ,arg)
> + (alist-delete 'git-reference result))))
> + (option '(#\r "recursive") #f #f
> + (lambda (opt name arg result)
> + (alist-cons 'recursive? #t result)))
> (option '(#\h "help") #f #f
> (lambda args
> (leave-on-EPIPE (show-help))
> @@ -183,12 +304,13 @@ (define (parse-options)
> (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) <>)))
> + (assq-ref opts 'verify-certificate?)
> + #:ref (assq-ref opts 'git-reference)
> + #:recursive? (assq-ref opts 'recursive?))))
> + (hash (let* ((path* (or path
> + (leave (G_ "~a: download failed~%")
> + arg))))
> + (file-hash* path* #:algorithm (assoc-ref opts 'hash-algorithm))))
Here also there are some too long lines in the above hunks; please break
long lines so they fit within the 80 characters limit.
> (fmt (assq-ref opts 'format)))
> (format #t "~a~%~a~%" path (fmt hash))
> #t)))
> diff --git a/tests/guix-download.sh b/tests/guix-download.sh
> index f4cb335eef..3bf63c4b12 100644
> --- a/tests/guix-download.sh
> +++ b/tests/guix-download.sh
> @@ -45,4 +45,46 @@ cmp "$output" "$abs_top_srcdir/README"
> # This one should fail.
> guix download "file:///does-not-exist" "file://$abs_top_srcdir/README" && false
>
> +# Test git support with local repository
Nitpick: please punctuate standalone comments (here, a missing period).
> +test_directory="$(mktemp -d)"
> +trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory" ; rm -f "$output"' EXIT
the 'chmod' doesn't seem to be useful; since we force removing with -f ?
And where did the $output variable come from?
> +
> +# Create a dummy git repo in the temporary directory
> +(
> + cd $test_directory
> + git init
> + touch test
> + git config user.name "User"
> + git config user.email "user <at> domain"
> + git add test
> + git commit -m "Commit"
> + git tag -a -m "v1" v1
> +)
> +
> +# Extract commit number
> +commit=$((cd $test_directory && git log) | head -n 1 | cut -f2 -d' ')
> +
> +# We expect that guix hash is working properly or at least that the output of
> +# 'guix download' is consistent with 'guix hash'
> +expected_hash=$(guix hash -rx $test_directory)
> +
> +# Test the different options
> +for option in "" "--commit=$commit" "--commit=v1" "--branch=master"
> +do
> + command_output="$(guix download --git $option "file://$test_directory")"
> + computed_hash="$(echo $command_output | cut -f2 -d' ')"
> + store_path="$(echo $command_output | cut -f1 -d' ')"
> + [ "$expected_hash" = "$computed_hash" ]
> + diff -r -x ".git" $test_directory $store_path
> +done
> +
> +# Should fail
> +guix download --git --branch=non_existent "file://$test_directory" && false
> +
> +# Same but download to file instead of store
> +tmpdir="t-archive-dir-$$"
> +trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory" ; rm -f "$output" ; rm -rf "$tmpdir"' EXIT
It'd look nicer if there was a single global trap call at the top of
these tests. Don't forget to punctuate your comments :-).
Otherwise, it looks good to me, although I haven't tried it.
--
Thanks,
Maxim
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.