unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
blob 81f35d63df704804c2776bd05c2bf7b4584db6b1 3970 bytes (raw)
name: guix/hash.scm 	 # note: path name is non-authoritative(*)

 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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
 
;;; 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.
;;;
;;; 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?
            vcs-file-predicate
            file-hash*))

(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) 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")
         #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 (lambda (file stat)
                                        (vcs-file? file stat)))))
  "Compute the hash of FILE with ALGORITHM.

Symbolic links are only dereferenced if RECURSIVE? is false.
Directories are only supported if RECURSIVE? is #true or 'auto'.
The executable bit is only recorded if RECURSIVE? is #true.
If FILE is a symbolic link, it is only followed if RECURSIVE? is false.

For regular files, there are two different hashes when the executable
hash isn't recorded: the regular hash and the nar hash. In most situations,
the regular hash is desired and setting RECURSIVE? to 'auto' does the right
thing for both regular files and directories.

This procedure must only be used under controlled circumstances;
the detection of symbolic links in FILE is racy.

When FILE is a directory, the procedure SELECT? called as (SELECT? FILE STAT)
decides which files to include. By default, version control files are
excluded. To include everything, SELECT? can be set to (const #true)."
  (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)))

debug log:

solving 81f35d63df ...
found 81f35d63df in https://yhetil.org/guix-patches/eb84353cf679b77019db31e243354632a24b996e.1701522007.git.zimon.toutoune@gmail.com/
found 3cb68e5c44 in https://git.savannah.gnu.org/cgit/guix.git
preparing index
index prepared:
100644 3cb68e5c44c4f4631a1f2ee6539481d734143f06	guix/hash.scm

applying [1/1] https://yhetil.org/guix-patches/eb84353cf679b77019db31e243354632a24b996e.1701522007.git.zimon.toutoune@gmail.com/
diff --git a/guix/hash.scm b/guix/hash.scm
index 3cb68e5c44..81f35d63df 100644

Checking patch guix/hash.scm...
Applied patch guix/hash.scm cleanly.

index at:
100644 81f35d63df704804c2776bd05c2bf7b4584db6b1	guix/hash.scm

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).