diff options
| -rw-r--r-- | guix/hash.scm | 35 | ||||
| -rw-r--r-- | guix/scripts/hash.scm | 10 |
2 files changed, 34 insertions, 11 deletions
diff --git a/guix/hash.scm b/guix/hash.scm index 3cb68e5c44..81f35d63df 100644 --- a/guix/hash.scm +++ b/guix/hash.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be> +;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,23 +24,45 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:export (vcs-file? + vcs-file-predicate file-hash*)) -(define (vcs-file? file stat) - "Returns true if FILE is a version control system file." +(define %vcs-directories + ;; Directory used for determining the kind of VCS. + (list ".bzr" ".git" ".hg" ".svn" "CVS")) + +(define* (vcs-file? file stat + #:optional + (vcs-directories %vcs-directories)) + "Return true if FILE matches a version control system from the list +VCSES-DIRECTORIES." (case (stat:type stat) ((directory) - (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS"))) + (member (basename file) vcs-directories)) ((regular) - ;; Git sub-modules have a '.git' file that is a regular text file. - (string=? (basename file) ".git")) + (if (member ".git" vcs-directories) + ;; Git sub-modules have a '.git' file that is a regular text file. + (string=? (basename file) ".git") + #f)) (else #f))) +(define (vcs-file-predicate directory) + "Return a two-argument procedure that returns true when version-control +metadata directories such as '.git' is found in DIRECTORY." + (define vcs-directories + (filter (lambda (vcs) + (file-exists? (in-vicinity directory vcs))) + %vcs-directories)) + + (lambda (file stat) + (vcs-file? file stat vcs-directories))) + (define* (file-hash* file #:key (algorithm (hash-algorithm sha256)) (recursive? 'auto) - (select? (negate vcs-file?))) + (select? (negate (lambda (file stat) + (vcs-file? file stat))))) "Compute the hash of FILE with ALGORITHM. Symbolic links are only dereferenced if RECURSIVE? is false. diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index 7197d3965c..dec037ed3f 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -3,7 +3,7 @@ ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen@yahoo.de> -;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com> +;;; Copyright © 2021, 2023 Simon Tournier <zimon.toutoune@gmail.com> ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev> ;;; ;;; This file is part of GNU Guix. @@ -181,9 +181,6 @@ use '--serializer=nar' instead~%"))) (_ #f)) (reverse opts))) (fmt (assq-ref opts 'format)) - (select? (if (assq-ref opts 'exclude-vcs?) - (negate vcs-file?) - (const #t))) (algorithm (assoc-ref opts 'hash-algorithm)) (serializer (assoc-ref opts 'serializer))) @@ -193,7 +190,10 @@ use '--serializer=nar' instead~%"))) (catch 'system-error (lambda _ (with-error-handling - (serializer file algorithm select?))) + (let ((select? (if (assq-ref opts 'exclude-vcs?) + (negate (vcs-file-predicate file)) + (const #t)))) + (serializer file algorithm select?)))) (lambda args (leave (G_ "~a ~a~%") file |