mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-25 05:48:07 -05:00
scripts: hash: Handle repository with different VCS folders.
Fixes <https://issues.guix.gnu.org/issue/65979>. * guix/hash.scm (%vcs-directories): New variable. (vcs-file?): Add optional argument for passing VCS kind of the file/repository. (file-hash*): Adjust accordingly. (vcs-file-predicate): New procedure and export it. * guix/scripts/hash.scm (guix-hash)[file-hash]: Use it. Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa
This commit is contained in:
parent
ffdcef5f36
commit
d007b64356
2 changed files with 34 additions and 11 deletions
|
@ -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 @@ (define-module (guix hash)
|
|||
#: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)
|
||||
(if (member ".git" vcs-directories)
|
||||
;; Git sub-modules have a '.git' file that is a regular text file.
|
||||
(string=? (basename file) ".git"))
|
||||
(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.
|
||||
|
|
|
@ -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 @@ (define (parse-options)
|
|||
(_ #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 @@ (define (file-hash file)
|
|||
(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
|
||||
|
|
Loading…
Reference in a new issue