bug#65979: incorrect “guix hash” for FastQC

[Simon Tournier]

Hi Ludo,

On Tue, 26 Sep 2023 at 15:34, Ludovic Courtès <ludo@gnu.org> wrote:

> My take is that it’s OK to keep ‘vcs-file?’ as is: the best we could do
> would be to add complicated heuristics in the hope corner cases like
> this one would be better dealt with, but it wouldn’t be bullet-proof
> anyway.

Hum, I am probably pig-headed here. :-)

I propose the change below.  Well, it does not appear to me a
complicated heuristics but I am biased.  The idea is to detect at the
repository root what is the kind of VCS, just by checking if .git (or
.hg or .svn or etc.) exists or not.  Then, only exclude this kind… and
not the whole list.

And I think this way is almost bullet-proof, no?  Or could you provide
some contrived examples?

WDYT?

Obviously, this fixes the issue:

--8<---------------cut here---------------start------------->8---
$ guix hash -rx /tmp/FastQC
0jyk90kg6s62w3dn6qjx9nrawjs12qx172lii0yxbvsfylhnx479

$ ./pre-inst-env guix hash -rx /tmp/FastQC
00y9drm0bkpxw8xfl8ysss18jmnhj8blgqgr6fpa58rkpfcbg8qk

$ grep -A 15 'define-public fastqc' gnu/packages/bioinformatics.scm | grep -C 1 
base32
       (sha256
        (base32
         "00y9drm0bkpxw8xfl8ysss18jmnhj8blgqgr6fpa58rkpfcbg8qk"))
--8<---------------cut here---------------end--------------->8---

And I do not observe a regression using a couple of tests.

Cheers,
simon




>From 1bf6555e6a89248f079437b842dbaff9c107de9a Mon Sep 17 00:00:00 2001
Message-Id: 
<1bf6555e6a89248f079437b842dbaff9c107de9a.1697562942.git.zimon.toutoune@gmail.com>
From: Simon Tournier <zimon.toutoune@gmail.com>
Date: Tue, 17 Oct 2023 18:53:04 +0200
Subject: [PATCH] scripts: hash: Handle repository several VCS folders.

Fixes <https://issues.guix.gnu.org/issue/65979>.
Reported by Simon Tournier <zimon.toutoune@gmail.com>

* guix/hash.scm (vcs-file?): Add optional argument for passing VCS kind of the
file/repository.
(file-hash*): Adjust accordingly.
* guix/scripts/hash.scm (guix-hash)[file-hash]: Detect VCS kind of the
file/repository and passes it.
---
 guix/hash.scm         | 18 ++++++++++++------
 guix/scripts/hash.scm | 18 +++++++++++++-----
 2 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/guix/hash.scm b/guix/hash.scm
index 3cb68e5c44..8fff51e8f1 100644
--- a/guix/hash.scm
+++ b/guix/hash.scm
@@ -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.
 ;;;
@@ -25,21 +26,26 @@ (define-module (guix hash)
   #:export (vcs-file?
             file-hash*))
 
-(define (vcs-file? file stat)
-  "Returns true if FILE is a version control system file."
+(define* (vcs-file? file stat
+                    #:optional
+                    (vcses (list ".bzr" ".git" ".hg" ".svn" "CVS")))
+  "Returns true if FILE matches a version control system from the list VCSES."
   (case (stat:type stat)
     ((directory)
-     (member (basename file) '(".bzr" ".git" ".hg" ".svn" "CVS")))
+     (member (basename file) vcses))
     ((regular)
-     ;; Git sub-modules have a '.git' file that is a regular text file.
-     (string=? (basename file) ".git"))
+     (if (member ".git" vcses)
+         ;; Git sub-modules have a '.git' file that is a regular text file.
+         (string=? (basename file) ".git")
+         #f))
     (else
      #f)))
 
 (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.
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index 7197d3965c..ed96e6a7e1 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -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-command (guix-hash . args)
                             (_ #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,18 @@ (define-command (guix-hash . args)
       (catch 'system-error
         (lambda _
           (with-error-handling
-            (serializer file algorithm select?)))
+            (let* ((vcses (fold (lambda (vcs result)
+                                  (if (file-exists? (string-append file "/" 
vcs))
+                                      (cons vcs result)
+                                      result))
+                                '()
+                                (list ".bzr" ".git" ".hg" ".svn" "CVS")))
+                   (select? (if (assq-ref opts 'exclude-vcs?)
+                                (negate (lambda (file stat)
+                                          (vcs-file? file stat
+                                                     vcses)))
+                                (const #t))))
+              (serializer file algorithm select?))))
         (lambda args
           (leave (G_ "~a ~a~%")
                  file

base-commit: dcc5c34504c94732c135a85fb4db40ca9796270e
-- 
2.38.1