From debbugs-submit-bounces@debbugs.gnu.org Mon Aug 30 12:40:39 2021 Received: (at submit) by debbugs.gnu.org; 30 Aug 2021 16:40:39 +0000 Received: from localhost ([127.0.0.1]:60082 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mKkKo-0001qj-TR for submit@debbugs.gnu.org; Mon, 30 Aug 2021 12:40:39 -0400 Received: from lists.gnu.org ([209.51.188.17]:59272) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1mKkKj-0001qS-O7 for submit@debbugs.gnu.org; Mon, 30 Aug 2021 12:40:33 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:49956) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mKkKj-0006YC-H0 for guix-patches@gnu.org; Mon, 30 Aug 2021 12:40:29 -0400 Received: from mx1.dismail.de ([78.46.223.134]:14469) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1mKkKg-0001QC-RR for guix-patches@gnu.org; Mon, 30 Aug 2021 12:40:29 -0400 Received: from mx1.dismail.de (localhost [127.0.0.1]) by mx1.dismail.de (OpenSMTPD) with ESMTP id 70d5e8be; Mon, 30 Aug 2021 18:40:21 +0200 (CEST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed; d=dismail.de; h=from:to:cc :subject:date:message-id:mime-version:content-transfer-encoding; s=20190914; bh=uXbsGUGimnq1e+dyokYSl2B2iVQ1xmogC+gY5WbfHC4=; b= vqNMeW5tcpvw/Lqp7O6Nk5gBJdqela8Bzg+JR6kD4o4WgtjNuXJZ8WjGBjYtO/Ce aSbT2aq+XVdImfj2IkDZeW9ggR03xdGYdKmkk9W9UpXMO6j8Ay0LrEDmRuoIunLN TfwoOpAGXuJBCaYorJmkL9ohLzJl8s283ooHcWRtQGkmg4J3DhsH8X20MQ6G98hY zZFnpRNUtb+qBGnP0RzvsDV51wDNTJXNAMpSXBa9ZzN4p+mlpRsfwnO4L98zP0l6 3zvIBGZQK2uHDgaSmbo+XdepImvYXnqvVOV4TvIrYnrgX9OaLiN9bX0kZvtlg1if 7YemQuttJIAH8p2MOiJrBQ== Received: from smtp2.dismail.de ( [10.240.26.12]) by mx1.dismail.de (OpenSMTPD) with ESMTP id d6fcb696; Mon, 30 Aug 2021 18:40:21 +0200 (CEST) Received: from smtp2.dismail.de (localhost [127.0.0.1]) by smtp2.dismail.de (OpenSMTPD) with ESMTP id c06078a3; Mon, 30 Aug 2021 18:40:21 +0200 (CEST) Received: by dismail.de (OpenSMTPD) with ESMTPSA id 8335a0ed (TLSv1.3:AEAD-AES256-GCM-SHA384:256:NO); Mon, 30 Aug 2021 18:40:20 +0200 (CEST) From: jgart To: guix-patches@gnu.org Subject: [PATCH] guix: git: Adds feature to download git repository to the store. Date: Mon, 30 Aug 2021 12:39:19 -0400 Message-Id: <20210830163918.19419-1-jgart@dismail.de> X-Mailer: git-send-email 2.33.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit Received-SPF: pass client-ip=78.46.223.134; envelope-from=jgart@dismail.de; helo=mx1.dismail.de X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, RCVD_IN_DNSWL_LOW=-0.7, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: -1.4 (-) X-Debbugs-Envelope-To: submit Cc: Julien Lepiller X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -2.4 (--) From: Julien Lepiller * 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