GNU bug report logs - #50264
ca-certificate-bundle fails to build

Previous Next

Full log

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

From: Ludovic Courtès <ludo <at> gnu.org>
To: Lars-Dominik Braun <lars <at> 6xq.net>
Cc: 50264 <at> debbugs.gnu.org, Leo Famulari <leo <at> famulari.name>
Subject: Re: bug#50264: ca-certificate-bundle fails to build
Date: Wed, 15 Sep 2021 18:30:04 +0200

[Message part 1 (text/plain, inline)]

And for posterity, here’s the script I used to reproduce the problem:
it’d pick 10 packages at random and call ‘ca-certificate-bundle’ on them.

Since this bug depends on what’s in the store, I’d run it on my laptop,
which only contains a fraction of the 18K packages in Guix, so it would
reproduce the bug after a couple of iterations.

That, together with the inevitable ‘pk’ calls plus a bit of chance, voilà!

Ludo’.

[ca-certificate-bundle.scm (text/plain, inline)]

;; https://issues.guix.gnu.org/50264

(use-modules (gnu) (guix)
             (guix profiles) (guix monads)
             (ice-9 match) (srfi srfi-1))

(define (all-packages)
  "Return the list of all the packages, public or private, omitting only
superseded packages."
  (fold-packages (lambda (package lst)
                   (match (package-replacement package)
                     (#f (cons package lst))
                     (replacement
                      (append (list replacement package) lst))))
                 '()
                 #:select? (negate package-superseded)))

(define (random-seed)
  (logxor (getpid) (car (gettimeofday))))

(define shuffle                                   ;from offload.scm
  (let ((state (seed->random-state (random-seed))))
    (lambda (lst)
      "Return LST shuffled (using the Fisher-Yates algorithm.)"
      (define vec (list->vector lst))
      (let loop ((result '())
                 (i (vector-length vec)))
        (if (zero? i)
            result
            (let* ((j (random i state))
                   (val (vector-ref vec j)))
              (vector-set! vec j (vector-ref vec (- i 1)))
              (loop (cons val result) (- i 1))))))))

(define (test packages)
  (pk 'testing-packages (map package-full-name packages))
  (let ((manifest (packages->manifest packages)))
    (with-store store
      (let ((drv (run-with-store store
                   (ca-certificate-bundle manifest))))
        (pk 'drv drv)
        (unless (find (lambda (input)
                        (let ((drv (derivation-input-derivation input)))
                          (string-prefix? "glibc-utf8-locales"
                                          (derivation-name drv))))
                      (derivation-inputs drv))
          (pk 'drv drv (derivation-inputs drv))
          (display-backtrace (make-stack #t) (current-error-port))
          (error "bah!" drv))
        (newline) (newline)))))

(let loop ((packages (shuffle (all-packages))))
  (test (take packages 10))
  (loop (drop packages 10)))

Previous Next

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