summaryrefslogtreecommitdiff
path: root/guix/hash.scm
diff options
context:
space:
mode:
authorSarah Morgensen <iskarian@mgsn.dev>2022-01-05 14:07:47 +0000
committerLudovic Courtès <ludo@gnu.org>2022-01-06 16:27:30 +0100
commit064c367716f88b7662b6b8e0d9dbd5eab941c25f (patch)
tree0a5756bada17a56ab0b6bf985613cfd86d0bac4f /guix/hash.scm
parent0701efb351b36984d5ffd356e8de323e49603680 (diff)
guix hash: Extract file hashing procedures.
* guix/scripts/hash.scm (guix-hash)[vcs-file?] (nar-hash, default-hash): Extract hashing logic to... * guix/hash.scm (vcs-file?, file-hash*): ... these new procedures in this new file. Modified-by: Maxime Devos <maximedevos@telenet.be> Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Diffstat (limited to 'guix/hash.scm')
-rw-r--r--guix/hash.scm73
1 files changed, 73 insertions, 0 deletions
diff --git a/guix/hash.scm b/guix/hash.scm
new file mode 100644
index 0000000000..3cb68e5c44
--- /dev/null
+++ b/guix/hash.scm
@@ -0,0 +1,73 @@
+;;; 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.
+
+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)))