From mboxrd@z Thu Jan 1 00:00:00 1970 From: Maxim Cournoyer Subject: bug#28745: [PATCH] tarballs generated on github are generated on demand (leading to different hash sums) Date: Sun, 15 Oct 2017 23:10:43 -0400 Message-ID: <87k1zv7pos.fsf@gmail.com> References: <20171008114009.3tyhcuioaau6tlya@abyayala> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:48761) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1e3vo2-0006wM-Gu for bug-guix@gnu.org; Sun, 15 Oct 2017 23:11:09 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1e3vnz-0006qo-4N for bug-guix@gnu.org; Sun, 15 Oct 2017 23:11:06 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:33558) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1e3vny-0006qd-Nm for bug-guix@gnu.org; Sun, 15 Oct 2017 23:11:03 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1e3vny-00015t-CV for bug-guix@gnu.org; Sun, 15 Oct 2017 23:11:02 -0400 Sender: "Debbugs-submit" Resent-Message-ID: In-Reply-To: bug's message of "Mon\, 16 Oct 2017 02\:52\:25 +0000" List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-guix-bounces+gcggb-bug-guix=m.gmane.org@gnu.org Sender: "bug-Guix" To: bug#28745 <28745@debbugs.gnu.org> --=-=-= Content-Type: text/plain 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! --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-gnu-packages-Fix-the-hashes-of-mutated-GitHub-archiv.patch >From 774a764149ecb0e234ae09c9a0a273af671c3c86 Mon Sep 17 00:00:00 2001 From: Maxim Cournoyer 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 --=-=-= Content-Type: text/plain Content-Disposition: attachment Content-Description: (fiasco finder) module (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 (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 (resultresults file)) (valid-results (sort (filter result-package-exist? all-results) resultresults-file valid-results file))) ;;; ;;; Functions and procedures. ;;; (define (packagepackage (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 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))) ;;; ;;; 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)))) --=-=-= Content-Type: text/plain Content-Disposition: attachment Content-Description: fiasco runner ;;; 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) --=-=-= Content-Type: text/plain Content-Disposition: attachment Content-Description: (fiasco fixer) module (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))) --=-=-=--