bug#28745: tarballs generated on github are generated on demand (leading to different hash sums)

bug#28745: tarballs generated on github are generated on demand (leading to different hash sums)

[ng0]

[-- Attachment #1: Type: text/plain, Size: 1061 bytes --]

Past and recent discussion in our IRC channel and on the mailing list
show that we can not rely on tarballs on github keeping the same
hash forever.
According to github they are "generated on demand", leading to
regular hash mismatches.

Since some of our own dependencies are on github (at the very least
guile-git), we need to come up with a solution.

Right now we have around 449 packages with tarball sources from
github in our gnu/packages.
We could:

- Move them all to use git-download and just use
  the commit that has been tagged in the versions that produce
  the tarballs on github.

- Mirror the content somewhere reliable in snapshots for
  some time. Problem here: we start to rely on this "somewhere"
  to be trustworthy and introduce one more point to trust
  (however due to pre-recorded hash sum this is just an annoyance,
  not a grave issue).

- Your idea here.

-- 
ng0
GnuPG: A88C8ADD129828D7EAC02E52E22F9BBFEE348588
GnuPG: https://dist.krosos.org/dist/keys/
https://www.infotropique.org https://krosos.org

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

bug#28745: tarballs generated on github are generated on demand (leading to different hash sums)

[ng0]

[-- Attachment #1: Type: text/plain, Size: 399 bytes --]

ng0 transcribed 2.1K bytes:
…
> Since some of our own dependencies are on github (at the very least
> guile-git), we need to come up with a solution.
…

Correction: libgit2 is on github, a dependency of guile-git (which is on gitlab).

-- 
ng0
GnuPG: A88C8ADD129828D7EAC02E52E22F9BBFEE348588
GnuPG: https://dist.krosos.org/dist/keys/
https://www.infotropique.org https://krosos.org

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

bug#28745: tarballs generated on github are generated on demand (leading to different hash sums)

[Jan Nieuwenhuizen]

ng0 writes:

> ng0 transcribed 2.1K bytes:
> …
>> Since some of our own dependencies are on github (at the very least
>> guile-git), we need to come up with a solution.
> …
>
> Correction: libgit2 is on github, a dependency of guile-git (which is on gitlab).

Sure, see bug#28659 ...possbily this needs to be merged that bug.
janneke


-- 
Jan Nieuwenhuizen <janneke@gnu.org> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com

bug#28745: tarballs generated on github are generated on demand (leading to different hash sums)

[Ricardo Wurmus]

ng0 <ng0@infotropique.org> writes:

> Right now we have around 449 packages with tarball sources from
> github in our gnu/packages.

I assume that this problem does not exist for tarballs that have been
signed and uploaded by the maintainer.  This is only a problem for
auto-generated tarballs for tags, so it’s probably less than 449
packages.

> - Move them all to use git-download and just use
>   the commit that has been tagged in the versions that produce
>   the tarballs on github.

This doesn’t seem like a bad idea.  It’s not great that we’ll have to
bootstrap the build systems for all these packages.

--
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net

bug#28745: [PATCH] tarballs generated on github are generated on demand (leading to different hash sums)

[Maxim Cournoyer]

[-- Attachment #1: Type: text/plain, Size: 693 bytes --]

Hello,

I could finish a script that helped me finding all of our affected
packages, verify that only the hash but not the content of the archives
had changed, as well as automate the hash update for those safe to
update.

Attached is the patch and the scripts I used. I think we might
want to reuse some of it to extend guix lint to warn packagers that
archives coming from .*github.*archives URL are not guaranteed to be
stable and that it would be better, if available, to use manually
uploaded releases archives.

Thanks!

Maxim

PS: I've also uploaded the scripts here:
https://notabug.org/apteryx/fiasco for ease of cloning. Any comments
about my nascent (ab)use of Scheme are welcome!


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-gnu-packages-Fix-the-hashes-of-mutated-GitHub-archiv.patch --]
[-- Type: text/x-patch, Size: 6358 bytes --]

From 774a764149ecb0e234ae09c9a0a273af671c3c86 Mon Sep 17 00:00:00 2001
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Date: Sun, 15 Oct 2017 22:17:12 -0400
Subject: [PATCH] gnu: packages: Fix the hashes of mutated GitHub archives.

Fixes bug https://bugs.gnu.org/28745.

* gnu/packages/audio.scm (csound): Fix hash.
* gnu/packages/engineering.scm (fritzing): Likewise.
* gnu/packages/erlang.scm (erlang): Likewise.
* gnu/packages/fonts.scm (font-google-material-design-icons): Likewise.
* gnu/packages/graphics.scm (ogre): Likewise.
* gnu/packages/java.scm (java-plexus-interpolation, antlr3): Likewise.
* gnu/packages/serialization.scm (yaml-cpp): Likewise.
* gnu/packages/version-control.scm (libgit2): Likewise.
---
 gnu/packages/audio.scm           | 2 +-
 gnu/packages/engineering.scm     | 2 +-
 gnu/packages/erlang.scm          | 2 +-
 gnu/packages/fonts.scm           | 2 +-
 gnu/packages/graphics.scm        | 2 +-
 gnu/packages/java.scm            | 4 ++--
 gnu/packages/serialization.scm   | 2 +-
 gnu/packages/version-control.scm | 2 +-
 8 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/gnu/packages/audio.scm b/gnu/packages/audio.scm
index 0900630df..fbbe77509 100644
--- a/gnu/packages/audio.scm
+++ b/gnu/packages/audio.scm
@@ -580,7 +580,7 @@ emulation (valve, tape), bit fiddling (decimator, pointer-cast), etc.")
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "0f67vyy3r29hn26qkkcwnizrnzzy8p7gmg3say5q3wjhxns3b5yl"))))
+                "0xqpqws4jsv7fyawcjzwaw544qbfh29xq164kdf30a9v1n3yklp4"))))
     (build-system cmake-build-system)
     (inputs
      `(("alsa-lib" ,alsa-lib)
diff --git a/gnu/packages/engineering.scm b/gnu/packages/engineering.scm
index 9f9949ef8..c9e184d7d 100644
--- a/gnu/packages/engineering.scm
+++ b/gnu/packages/engineering.scm
@@ -429,7 +429,7 @@ multipole-accelerated algorithm.")
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "0pvk57z2pxz89pcwwm61lkpvj4w9qxqz8mi0zkpj6pnaljabp7bf"))))
+                "15rwjp4xdj9w1z9f709rz9p0k2mi9k9idma9hvzkj5j8p04mg7yd"))))
     (build-system gnu-build-system)
     (arguments
      `(#:phases
diff --git a/gnu/packages/erlang.scm b/gnu/packages/erlang.scm
index cf4d7a595..1a575a0fd 100644
--- a/gnu/packages/erlang.scm
+++ b/gnu/packages/erlang.scm
@@ -46,7 +46,7 @@
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "1azjjyb743i6vjq7rnh5qnslsqg0x60a9zrlhg9n3dpm13z1b22l"))
+                "11xp6vv1v7iay9dg1xc6xm7izfsanbn5pgwp96ba0j1fmlkhjw92"))
               (patches (search-patches "erlang-man-path.patch"))))
     (build-system gnu-build-system)
     (native-inputs
diff --git a/gnu/packages/fonts.scm b/gnu/packages/fonts.scm
index b65d3a9e9..9975c73a2 100644
--- a/gnu/packages/fonts.scm
+++ b/gnu/packages/fonts.scm
@@ -1026,7 +1026,7 @@ monospace, slab-serif fonts.")
                     version ".tar.gz"))
               (sha256
                (base32
-                "183n0qv3q8w6n27libarq1fhc4mqv2d3sasbfmbn7x9r5pw9c6ga"))
+                "018i3za9r6kf6svci33z09lc5pr5yz4164m8gzzwjzzqcrng0p5j"))
               (file-name (string-append name "-" version ".tar.gz"))))
     (build-system font-build-system)
     (home-page "http://google.github.io/material-design-icons")
diff --git a/gnu/packages/graphics.scm b/gnu/packages/graphics.scm
index 8e3c5563f..3ffb4dd25 100644
--- a/gnu/packages/graphics.scm
+++ b/gnu/packages/graphics.scm
@@ -244,7 +244,7 @@ exception-handling library.")
                            "/archive/v" version ".tar.gz"))
        (sha256
         (base32
-         "1ab354bmwwryxr4zgxchfkm6h4z38mjgif8yn89x640rsrgw5ipj"))
+         "1p0c91cc7zg3c00wjaibnxb0a0xm14mkg0h65pzpw93m0d6nc8wd"))
        (file-name (string-append name "-" version ".tar.gz"))))
     (build-system cmake-build-system)
     (arguments
diff --git a/gnu/packages/java.scm b/gnu/packages/java.scm
index 95fba20e8..45cb16f1f 100644
--- a/gnu/packages/java.scm
+++ b/gnu/packages/java.scm
@@ -2299,7 +2299,7 @@ more.")
                                   "plexus-interpolation-" version ".tar.gz"))
               (sha256
                (base32
-                "1w79ljwk42ymrgy8kqxq4l82pgdj6287gabpfnpkyzbrnclsnfrp"))))
+                "03377yzlx5q440m6sxxgv6a5qb8fl30zzcgxgc0hxk5qgl2z1jjn"))))
     (build-system ant-build-system)
     (arguments
      `(#:jar-name "plexus-interpolation.jar"
@@ -4429,7 +4429,7 @@ StringTemplate also powers ANTLR.")
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "07zff5frmjd53rnqdx31h0pmswz1lv0p2lp28cspfszh25ysz6sj"))))
+                "0218v683081lg54z9hvjxinhxd4dqp870jx6n39gslm0bkyi4vd6"))))
     (build-system ant-build-system)
     (arguments
      `(#:jar-name (string-append ,name "-" ,version ".jar")
diff --git a/gnu/packages/serialization.scm b/gnu/packages/serialization.scm
index 186692612..c66e814e5 100644
--- a/gnu/packages/serialization.scm
+++ b/gnu/packages/serialization.scm
@@ -247,7 +247,7 @@ that implements both the msgpack and msgpack-rpc specifications.")
                     "yaml-cpp-" version ".tar.gz"))
               (sha256
                (base32
-                "1vk6pjh0f5k6jwk2sszb9z5169whmiha9ainbdpa1arxlkq7v3b6"))))
+                "1ck7jk0wjfigrf4cgcjqsir4yp1s6vamhhxhpsgfvs46pgm5pk6y"))))
     (build-system cmake-build-system)
     (arguments
      '(#:configure-flags '("-DBUILD_SHARED_LIBS=ON")))
diff --git a/gnu/packages/version-control.scm b/gnu/packages/version-control.scm
index 38756f06c..c3f6a8500 100644
--- a/gnu/packages/version-control.scm
+++ b/gnu/packages/version-control.scm
@@ -363,7 +363,7 @@ everything from small to very large projects with speed and efficiency.")
               (file-name (string-append name "-" version ".tar.gz"))
               (sha256
                (base32
-                "1fdk9yhwvl1w1z71ykzcvgh4nsf8scxcbclz5anh98zpplmhmisa"))
+                "1b3figbhp5l83vd37vq6j2narrq4yl9pfw6mw0px0dzb1hz3jqka"))
               (patches (search-patches "libgit2-0.25.1-mtime-0.patch"))))
     (build-system cmake-build-system)
     (outputs '("out" "debug"))
-- 
2.14.1


[-- Attachment #3: (fiasco finder) module --]
[-- Type: text/plain, Size: 11900 bytes --]

(define-module (fiasco finder)
  #:use-module (ice-9 control)
  #:use-module (ice-9 match)
  #:use-module (ice-9 popen)
  #:use-module (ice-9 regex)
  #:use-module (ice-9 textual-ports)
  #:use-module (gnu packages)
  #:use-module (guix base32)
  #:use-module (guix build utils)
  #:use-module (guix download)
  #:use-module ((guix build download)
		#:select (url-fetch)
		#:prefix build:)
  #:use-module (guix download)
  #:use-module (guix packages)
  #:use-module (guix scripts download)
  #:use-module (guix scripts hash)
  #:use-module (guix store)
  #:use-module (guix ui)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-19)

  #:export (result
	    result?
	    result-package-name
	    result-package-version
	    result-guix-hash
	    result-upstream-hash
	    result-hash-ok?
	    result-safe-to-update?
	    result-date
	    result->package

	    results-dir
	    results-file
	    results-file->results
	    results->results-file
	    purge-deprecated-results!

	    find-problematic-packages))

;;; Commentary: Finds GitHub packages whose hash got broken.
;;; Requirements: tar and diff command line tools.

;; Workaround Geiser bug #83 (see:
;; https://github.com/jaor/geiser/issues/83)
(guix-warning-port (current-warning-port))

;;;
;;; Parameters to configure.
;;;

(define substitute-urls
  (make-parameter (cons* "https://berlin.guixsd.org"
			 "https://bayfront.guixsd.org"
			 %default-substitute-urls)))

(define results-dir
  (make-parameter (string-append (getenv "HOME") "/src/guile-hacks/fiasco")))

(define results-file
  (make-parameter (string-append (results-dir) "/results.txt")))

(define tar-diff-dir
  (make-parameter (string-append (results-dir) "/tar-diffs")))

;;;
;;; Data structures and supporting functions.
;;;

(define-record-type <result>
  (make-result package-name package-version guix-hash
	       upstream-hash hash-ok? safe-to-update? date)
  result?
  (package-name result-package-name)
  (package-version result-package-version)
  (guix-hash result-guix-hash)
  (upstream-hash result-upstream-hash)
  (hash-ok? result-hash-ok?)
  (safe-to-update? result-safe-to-update?)
  (date result-date))

(define (result->sexp result)
  (list (result-package-name result)
	(result-package-version result)
	(result-guix-hash result)
	(result-upstream-hash result)
	(result-hash-ok? result)
	(result-safe-to-update? result)
	(result-date result)))

(define (sexp->result sexp)
  (match sexp
    ((package-name package-version guix-hash
		   upstream-hash safe-to-update? result-hash-ok? date)
     (make-result package-name package-version guix-hash
		  upstream-hash safe-to-update? result-hash-ok? date))))

(define (results-file->results file)
  "Read the results from FILE and return the list of result records."
  (with-input-from-file file
    (lambda ()
      (let loop ((line (read (current-input-port))))
	(if (eof-object? line)
	    '()
	    (cons (sexp->result line)
		  (loop (read (current-input-port)))))))))

(define (result-package-exist? result)
    "Return the package referred to by RESULT or #f if it doesn't exist."
  (let* ((name (result-package-name result))
	 (version (result-package-version result))
	 (packages (find-best-packages-by-name name version)))
    (not (null? packages))))

(define (result->package result)
  "Return the package referred to by RESULT or null if it doesn't exist."
  (let* ((name (result-package-name result))
	 (version (result-package-version result))
	 (packages (find-best-packages-by-name name version)))
    (if (null? packages)
	(begin
	  (warn (format #f "The package ~a, version ~a is no longer in Guix"
			name version))
	  '())
	(first packages))))

(define (results->results-file results file)
  "Overwrite the FILE content with the RESULTS."
  (with-output-to-file file
    (lambda ()
      (for-each (lambda (result)
		  (write (result->sexp result) (current-output-port))
		  (display "\n" (current-output-port)))
		results))))

(define (result<? result1 result2)
  "Predicate to sort results alphabetically by name and versions."
  (let ((name1 (result-package-name result1))
	(name2 (result-package-name result2))
	(version1 (result-package-version result1))
	(version2 (result-package-version result2)))
  (or (string<? name1 name2)
      (and (string=? name1 name2)
	   (string<? version1 version2)))))

(define (purge-deprecated-results! file)
  "Overwrite FILE after purging the results of Guix packages no longer
available."
  (let* ((all-results (results-file->results file))
	 (valid-results
	  (sort (filter result-package-exist? all-results) result<?)))
    (results->results-file valid-results file)))

\f

;;;
;;; Functions and procedures.
;;;

(define (package<? package1 package2)
  "Predicate to sort packages alphabetically by name and versions."
  (or (string<? (package-name package1) (package-name package2))
      (and (string=? (package-name package1) (package-name package2))
	   (string<? (package-version package1) (package-version package2)))))

(define (problematic-uri? uri)

  (define (contains-github-archive? uri)
    (regexp-match? (string-match "github.com/.*/archive/" uri)))

  ;; URI can be a string or a list of string.
  (match uri
    ((uri1 uri2 ...)			;match list of strings
     (not (null? (filter contains-github-archive? uri))))
    (uri1				;match string
     (contains-github-archive? uri1))))

(define (problematic-github-package? package)
  (let ((source (package-source package)))
    (and (origin? source)
	 (eq? (origin-method source) url-fetch)
	 (problematic-uri? (origin-uri source)))))

(define (problematic-github-packages)
  "Return the list of all the potentially problematic GitHub packages in Guix."
  (sort (fold-packages (lambda (p r)
			 (if (problematic-github-package? p)
			     (cons p r)
			     r))
		       '())
	package<?))

(define* (already-checked-packages #:optional (file (results-file)))
  "List of already checked packages."
  (if (file-exists? file)
      (filter package? (map result->package
			    (results-file->results file)))
      '()))

(define (origin->nix-base32-bash origin)
  (bytevector->nix-base32-string (origin-sha256 origin)))

(define (origin->download-uri-suffix origin)
  "Form the suffix part of the URI of a downloadable substitute file."
  (let ((file-name (origin-actual-file-name origin))
	(hash (origin->nix-base32-bash origin)))
    (string-append "/file/" file-name "/sha256/" hash)))

(define* (download-substitute package file)
  "Download the substitute of PACKAGE and return it as FILE, or #f if
the substitute could not be downloaded."
  (let* ((origin (package-source package))
	 (download-uri-suffix (origin->download-uri-suffix origin)))
    (let/ec return
      (for-each (lambda (url)
		  ;; Do not verify certificate to work around bug#28810.
		  (let* ((uri (string-append url download-uri-suffix))
			 (file (build:url-fetch uri file
						#:verify-certificate? #f)))
		    (when file
		      (return file))))	;abort loop
		(substitute-urls))
      (warn "Failed to download a substitute for package: "
	    (package-name package))
      #f)))

(define (file-hash file)
  "Return the nix-base32 string corresponding to the sha256 hash of FILE."
  (and file
       (string-trim-both (with-output-to-string
			   (lambda ()
			     (guix-hash file))))))

(define (compare-tar-archives archive1 archive2)
  "Return #f if the archives content is the same.  Otherwise, a string
detailing the differences is returned."
  (let* ((tmpdir (tmpnam))
	 (subdir1 (string-append tmpdir "/archive1"))
	 (subdir2 (string-append tmpdir "/archive2"))
	 (name1 (basename archive1))
	 (name2 (basename archive2))
	 (diff-file (string-append (tar-diff-dir) "/"
				   name1 "-" name2 ".diff")))
    (define (untar archive-file dest-dir)
      (unless (zero? (system* "tar" "-C" dest-dir "-xf" archive-file))
	(error "Failed to extract archive: " archive-file)))

    (mkdir-p subdir1)
    (mkdir-p subdir2)
    (mkdir-p (tar-diff-dir))
    (untar archive1 subdir1)
    (untar archive2 subdir2)

    ;; Use --no-dereference to prevent diff failing on broken
    ;; symlinks that archives may contain (e.g. antlr3).
    (let* ((input-pipe (open-pipe* OPEN_READ
				   "diff" "-r" "--no-dereference"
				   subdir1 subdir2))
	   (output (get-string-all input-pipe))
	   (exit-val (status:exit-val (close-pipe input-pipe))))
      (case exit-val
	((0) #f)
	((1)
	 (with-output-to-file diff-file
	   (lambda ()
	     (display output)))
	 (format #t "Diff saved to ~a:~%~a~%" diff-file output))
	(else (error "diff failed comparing the folders: " subdir1 subdir2
		     "exit status: " exit-val))))))

(define (hash-ok? hash1 hash2)
  (and (string? hash1)
       (string? hash2)
       (string=? hash1 hash2)))

(define (check-package-hash package)
  "Verify the hash of a package and return a <result> object.  Assumes
the definition of PACKAGE contains an origin using the url-fetch
method and a base32 encoded sha256 hash."
  (let* ((date (date->string (current-date)))
	 (name (package-name package))
	 (version (package-version package))
	 (origin (package-source package))
	 (tmpdir (tmpnam))
	 (tmpdir! (mkdir-p tmpdir))
	 (file-name (origin-actual-file-name origin))
	 (upstream-archive (string-append tmpdir "/upstream-" file-name))
	 (substitute-archive (string-append tmpdir "/substitute-" file-name))
	 (uri (origin-uri origin))
	 (guix-hash (origin->nix-base32-bash origin))
	 (upstream-hash (file-hash (build:url-fetch uri upstream-archive)))
	 (hash-ok? (hash-ok? upstream-hash guix-hash))
	 (substitute (and upstream-hash ;stop if false
			  (not hash-ok?)
			  (download-substitute package
					       substitute-archive)))
	 (safe-to-update?
	  (if hash-ok?
	      #f	      ;false here means 'no need to update'
	      (and substitute ;stop here if we don't have a substitute
		   (not (compare-tar-archives upstream-archive
					      substitute-archive))))))
    (make-result name version guix-hash upstream-hash hash-ok?
		 safe-to-update? date)))

\f

;;;
;;; Main program
;;;

(define (find-problematic-packages)
  "Find and print the names of the potentially problematic GitHub packages."

  (define (print-packages packages)
    (for-each (lambda (name)
		(format #t "~a~%" name))
	      (map package-name packages))
    (format #t "~%"))

  (define (verify-package-hash package)
    (format #t "~%~a verifying package hash...~%" (package-name package))
    (let* ((result (check-package-hash package))
	   (name (result-package-name result))
	   (guix-hash (result-guix-hash result))
	   (upstream-hash (result-upstream-hash result))
	   (hash-ok? (result-hash-ok? result)))
      (format #t "~a Guix hash:     ~s~%" name guix-hash)
      (format #t "~a upstream hash: ~s~%" name upstream-hash)
      (if hash-ok?
	  (format #t "~a hash OK~%" name)
	  (format #t "~a hash NOK~%" name))
      (cond
       (hash-ok? #t)			;no-op
       ((result-safe-to-update? result)
	(format #t "~a hash can be safely updated~%" name))
       (else (format #t "~a requires manual verification~%" name)))

      ;; Append result to results file.
      (let ((results-file (open-file (results-file) "a")))
	(dynamic-wind
	  (lambda () #f)
	  (lambda ()
	    (write (result->sexp result) results-file)
	    (display "\n" results-file))
	  (lambda () (close results-file))))))

  (let* ((problematic-github-packages (problematic-github-packages))
	 (already-checked-packages (already-checked-packages)))

    (format #t "Number of potentially problematic GitHub packages: ~a~%"
	    (length problematic-github-packages))
    ;;(print-packages problematic-github-packages)

    (unless (null? already-checked-packages)
      (format #t "Skipping ~a already checked packages~%"
	      (length already-checked-packages)))

    (for-each verify-package-hash
    	      (lset-difference eq? problematic-github-packages
    			       already-checked-packages))))


[-- Attachment #4: fiasco runner --]
[-- Type: text/plain, Size: 558 bytes --]

;;; Script that detects problematic github packages.
;;; To run, use something like this in the "fiasco" dir:
;;; ~/src/guix/pre-inst-env guile -L . main.scm

(use-modules (fiasco finder)
	     (fiasco fixer))

(define (main)
  ;; You may select a different results-dir by parameterizing it
  ;; differently below. More parameters available to configure can be
  ;; found in (fiasco finder).
  (parameterize ((results-dir (string-append (getenv "HOME")
					     "/src/guile-hacks/fiasco")))
    (find-problematic-packages)
    (fix-packages-hash)))

(main)

[-- Attachment #5: (fiasco fixer) module --]
[-- Type: text/plain, Size: 1827 bytes --]

(define-module (fiasco fixer)
  #:use-module (fiasco finder)
  #:use-module (guix base32)
  #:use-module (guix upstream)

  #:export (fix-packages-hash))

;;; Commentary:
;;;
;;; Repair the packages whose hash can be safely updated, as found by
;;; the finder script. This should be run from a checkout of the Guix
;;; source tree, e.g. as "./pre-inst-guix guile ~/src/guile-hacks/fiasco/run.scm

(define (result-needs-checking? result)
  (and (not (result-hash-ok? result))
       (not (result-safe-to-update? result))))

(define* (fix-packages-hash #:optional (file (results-file)))
  "Correct the packages whose hash can be safely updated, based on
data in FILE."
  (let* ((results (results-file->results file))
	 (results-to-check (filter result-needs-checking? results))
	 (actionable-results (filter result-safe-to-update? results)))

    (define (update-package-hash result)
      (when (not (null? (result->package result)))
	(let* ((package (result->package result))
	       (name (result-package-name result))
	       (version (result-package-version result))
	       (old-hash (result-guix-hash result))
	       (new-hash (result-upstream-hash result))
	       (new-hash-bv (nix-base32-string->bytevector new-hash)))
	  (format #t "~a: updating hash from ~s to ~s..." name old-hash new-hash)
	  (if (update-package-source package version new-hash-bv)
	      (format #t "   success~%")
	      (format #t "   failed~%")))))

    (format #t "The following packages require manual verification:~%")
    (for-each (lambda (r)
		(format #t "~a version ~a~%"
			(result-package-name r)
			(result-package-version r)))
	      results-to-check)
    (display "\n")

    (format #t "Attempting to repair the hashes of ~a packages...~%"
	    (length actionable-results))

    (for-each update-package-hash actionable-results)))

bug#28745: [PATCH] tarballs generated on github are generated on demand (leading to different hash sums)

[Ludovic Courtès]

Hi,

Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:

> I could finish a script that helped me finding all of our affected
> packages, verify that only the hash but not the content of the archives
> had changed, as well as automate the hash update for those safe to
> update.

Great job!

> Attached is the patch and the scripts I used. I think we might
> want to reuse some of it to extend guix lint to warn packagers that
> archives coming from .*github.*archives URL are not guaranteed to be
> stable and that it would be better, if available, to use manually
> uploaded releases archives.

Unfortunately, it’s become commonplace to publish nothing else than a
Git tag.  Now, in those cases, we could also use ‘git-fetch’, which
wouldn’t be affected by problems with generated tarballs.

Thoughts?

> PS: I've also uploaded the scripts here:
> https://notabug.org/apteryx/fiasco for ease of cloning. Any comments
> about my nascent (ab)use of Scheme are welcome!

The code looks nice!

> From 774a764149ecb0e234ae09c9a0a273af671c3c86 Mon Sep 17 00:00:00 2001
> From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
> Date: Sun, 15 Oct 2017 22:17:12 -0400
> Subject: [PATCH] gnu: packages: Fix the hashes of mutated GitHub archives.
>
> Fixes bug https://bugs.gnu.org/28745.
>
> * gnu/packages/audio.scm (csound): Fix hash.
> * gnu/packages/engineering.scm (fritzing): Likewise.
> * gnu/packages/erlang.scm (erlang): Likewise.
> * gnu/packages/fonts.scm (font-google-material-design-icons): Likewise.
> * gnu/packages/graphics.scm (ogre): Likewise.
> * gnu/packages/java.scm (java-plexus-interpolation, antlr3): Likewise.
> * gnu/packages/serialization.scm (yaml-cpp): Likewise.
> * gnu/packages/version-control.scm (libgit2): Likewise.

I’ve checked the hashes by running:

  ./pre-inst-env guix build -S --no-substitutes csound fritzing erlang \
     font-google-material-design-icons ogre java-plexus-interpolation \
     antlr3 yaml-cpp libgit2  --max-jobs=2

and everything went well.

Pushed as fd75eb6cd4e5c689f9e6ce7dd8d87f423778d308, thanks!

Ludo’.

bug#28745: [PATCH] tarballs generated on github are generated on demand (leading to different hash sums)

[Maxim Cournoyer]

ludo@gnu.org (Ludovic Courtès) writes:

> Maxim Cournoyer <maxim.cournoyer@gmail.com> skribis:
>
[...]
>
>> Attached is the patch and the scripts I used. I think we might
>> want to reuse some of it to extend guix lint to warn packagers that
>> archives coming from .*github.*archives URL are not guaranteed to be
>> stable and that it would be better, if available, to use manually
>> uploaded releases archives.
>
> Unfortunately, it’s become commonplace to publish nothing else than a
> Git tag.  Now, in those cases, we could also use ‘git-fetch’, which
> wouldn’t be affected by problems with generated tarballs.
>
> Thoughts?

I think the status quo is reasonable for now; if this becomes a recurring
problem we can reopen the issue and do something more about it.

>> PS: I've also uploaded the scripts here:
>> https://notabug.org/apteryx/fiasco for ease of cloning. Any comments
>> about my nascent (ab)use of Scheme are welcome!
>
> The code looks nice!

OK, that's reassuring! :)

>
>> From 774a764149ecb0e234ae09c9a0a273af671c3c86 Mon Sep 17 00:00:00 2001
>> From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
>> Date: Sun, 15 Oct 2017 22:17:12 -0400
>> Subject: [PATCH] gnu: packages: Fix the hashes of mutated GitHub archives.
>>
>> Fixes bug https://bugs.gnu.org/28745.
>>
>> * gnu/packages/audio.scm (csound): Fix hash.
>> * gnu/packages/engineering.scm (fritzing): Likewise.
>> * gnu/packages/erlang.scm (erlang): Likewise.
>> * gnu/packages/fonts.scm (font-google-material-design-icons): Likewise.
>> * gnu/packages/graphics.scm (ogre): Likewise.
>> * gnu/packages/java.scm (java-plexus-interpolation, antlr3): Likewise.
>> * gnu/packages/serialization.scm (yaml-cpp): Likewise.
>> * gnu/packages/version-control.scm (libgit2): Likewise.
>
> I’ve checked the hashes by running:
>
>   ./pre-inst-env guix build -S --no-substitutes csound fritzing erlang \
>      font-google-material-design-icons ogre java-plexus-interpolation \
>      antlr3 yaml-cpp libgit2  --max-jobs=2
>
> and everything went well.
>
> Pushed as fd75eb6cd4e5c689f9e6ce7dd8d87f423778d308, thanks!
>
> Ludo’.

Thanks!

Maxim

bug#28745: [PATCH] tarballs generated on github are generated on demand (leading to different hash sums)

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> Unfortunately, it’s become commonplace to publish nothing else than a
> Git tag.  Now, in those cases, we could also use ‘git-fetch’, which
> wouldn’t be affected by problems with generated tarballs.
>
> Thoughts?

For a couple of packages I’ve already started using git-fetch with the
tag (instead of the commit hash).  I think that’s preferable over using
auto-generated tarballs.

--
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net