GNU bug report logs - #66961
[PATCH] scripts: hash: Handle repository with different VCS folders.

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 66961 in the body.
You can then email your comments to 66961 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: guix-patches <at> gnu.org
Cc: Simon Tournier <zimon.toutoune <at> gmail.com>
Subject: [PATCH] scripts: hash: Handle repository with different VCS folders.
Date: Mon,  6 Nov 2023 00:00:55 +0100

Fixes <https://issues.guix.gnu.org/issue/65979>.
Reported by Simon Tournier <zimon.toutoune <at> 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.

Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa
---
 guix/hash.scm         | 18 ++++++++++++------
 guix/scripts/hash.scm | 18 +++++++++++++-----
 2 files changed, 25 insertions(+), 11 deletions(-)

Hi,

I re-resend this patch for more attractions in case I have missed
something. :-)  It had already been send more than 2 weeks ago as an answer to
#65979.

It fixes a corner case of "guix hash".

--8<---------------cut here---------------start------------->8---
$ git clone https://github.com/s-andrews/FastQC /tmp/FastQC
$ git -C /tmp/FastQC/ checkout v0.11.9

$ find /tmp/FastQC/ -type d -name ".git" -print
/tmp/FastQC/.git
$ find /tmp/FastQC/ -type d -name ".svn" -print
/tmp/FastQC/Help/1 Introduction/.svn
/tmp/FastQC/Help/3 Analysis Modules/.svn
/tmp/FastQC/Help/2 Basic Operations/.svn

$ guix hash -rx /tmp/FastQC
0jyk90kg6s62w3dn6qjx9nrawjs12qx172lii0yxbvsfylhnx479

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

$ ./pre-inst-env guix hash -rx /tmp/FastQC
00y9drm0bkpxw8xfl8ysss18jmnhj8blgqgr6fpa58rkpfcbg8qk
--8<---------------cut here---------------end--------------->8---

And it does not introduce any significant penalty:

--8<---------------cut here---------------start------------->8---
$ time guix hash -rx .
093w70scf2v64bdbln5m2xjm63pzfib903w1mcb2smj32g0w8y63

real	0m9.730s
user	0m20.468s
sys	0m1.487s

$ time ./pre-inst-env guix hash -rx .
093w70scf2v64bdbln5m2xjm63pzfib903w1mcb2smj32g0w8y63

real	0m9.632s
user	0m20.320s
sys	0m1.541s
--8<---------------cut here---------------end--------------->8---


WDYT?

Cheers,
simon


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 <at> mgsn.dev>
 ;;; Copyright © 2022 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune <at> 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 <at> karetnikov.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke <at> gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen <at> yahoo.de>
-;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
+;;; Copyright © 2021, 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian <at> 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: 08d94fe20eca47b69678b3eced8749dd02c700a4
-- 
2.41.0

Message #8 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Simon Tournier <zimon.toutoune <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH] scripts: hash: Handle repository with
 different VCS folders.
Date: Tue, 14 Nov 2023 14:44:52 +0100

Hi!

Simon Tournier <zimon.toutoune <at> gmail.com> skribis:

> Fixes <https://issues.guix.gnu.org/issue/65979>.
> Reported by Simon Tournier <zimon.toutoune <at> 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.
>
> Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa

[...]

> +(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."

How about ‘vcs-directories’ rather than ‘vcses’?

Also, you can add:

  (define %known-vcs-directories
    '(".bzr" …))

and use it to avoid repeating it.

> +            (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))))

Maybe you can have:

  (define (vcs-predicate directory)
    (define directories
      (filter (lambda (metadata-directory)
                (file-exists? (in-vicinity directory metadata-directory)))
              %known-vcs-directories))

    (lambda (file stat)
      (vcs-file? file stat directories)))

and then use that above?  (That way we don’t stat these things when
‘exclude-vcs?’ is #false.)

Thanks,
Ludo’.

Message #11 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: 66961 <at> debbugs.gnu.org
Cc: Simon Tournier <zimon.toutoune <at> gmail.com>
Subject: [PATCH v2] scripts: hash: Handle repository with different VCS
 folders.
Date: Wed, 29 Nov 2023 21:31:00 +0100

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

* 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-exclude?): New procedure and export it.
* guix/scripts/hash.scm (guix-hash): Use it.

Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa
---
 guix/hash.scm         | 34 ++++++++++++++++++++++++++++------
 guix/scripts/hash.scm |  2 +-
 2 files changed, 29 insertions(+), 7 deletions(-)

diff --git a/guix/hash.scm b/guix/hash.scm
index 3cb68e5c44..650def0696 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 <at> mgsn.dev>
 ;;; Copyright © 2022 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,23 +24,44 @@ (define-module (guix hash)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:export (vcs-file?
+            vcs-exclude?
             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-exclude? directory)
+  "Return a procedure excluding content if DIRECTORY contains supported VCS."
+  (define vcs-directories
+    (filter (lambda (vcs)
+              (file-exists? (in-vicinity directory vcs)))
+            %vcs-directories))
+
+  (lambda (file stat)
+    (not (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.
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index 7197d3965c..b6af9d5649 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -182,7 +182,7 @@ (define-command (guix-hash . args)
                            (reverse opts)))
          (fmt  (assq-ref opts 'format))
          (select? (if (assq-ref opts 'exclude-vcs?)
-                      (negate vcs-file?)
+                      (vcs-exclude? file)
                       (const #t)))
          (algorithm (assoc-ref opts 'hash-algorithm))
          (serializer (assoc-ref opts 'serializer)))

base-commit: cd46757c1a0f886848fbb6828c028dd2a2532767
-- 
2.41.0

Message #14 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: 66961 <at> debbugs.gnu.org
Cc: Simon Tournier <zimon.toutoune <at> gmail.com>
Subject: [PATCH v3] scripts: hash: Handle repository with different VCS
 folders.
Date: Wed, 29 Nov 2023 21:54:03 +0100

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

* 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-exclude?): New procedure and export it.
* guix/scripts/hash.scm (guix-hash)[file-hash]: Use it.

Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa
---
 guix/hash.scm         | 34 ++++++++++++++++++++++++++++------
 guix/scripts/hash.scm | 10 +++++-----
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/guix/hash.scm b/guix/hash.scm
index 3cb68e5c44..650def0696 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 <at> mgsn.dev>
 ;;; Copyright © 2022 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,23 +24,44 @@ (define-module (guix hash)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:export (vcs-file?
+            vcs-exclude?
             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-exclude? directory)
+  "Return a procedure excluding content if DIRECTORY contains supported VCS."
+  (define vcs-directories
+    (filter (lambda (vcs)
+              (file-exists? (in-vicinity directory vcs)))
+            %vcs-directories))
+
+  (lambda (file stat)
+    (not (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.
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index 7197d3965c..8982bb37b9 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2013 Nikita Karetnikov <nikita <at> karetnikov.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke <at> gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen <at> yahoo.de>
-;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
+;;; Copyright © 2021, 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian <at> 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,10 @@ (define-command (guix-hash . args)
       (catch 'system-error
         (lambda _
           (with-error-handling
-            (serializer file algorithm select?)))
+            (let ((select? (if (assq-ref opts 'exclude-vcs?)
+                               (vcs-exclude? file)
+                               (const #t))))
+              (serializer file algorithm select?))))
         (lambda args
           (leave (G_ "~a ~a~%")
                  file

base-commit: cd46757c1a0f886848fbb6828c028dd2a2532767
-- 
2.41.0

Message #17 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH] scripts: hash: Handle repository with
 different VCS folders.
Date: Wed, 29 Nov 2023 21:36:31 +0100

Hi Ludo,

On mar., 14 nov. 2023 at 14:44, Ludovic Courtès <ludo <at> gnu.org> wrote:

> How about ‘vcs-directories’ rather than ‘vcses’?
>
> Also, you can add:
>
>   (define %known-vcs-directories
>     '(".bzr" …))
>
> and use it to avoid repeating it.

[...]

> Maybe you can have:
>
>   (define (vcs-predicate directory)
>     (define directories
>       (filter (lambda (metadata-directory)
>                 (file-exists? (in-vicinity directory metadata-directory)))
>               %known-vcs-directories))
>
>     (lambda (file stat)
>       (vcs-file? file stat directories)))
>
> and then use that above?  (That way we don’t stat these things when
> ‘exclude-vcs?’ is #false.)

Thanks for the feedback.  See v2.

Cheers,
simon

PS: Sorry, I have sent twice v2; missed an option with my new
experimental setup. :-)

Message #20 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH] scripts: hash: Handle repository with
 different VCS folders.
Date: Wed, 29 Nov 2023 21:52:56 +0100

On mer., 29 nov. 2023 at 21:36, Simon Tournier <zimon.toutoune <at> gmail.com> wrote:

> Thanks for the feedback.  See v2.

[...]

> PS: Sorry, I have sent twice v2; missed an option with my new
> experimental setup. :-)

Sorry for the mess.  I have sent the correct one; v2 is obviously-
broken.  Therefore, please see v3.  Again sorry for the mess.

Cheers,
simon

Message #23 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Simon Tournier <zimon.toutoune <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH v3] scripts: hash: Handle repository with
 different VCS folders.
Date: Sat, 02 Dec 2023 11:39:51 +0100

Hi,

Simon Tournier <zimon.toutoune <at> gmail.com> skribis:

> Fixes <https://issues.guix.gnu.org/issue/65979>.
> Reported by Simon Tournier <zimon.toutoune <at> gmail.com>
>
> * 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-exclude?): New procedure and export it.
> * guix/scripts/hash.scm (guix-hash)[file-hash]: Use it.
>
> Change-Id: I8e286c3426ddefd664dc3a471d5a09e309824faa

[...]

> +(define (vcs-exclude? directory)
> +  "Return a procedure excluding content if DIRECTORY contains supported VCS."

Nitpick: I would call it ‘vcs-file-predicate’ for consistency, with
a docstring along these lines:

  Return a two-argument procedure that returns true for version-control
  metadata directories such as '.git' found in DIRECTORY.

> +  (lambda (file stat)
> +    (not (vcs-file? file stat vcs-directories))))

… and thus removing ‘not’ here

> +            (let ((select? (if (assq-ref opts 'exclude-vcs?)
> +                               (vcs-exclude? file)

… and changing the above to (negate (vcs-file-predicate file)).

(“Return #t for VCS files” sounds clearer to me than “return true except
for VCS files” in terms of API design.)

OK with these changes!

Thanks,
Ludo’.

Message #26 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: 66961 <at> debbugs.gnu.org
Cc: Simon Tournier <zimon.toutoune <at> gmail.com>
Subject: [PATCH v4] scripts: hash: Handle repository with different VCS
 folders.
Date: Sat,  2 Dec 2023 14:11:20 +0100

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

* 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
---
 guix/hash.scm         | 35 +++++++++++++++++++++++++++++------
 guix/scripts/hash.scm | 10 +++++-----
 2 files changed, 34 insertions(+), 11 deletions(-)

diff --git a/guix/hash.scm b/guix/hash.scm
index 3cb68e5c44..81f35d63df 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 <at> mgsn.dev>
 ;;; Copyright © 2022 Maxime Devos <maximedevos <at> telenet.be>
+;;; Copyright © 2023 Simon Tournier <zimon.toutoune <at> 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.
diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm
index 7197d3965c..dec037ed3f 100644
--- a/guix/scripts/hash.scm
+++ b/guix/scripts/hash.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2013 Nikita Karetnikov <nikita <at> karetnikov.org>
 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke <at> gnu.org>
 ;;; Copyright © 2018 Tim Gesthuizen <tim.gesthuizen <at> yahoo.de>
-;;; Copyright © 2021 Simon Tournier <zimon.toutoune <at> gmail.com>
+;;; Copyright © 2021, 2023 Simon Tournier <zimon.toutoune <at> gmail.com>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian <at> 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,10 @@ (define-command (guix-hash . args)
       (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

base-commit: aeb494322ca9dec4a4d66a7d063239c8536bd538
-- 
2.41.0

Message #29 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH v3] scripts: hash: Handle repository with
 different VCS folders.
Date: Sat, 02 Dec 2023 14:10:24 +0100

Hi,

On sam., 02 déc. 2023 at 11:39, Ludovic Courtès <ludo <at> gnu.org> wrote:

> Nitpick: I would call it ‘vcs-file-predicate’ for consistency,

Hum, I thought the convention for ’predicate’ was ending by ’?’.
Therefore, personally I do not find this name consistent.  Anyway…

>                                                                with
> a docstring along these lines:
>
>   Return a two-argument procedure that returns true for version-control
>   metadata directories such as '.git' found in DIRECTORY.

…did that way in v4.

Thanks for your comments.


Cheers,
simon

Message #32 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Simon Tournier <zimon.toutoune <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH v4] scripts: hash: Handle repository with
 different VCS folders.
Date: Fri, 22 Dec 2023 17:19:12 +0100

Hi,

Simon Tournier <zimon.toutoune <at> gmail.com> skribis:

> Fixes <https://issues.guix.gnu.org/issue/65979>.
> Reported by Simon Tournier <zimon.toutoune <at> gmail.com>
>
> * 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

Sorry for the long delay—LGTM!

Thanks,
Ludo’.

Message #35 received at 66961 <at> debbugs.gnu.org (full text, mbox):

From: Simon Tournier <zimon.toutoune <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 66961 <at> debbugs.gnu.org,
 Ricardo Wurmus <rekado <at> elephly.net>, Christopher Baines <guix <at> cbaines.net>
Subject: Re: [bug#66961] [PATCH v4] scripts: hash: Handle repository with
 different VCS folders.
Date: Tue, 23 Jul 2024 16:35:01 +0200

Hi,

On Fri, 22 Dec 2023 at 17:19, Ludovic Courtès <ludo <at> gnu.org> wrote:

> Sorry for the long delay—LGTM!

Longer delay for pushing. :-)

Done with d007b64356764f49677c78d82643f1125b5353b7.

Cheers,
simon

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.