From mboxrd@z Thu Jan 1 00:00:00 1970 From: Andy Wingo Subject: [PATCH] guix hash: -g hashes a git repository Date: Mon, 3 Apr 2017 21:58:37 +0200 Message-ID: <20170403195837.4504-1-wingo@igalia.com> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:43787) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cv88P-0004ai-W3 for guix-devel@gnu.org; Mon, 03 Apr 2017 15:59:31 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cv88L-0003fz-1r for guix-devel@gnu.org; Mon, 03 Apr 2017 15:59:30 -0400 Received: from pb-sasl2.pobox.com ([64.147.108.67]:61009 helo=sasl.smtp.pobox.com) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1cv88K-0003E4-Tp for guix-devel@gnu.org; Mon, 03 Apr 2017 15:59:24 -0400 Received: from sasl.smtp.pobox.com (unknown [127.0.0.1]) by pb-sasl2.pobox.com (Postfix) with ESMTP id 92F7C6E789 for ; Mon, 3 Apr 2017 15:58:48 -0400 (EDT) Received: from pb-sasl2.nyi.icgroup.com (unknown [127.0.0.1]) by pb-sasl2.pobox.com (Postfix) with ESMTP id 7A4AB6E788 for ; Mon, 3 Apr 2017 15:58:48 -0400 (EDT) Received: from clucks (unknown [88.160.190.192]) (using TLSv1 with cipher ECDHE-RSA-AES256-SHA (256/256 bits)) (No client certificate requested) by pb-sasl2.pobox.com (Postfix) with ESMTPSA id B67DA6E787 for ; Mon, 3 Apr 2017 15:58:46 -0400 (EDT) List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org * guix/scripts/hash.scm (show-help, %options): Add -g option. (guix-hash): Support hashing of Git URLs. * doc/guix.texi (Invoking guix hash): Document guix hash --git. --- doc/guix.texi | 18 ++++++++++++++++++ guix/scripts/hash.scm | 37 +++++++++++++++++++++++++++++-------- 2 files changed, 47 insertions(+), 8 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 8da82b4d8..7d35d9f45 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -5281,6 +5281,24 @@ $ git clone http://example.org/foo.git $ cd foo $ guix hash -rx . @end example + +Hashing a git repository 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. + +For example: +@example +$ git clone http://example.org/foo.git +$ guix hash -g foo +@end example + +Or even: +@example +$ guix hash -g http://example.org/foo.git +@end example @end table @node Invoking guix import diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index a048b5346..104a6a864 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) @@ -52,6 +53,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 +72,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 @@ -133,18 +141,31 @@ and 'hexadecimal' can be used as well).\n")) (negate vcs-file?) (const #t)))) + (define (recursive-hash file) + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port #:select? select?) + (force-output port) + (get-hash))) + (define (file-hash file) ;; 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?) + (call-with-temporary-directory + (lambda (dir) + (let ((checkout (in-vicinity dir "git-checkout"))) + (unless (zero? (system* "git" "clone" "--" file checkout)) + (leave (_ "git clone failed~%"))) + (pk "git" "clone" file checkout) + (recursive-hash checkout))))) + ((assoc-ref opts 'recursive?) + (recursive-hash file)) + (else + (match file + ("-" (port-sha256 (current-input-port))) + (_ (call-with-input-file file port-sha256))))))) (match args ((file) -- 2.12.2