ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

scripts: hash: Handle repository with different VCS folders.

Browse source 
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:
Simon Tournier 2023-12-02 14:11:20 +01:00
parent ffdcef5f36
commit d007b64356
No known key found for this signature in database
GPG key ID: 92F1D22C608EE7E5
2 changed files with 34 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

35
guix/hash.scm
View file

@ -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)
;; 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.

10
guix/scripts/hash.scm
View file

@ -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