1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix hash)
#:use-module (gcrypt hash)
#:use-module (guix serialization)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:export (vcs-file?
file-hash*))
(define (vcs-file? file stat)
"Returns true if FILE is a version control system file."
(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* (file-hash* file #:key
(algorithm (hash-algorithm sha256))
(recursive? 'auto)
(select? (negate vcs-file?)))
"Compute the hash of FILE with ALGORITHM. If RECURSIVE? is #true or 'auto',
recurse into subdirectories of FILE, computing the combined hash (nar hash) of
all files for which (SELECT? FILE STAT) returns true.
Symbolic links are not dereferenced unless RECURSIVE? is false.
This procedure must only be used under controlled circumstances;
the detection of symbolic links in FILE is racy.
Keep in mind that the hash of a regular file depends on RECURSIVE?:
if the recursive hash is desired, it must be set to #true. Otherwise, it must
be set to #false or 'auto'. In most situations, the non-recursive hash is desired
for regular files."
(if (or (eq? recursive? #true)
(and (eq? recursive? 'auto)
;; Don't change this to (eq? 'directory ...), because otherwise
;; if 'file' denotes a symbolic link, the 'file-hash' below
;; would dereference it -- dereferencing symbolic links would
;; open an avoidable can of potential worms.
(not (eq? 'regular (stat:type (lstat file))))))
(let-values (((port get-hash)
(open-hash-port algorithm)))
(write-file file port #:select? select?)
(force-output port)
(get-hash))
(file-hash algorithm file)))
|