From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:39821) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d2l6m-0003Lx-7l for guix-patches@gnu.org; Mon, 24 Apr 2017 17:01:27 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d2l6i-0003vs-AX for guix-patches@gnu.org; Mon, 24 Apr 2017 17:01:20 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:40308) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d2l6i-0003vV-4E for guix-patches@gnu.org; Mon, 24 Apr 2017 17:01:16 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d2l6h-0004dB-Rx for guix-patches@gnu.org; Mon, 24 Apr 2017 17:01:15 -0400 Subject: bug#26645: [PATCH 2/9] guix hash: Add --git option to hash a git checkout. Resent-Message-ID: From: Andy Wingo Date: Mon, 24 Apr 2017 22:59:16 +0200 Message-Id: <20170424205923.27726-2-wingo@igalia.com> In-Reply-To: <20170424205923.27726-1-wingo@igalia.com> References: <20170424205923.27726-1-wingo@igalia.com> List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: 26645@debbugs.gnu.org * guix/scripts/hash.scm (show-help, %options): Add -g option. (vcs-file?): Pull out to top. (guix-hash-git-checkout): New function. (guix-hash): Support hashing of Git URLs. * doc/guix.texi (Invoking guix hash): Document guix hash --git. --- doc/guix.texi | 17 +++++++++++++ guix/scripts/hash.scm | 67 ++++++++++++++++++++++++++++++++++++--------------- 2 files changed, 65 insertions(+), 19 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 0d334e302..7f1074f9d 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5384,6 +5384,23 @@ $ git clone http://example.org/foo.git $ cd foo $ guix hash -rx . @end example + +Hashing a git checkout is so common that it has its own alias: + +@item --git +@itemx -g +Clones the git repository at @var{file} into a temporary directory and +recursively hashes it, excluding the @file{.git} subdirectory. This is +mainly useful if you want to get the Guix hash of the current Git +checkout: + +@example +$ git clone http://example.org/foo.git +$ cd foo +# Hack a bunch of things, make some commits +$ guix hash -g . +@end example + @end table @node Invoking guix import diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index a048b5346..f1ac3c38a 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -25,6 +25,7 @@ #:use-module (guix ui) #:use-module (guix scripts) #:use-module (guix base16) + #:use-module (guix utils) #:use-module (ice-9 binary-ports) #:use-module (rnrs files) #:use-module (ice-9 match) @@ -32,7 +33,8 @@ #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) - #:export (guix-hash)) + #:export (guix-hash-git-checkout + guix-hash)) ;;; @@ -52,6 +54,9 @@ and 'hexadecimal' can be used as well).\n")) (format #t (_ " -x, --exclude-vcs exclude version control directories")) (format #t (_ " + -g, --git clone the git repository at FILE and hash it + (implies -r)")) + (format #t (_ " -f, --format=FMT write the hash in the given format")) (format #t (_ " -r, --recursive compute the hash on FILE recursively")) @@ -68,6 +73,10 @@ and 'hexadecimal' can be used as well).\n")) (list (option '(#\x "exclude-vcs") #f #f (lambda (opt name arg result) (alist-cons 'exclude-vcs? #t result))) + (option '(#\g "git") #f #f + (lambda (opt name arg result) + (alist-cons 'git? #t + (alist-cons 'exclude-vcs? #t result)))) (option '(#\f "format") #t #f (lambda (opt name arg result) (define fmt-proc @@ -98,6 +107,35 @@ and 'hexadecimal' can be used as well).\n")) ;;; +;;; Helpers. +;;; + +(define (vcs-file? file stat) + (case (stat:type stat) + ((directory) + (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) + ((regular) + ;; Git sub-modules have a '.git' file that is a regular text file. + (string=? (basename file) ".git")) + (else + #f))) + +(define* (recursive-hash file #:key (select? (const #t))) + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port #:select? select?) + (force-output port) + (get-hash))) + +(define (guix-hash-git-checkout directory) + (call-with-temporary-directory + (lambda (dir) + (let ((checkout (in-vicinity dir "git-checkout"))) + (unless (zero? (system* "git" "clone" "--" directory checkout)) + (leave (_ "git clone failed~%"))) + (recursive-hash checkout #:select? (negate vcs-file?)))))) + + +;;; ;;; Entry point. ;;; @@ -112,16 +150,6 @@ and 'hexadecimal' can be used as well).\n")) (alist-cons 'argument arg result)) %default-options)) - (define (vcs-file? file stat) - (case (stat:type stat) - ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) - ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) - (else - #f))) - (let* ((opts (parse-options)) (args (filter-map (match-lambda (('argument . value) @@ -137,14 +165,15 @@ and 'hexadecimal' can be used as well).\n")) ;; Compute the hash of FILE. ;; Catch and gracefully report possible '&nar-error' conditions. (with-error-handling - (if (assoc-ref opts 'recursive?) - (let-values (((port get-hash) (open-sha256-port))) - (write-file file port #:select? select?) - (force-output port) - (get-hash)) - (match file - ("-" (port-sha256 (current-input-port))) - (_ (call-with-input-file file port-sha256)))))) + (cond + ((assoc-ref opts 'git?) + (guix-hash-git-checkout file)) + ((assoc-ref opts 'recursive?) + (recursive-hash file #:select? select)) + (else + (match file + ("-" (port-sha256 (current-input-port))) + (_ (call-with-input-file file port-sha256))))))) (match args ((file) -- 2.12.2