bug#40525: inferior process on core-updates crashes: mmap(PROT_NONE) failed

[Christopher Baines <mail@cbaines.net>]

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


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

> Hi,
>
> Christopher Baines <mail@cbaines.net> skribis:
>
>> At some point, usually when extracting the information about lint
>> warnings, package derivations or system tests, the inferior guix repl
>> crashes.
>
> Could you come up with a simpler reproducer?  What do we need to send to
> the inferior to reach that crash?

I've attached a script that when run should reproduce the issue. I
extracted the code relating to lint warnings from the Guix Data
Service. The script attached runs this code twice against the inferior,
once will often be enough to cause it to crash, but twice should
reproduce it more reliably.


[-- Attachment #1.2: inferior-script --]
[-- Type: text/plain, Size: 5025 bytes --]

(use-modules (ice-9 match)
             (guix inferior)
             (guix channels)
             (guix store))

(define (all-inferior-lint-warnings inf store)
  (define locales
    '("cs_CZ.utf8"
      "da_DK.utf8"
      "de_DE.utf8"
      "eo_EO.utf8"
      "es_ES.utf8"
      "fr_FR.utf8"
      "hu_HU.utf8"
      "pl_PL.utf8"
      "pt_BR.utf8"
      ;;"sr_SR.utf8"
      "sv_SE.utf8"
      "vi_VN.utf8"
      "zh_CN.utf8"))

  (define (lint-warnings-for-checker checker-name)
    `(lambda (store)
       (let* ((checker (find (lambda (checker)
                               (eq? (lint-checker-name checker)
                                    ',checker-name))
                             %local-checkers))
              (check (lint-checker-check checker)))

         (define lint-checker-requires-store?-defined?
           (defined? 'lint-checker-requires-store?
             (resolve-module '(guix lint))))

         (define (process-lint-warning lint-warning)
           (list
            (match (lint-warning-location lint-warning)
              (($ <location> file line column)
               (list (if (string-prefix? "/gnu/store/" file)
                         ;; Convert a string like
                         ;; /gnu/store/53xh0mpigin2rffg31s52x5dc08y0qmr-guix-module-union/share/guile/site/2.2/gnu/packages/xdisorg.scm
                         ;;
                         ;; This happens when the checker uses
                         ;; package-field-location.
                         (string-join (drop (string-split file #\/) 8) "/")
                         file)
                     line
                     column)))
            (let* ((source-locale "en_US.utf8")
                   (source-message
                    (begin
                      (setlocale LC_MESSAGES source-locale)
                      (lint-warning-message lint-warning)))
                   (messages-by-locale
                    (filter-map
                     (lambda (locale)
                       (catch 'system-error
                         (lambda ()
                           (setlocale LC_MESSAGES locale))
                         (lambda (key . args)
                           (error
                            (simple-format
                             #f
                             "error changing locale to ~A: ~A ~A"
                             locale key args))))
                       (let ((message
                              (lint-warning-message lint-warning)))
                         (setlocale LC_MESSAGES source-locale)
                         (if (string=? message source-message)
                             #f
                             (cons locale message))))
                     (list ,@locales))))
              (cons (cons source-locale source-message)
                    messages-by-locale))))

         (filter
          (match-lambda
            ((package-id . warnings)
             (not (null? warnings)))
            (a
             (error (simple-format #f "NO MATCH FOR ~A\n" a))))
          (hash-map->list
           (lambda (package-id package)
             (cons
              package-id
              (catch
                #t
                (lambda ()
                  (map process-lint-warning
                       (if (and lint-checker-requires-store?-defined?
                                (lint-checker-requires-store? checker))

                           (check package #:store store)
                           (check package))))
                (lambda (key . args)
                  '()))))
           %package-table)))))

  (inferior-eval '(use-modules (srfi srfi-1)
                               (guix lint)) inf)
  (inferior-packages inf)
  (let ((checkers
         (inferior-eval
          '(begin
             (map (lambda (checker)
                    (list (lint-checker-name checker)
                          (lint-checker-description checker)
                          (if (memq checker %network-dependent-checkers)
                              #t
                              #f)))
                  %all-checkers))
          inf)))
    (map
     (match-lambda
       ((name description network-dependent?)
        (cons
         (list name description network-dependent?)
         (if network-dependent?
             '()
             (inferior-eval-with-store inf store (lint-warnings-for-checker
                                                  name))))))
     checkers)))

(let* ((channel
        (channel
         (name 'guix)
         (commit "d523eb5c9c2659cbbaf4eeef3691234ae527ee6a")
         (url "https://git.savannah.gnu.org/git/guix.git")))
       (inferior
        (inferior-for-channels (list channel)))
       (result
        (with-store store
          (all-inferior-lint-warnings inferior store)
          ;; Running all-inferior-lint-warnings once doesn't seem to always
          ;; produce the crash, so just run it again
          (all-inferior-lint-warnings inferior store))))
  (peek "RESULT" result))

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