git authenticate: Upgrade pre-push hook with a fixed version.

Partly fixes <https://issues.guix.gnu.org/74583>.

* guix/scripts/git/authenticate.scm (%pre-push-hook): New variable.
(install-hooks): Use it.
(broken-pre-push-hook?, maybe-upgrade-hooks): New procedures.
(guix-git-authenticate): Call ‘maybe-upgrade-hooks’ when ‘configured?’
returns true.

Change-Id: I39d34ab66ffe0f34170c0f562e9f97f2f69c9fdc

1 files changed, 65 insertions, 13 deletions

diff --git a/guix/scripts/git/authenticate.scm b/guix/scripts/git/authenticate.scm
index d202b6cc7a..3bc72a70b1 100644
--- a/guix/scripts/git/authenticate.scm
+++ b/guix/scripts/git/authenticate.scm
@@ -26,8 +26,10 @@
   #:use-module ((guix channels) #:select (openpgp-fingerprint))
   #:use-module ((guix git) #:select (with-git-error-handling))
   #:use-module (guix progress)
+  #:autoload   (guix base16) (base16-string->bytevector)
   #:use-module (guix base64)
-  #:autoload   (rnrs bytevectors) (bytevector-length)
+  #:autoload   (rnrs bytevectors) (bytevector=? bytevector-length)
+  #:autoload   (gcrypt hash) (port-hash hash-algorithm sha1)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
@@ -143,6 +145,24 @@ REPOSITORY."
   (info (G_ "introduction and keyring recorded \
 in repository configuration file~%")))
 
+(define %pre-push-hook
+  ;; Contents of the pre-push hook that gets installed.
+  "\
+#!/bin/sh
+# Installed by 'guix git authenticate'.
+set -e
+
+# The \"empty hash\" used by Git when pushing a branch deletion.
+z40=0000000000000000000000000000000000000000
+
+while read local_ref local_oid remote_ref remote_oid
+do
+  if [ \"$local_oid\" != \"$z40\" ]
+  then
+      guix git authenticate --end=\"$local_oid\"
+  fi
+done\n")
+
 (define (install-hooks repository)
   "Attempt to install in REPOSITORY hooks that invoke 'guix git authenticate'.
 Bail out if one of these already exists."
@@ -166,13 +186,7 @@ authenticated before you push and when you pull updates.")))
       (begin
         (call-with-output-file pre-push-hook
           (lambda (port)
-            (format port "#!/bin/sh
-# Installed by 'guix git authenticate'.
-set -e
-while read local_ref local_oid remote_ref remote_oid
-do
-  guix git authenticate --end=\"$local_oid\"
-done\n")
+            (display %pre-push-hook port)
             (chmod port #o755)))
         (call-with-output-file post-merge-hook
           (lambda (port)
@@ -183,6 +197,42 @@ exec guix git authenticate\n")
         (info (G_ "installed hooks '~a' and '~a'~%")
               pre-push-hook post-merge-hook))))
 
+(define (broken-pre-push-hook? file)
+  "Return true if FILE corresponds to a missing or known-broken pre-push hook
+that needs to be replaced."
+  (define broken-pre-push-hooks
+    ;; Size and SHA1 hash of pre-push hooks that were automatically installed
+    ;; but are known to be broken.
+    `((161 "a9916155b71894014144fcafad7700f89da26c83")))
+
+  (match (stat file #f)
+    (#f #t)
+    (st
+     (find (match-lambda
+             ((size bad-sha1)
+              (and (= size (stat:size st))
+                   (bytevector=? (call-with-input-file file
+                                   (lambda (port)
+                                     (port-hash (hash-algorithm sha1) port)))
+                                 (base16-string->bytevector bad-sha1)))))
+           broken-pre-push-hooks))))
+
+(define (maybe-upgrade-hooks repository)
+  "Update pre-push or post-merge hooks in REPOSITORY if it is missing or a
+known-broken version is installed."
+  (define directory
+    (repository-common-directory repository))
+
+  (define pre-push-hook
+    (in-vicinity directory "hooks/pre-push"))
+
+  (when (broken-pre-push-hook? pre-push-hook)
+    (info (G_ "upgrading hook '~a'~%") pre-push-hook)
+    (call-with-output-file pre-push-hook
+      (lambda (port)
+        (display %pre-push-hook port)
+        (chmod port #o755)))))
+
 (define (show-stats stats)
   "Display STATS, an alist containing commit signing stats as returned by
 'authenticate-repository'."
@@ -303,11 +353,13 @@ expected COMMIT and SIGNER~%")))
                                   #:cache-key cache-key
                                   #:make-reporter make-reporter))
 
-       (unless (configured? repository)
-         (record-configuration repository
-                               #:commit commit #:signer signer
-                               #:keyring-reference keyring)
-         (install-hooks repository))
+       (if (configured? repository)
+           (maybe-upgrade-hooks repository)
+           (begin
+             (record-configuration repository
+                                   #:commit commit #:signer signer
+                                   #:keyring-reference keyring)
+             (install-hooks repository)))
 
        (when (and show-stats? (not (null? stats)))
          (show-stats stats))