[bug#40115] [PATCH] download: Use correct system and guile in 'url-fetch/tarbomb' and 'url-fetch/zipbomb'.

[Diego Nicola Barbato <dnbarbato@posteo.de>]

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

Hey Guix,

Here's some additional information.

Diego Nicola Barbato <dnbarbato@posteo.de> writes:

> The attached patch fixes a bug where e.g.
>
>   guix build -s i686-linux ffmpeg
>
> builds a different derivation on i686-linux than on x86_64-linux.  This
> doesn't just affect ffmpeg but a whole class of packages which use or
> depend on a package that uses 'url-fetch/tarbomb' or 'url-fetch/zipbomb'
> as the origin method of its source.  That's around 334 packages, among
> them diffoscope, enlightenment, gnome, ungoogled-chromium, and wine.

The number (348 for commit 151f3d4) and full list of affected packages
can be computed by loading the attached script [0] into `guix repl' and
running `(show-affected-packages)'.

> The problem is fixed by explicitly passing the correct #:system and
> #:guile-for-build to 'gexp->derivation' (as is done in other origin
> methods such as 'git-fetch' or 'hg-fetch').
>
> This shouldn't trigger any rebuils as it only affects the behaviour of
> `guix build -s $system $package' if $system differs from the system type
> of Guix itself.

A closer look at some derivations and outputs suggests that this patch
will actually trigger rebuilds for all affected packages on all systems
except x86_64 because the build farm currently builds the wrong
derivations as can be seen for e.g. QEMU by comparing the build on
Cuirass

  https://ci.guix.gnu.org/build/2442001/details

with the derivations computed by

  guix build -s i686-linux --no-grafts -d qemu

on i686-linux and x86_64-linux (commit 151f3d4) respectively:

  Cuirass:
    /gnu/store/wc2k8h4iahbnfvl35220hvdx6mc70v7l-qemu-4.2.0.drv
    /gnu/store/fjg87f21qdzi7h5pqsxpd6rlf9mcy58h-qemu-4.2.0        <~
  i686-linux:
    /gnu/store/019ccjdh1nxfkpjyzwmirvif1ra9v3lh-qemu-4.2.0.drv
    /gnu/store/8a0cg5ip9967y54gkwskfxmiwwk9mf1b-qemu-4.2.0
  x86_64-linux:
    /gnu/store/iajzrw7lahcyhgyr7anmcjxa33607nqh-qemu-4.2.0.drv
    /gnu/store/fjg87f21qdzi7h5pqsxpd6rlf9mcy58h-qemu-4.2.0        <~

Consequently no substitutes are available for the affected packages on
systems other than x86_64-linux as witnessed by the different number of
available substitutes reported by

  guix weather -s i686-linux -m tarbomb-zipbomb-manifest-small.scm

on i686-linux

--8<---------------cut here---------------start------------->8---
computing 37 package derivations for i686-linux...
looking for 37 store items on https://ci.guix.gnu.org...
https://ci.guix.gnu.org
  18.9% substitutes available (7 out of 37)
  at least 2.3 MiB of nars (compressed)
  5.1 MiB on disk (uncompressed)
  0.001 seconds per request (0.0 seconds in total)
  1028.5 requests per second
  'https://ci.guix.gnu.org/api/queue?nr=1000' returned 504 ("Gateway Time-out")
--8<---------------cut here---------------end--------------->8---

and on x86_64-linux

--8<---------------cut here---------------start------------->8---
computing 37 package derivations for i686-linux...
looking for 37 store items on https://ci.guix.gnu.org...
https://ci.guix.gnu.org
  81.1% substitutes available (30 out of 37)
  at least 165.9 MiB of nars (compressed)
  423.3 MiB on disk (uncompressed)
  0.001 seconds per request (0.1 seconds in total)
  703.3 requests per second
  'https://ci.guix.gnu.org/api/queue?nr=1000' returned 504 ("Gateway Time-out")
--8<---------------cut here---------------end--------------->8---

I have attached manifest files for the packages directly using
`url-fetch/tarbomb' or `url-fetch/zipbomb' [1] and for all affected
packages [2] (they use the aforementioned script).

I think this patch can go on master even though it triggers more than
300 rebuilds, since there are currently no substitutes available for the
affected packages anyway.

Regards,

Diego

PS I hope I got all the terminology (e.g. computing vs. building a
derivation) right.

[0]: 

[-- Attachment #2: uses-tarbomb-zipbomb.scm --]
[-- Type: application/octet-stream, Size: 1819 bytes --]

(use-modules (gnu packages)
             (guix packages)
             (guix download)
             (srfi srfi-1))

(define (uses-origin-methods? methods package)
  (and (package-source package)
       (if (list? methods)
           (and
            (member (origin-method (package-source package)) methods)
            #t)
           (eq? (origin-method (package-source package)) methods))))

(define (somehow-depends-on-origin-methods? methods package)
  (not
   (null?
    (fold
     (lambda (p lst)
       (if (uses-origin-methods? methods p)
           (cons p lst)
           lst))
     '()
     (package-closure (list package))))))

(define (all-directly-affected-packages methods)
  (fold-packages
   (lambda (p r)
     (if (uses-origin-methods? methods p)
         (cons p r) r))
   '()))

(define (all-affected-packages methods)
  (fold-packages
   (lambda (p r)
     (if (somehow-depends-on-origin-methods? methods p)
         (cons p r) r))
   '()))

(define (package-name+version package)
  (string-append
   (package-name package)
   "@"
   (package-version package)))

(define (display-affected-packages)
  (let ((tarbomb+zipbomb-direct
         (all-directly-affected-packages `(,url-fetch/tarbomb ,url-fetch/zipbomb)))
        (tarbomb+zipbomb-all
         (all-affected-packages `(,url-fetch/tarbomb ,url-fetch/zipbomb))))
    (format #t "~&~d packages use url-fetch/tarbomb or url-fetch/zipbomb:~
                ~&~{~a~@{ ~a~}~}~%~
                ~&~d packages depend indirectly on url-fetch/tarbomb or url-fetch/zipbomb:~
                ~&~{~a~@{ ~a~}~}~%~"
            (length tarbomb+zipbomb-direct)
            (sort (map package-name+version tarbomb+zipbomb-direct) string<)
            (length tarbomb+zipbomb-all)
            (sort (map package-name+version tarbomb+zipbomb-all) string<))))

[-- Attachment #3: Type: text/plain, Size: 5 bytes --]

[1]: 

[-- Attachment #4: tarbomb-zipbomb-manifest-small.scm --]
[-- Type: application/octet-stream, Size: 276 bytes --]

;; Evaluate to a manifest containing all packages that use
;; `url-fetch/tarbomb' or `url-fetch/zipbomb' as the origin-method of
;; their source.
(load "uses-tarbomb-zipbomb.scm")
(packages->manifest
 (all-directly-affected-packages `(,url-fetch/tarbomb ,url-fetch/zipbomb)))

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

[2]: 

[-- Attachment #6: tarbomb-zipbomb-manifest-full.scm --]
[-- Type: application/octet-stream, Size: 241 bytes --]

;; Evaluate to a manifest containing all packages that somehow depend
;; on `url-fetch/tarbomb' or `url-fetch/zipbomb'.
(load "uses-tarbomb-zipbomb.scm")
(packages->manifest
 (all-affected-packages `(,url-fetch/tarbomb ,url-fetch/zipbomb)))