me
/
guix
Archived
1
0
Fork 0
Code

installer: Add crash dump upload support. 

Suggested-by: Josselin Poiret <dev@jpoiret.xyz>

* gnu/installer/dump.scm: New file.
* gnu/installer/newt/dump.scm: New file.
* gnu/local.mk (INSTALLER_MODULES): Add them.
* gnu/installer/record.scm (<installer>)[dump-page]: New field.
* gnu/installer/steps.scm (%current-result): New variable.
(run-installer-steps): Update it.
* gnu/installer.scm (installer-program): Add tar and gip to the installer
path. Add guile-webutils and gnutls to the Guile extensions. Generate and send
the crash dump report.
* gnu/installer/newt.scm (exit-error): Add a report argument. Display the
report id.
(dump-page): New procedure.
(newt-installer): Update it.
master
Mathieu Othacehe 2021-12-29 13:45:26 +01:00
parent 8f58508327
commit 0d37a5df7e
No known key found for this signature in database
GPG Key ID: 8354763531769CA6
7 changed files with 183 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gnu/installer.scm
View File

@ -33,6 +33,7 @@
#:use-module (gnu packages admin)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages compression)
#:use-module (gnu packages connman)
#:use-module (gnu packages cryptsetup)
#:use-module (gnu packages disk)
@ -336,6 +337,8 @@ selected keymap."
guix ;guix system init call
util-linux ;mkwap
shadow
tar ;dump
gzip ;dump
coreutils)))
(with-output-to-port (%make-void-port "w")
(lambda ()
@ -352,7 +355,8 @@ selected keymap."
;; packages …), etc. modules.
(with-extensions (list guile-gcrypt guile-newt
guile-parted guile-bytestructures
guile-json-3 guile-git guix gnutls)
guile-json-3 guile-git guile-webutils
guix gnutls)
(with-imported-modules `(,@(source-module-closure
`(,@modules
(gnu services herd)
@ -363,6 +367,7 @@ selected keymap."
(use-modules (gnu installer record)
(gnu installer keymap)
(gnu installer steps)
(gnu installer dump)
(gnu installer final)
(gnu installer hostname)
(gnu installer locale)
@ -432,15 +437,22 @@ selected keymap."
(lambda (key . args)
(syslog "crashing due to uncaught exception: ~s ~s~%"
key args)
(let ((error-file "/tmp/last-installer-error"))
(let ((error-file "/tmp/last-installer-error")
(dump-archive "/tmp/dump.tgz"))
(call-with-output-file error-file
(lambda (port)
(display-backtrace (make-stack #t) port)
(print-exception port
(stack-ref (make-stack #t) 1)
key args)))
((installer-exit-error current-installer)
error-file key args))
(make-dump dump-archive
#:result %current-result
#:backtrace error-file)
(let ((report
((installer-dump-page current-installer)
dump-archive)))
((installer-exit-error current-installer)
error-file report key args)))
(primitive-exit 1)))
((installer-exit current-installer)))))))

103
gnu/installer/dump.scm 100644
View File

@ -0,0 +1,103 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer dump)
#:use-module (gnu installer utils)
#:use-module (guix build utils)
#:use-module (srfi srfi-11)
#:use-module (ice-9 iconv)
#:use-module (ice-9 match)
#:use-module (ice-9 popen)
#:use-module (ice-9 textual-ports)
#:use-module (web client)
#:use-module (web http)
#:use-module (web response)
#:use-module (webutils multipart)
#:export (make-dump
send-dump-report))
;; The installer crash dump type.
(define %dump-type "installer-dump")
(define (result->list result)
"Return the alist for the given RESULT."
(hash-map->list (lambda (k v)
(cons k v))
result))
(define* (make-dump output
#:key
result
backtrace)
"Create a crash dump archive in OUTPUT. RESULT is the installer result hash
table. BACKTRACE is the installer Guile backtrace."
(let ((dump-dir "/tmp/dump"))
(mkdir-p dump-dir)
(with-directory-excursion dump-dir
;; backtrace
(copy-file backtrace "installer-backtrace")
;; installer result
(call-with-output-file "installer-result"
(lambda (port)
(write (result->list result) port)))
;; syslog
(copy-file "/var/log/messages" "syslog")
;; dmesg
(let ((pipe (open-pipe* OPEN_READ "dmesg")))
(call-with-output-file "dmesg"
(lambda (port)
(dump-port pipe port)
(close-pipe pipe)))))
(with-directory-excursion (dirname dump-dir)
(system* "tar" "-zcf" output (basename dump-dir)))))
(define* (send-dump-report dump
#:key
(url "https://dump.guix.gnu.org"))
"Turn the DUMP archive into a multipart body and send it to the Guix crash
dump server at URL."
(define (match-boundary kont)
(match-lambda
(('boundary . (? string? b))
(kont b))
(x #f)))
(define (response->string response)
(bytevector->string
(read-response-body response)
"UTF-8"))
(let-values (((body boundary)
(call-with-input-file dump
(lambda (port)
(format-multipart-body
`((,%dump-type . ,port)))))))
(false-if-exception
(response->string
(http-post
(string-append url "/upload")
#:keep-alive? #t
#:streaming? #t
#:headers `((content-type
. (multipart/form-data
(boundary . ,boundary))))
#:body body)))))

18
gnu/installer/newt.scm
View File

@ -19,6 +19,7 @@
(define-module (gnu installer newt)
#:use-module (gnu installer record)
#:use-module (gnu installer utils)
#:use-module (gnu installer newt dump)
#:use-module (gnu installer newt ethernet)
#:use-module (gnu installer newt final)
#:use-module (gnu installer newt parameters)
@ -55,16 +56,19 @@
(newt-finish)
(clear-screen))
(define (exit-error file key args)
(define (exit-error file report key args)
(newt-set-color COLORSET-ROOT "white" "red")
(let ((width (nearest-exact-integer
(* (screen-columns) 0.8)))
(height (nearest-exact-integer
(* (screen-rows) 0.7))))
(* (screen-rows) 0.7)))
(report (if report
(format #f ". It has been uploaded as ~a" report)
"")))
(run-file-textbox-page
#:info-text (format #f (G_ "The installer has encountered an unexpected \
problem. The backtrace is displayed below. Please report it by email to \
<~a>.") %guix-bug-report-address)
problem. The backtrace is displayed below~a. Please report it by email to \
<~a>.") report %guix-bug-report-address)
#:title (G_ "Unexpected problem")
#:file file
#:exit-button? #f
@ -123,6 +127,9 @@ problem. The backtrace is displayed below. Please report it by email to \
(define (parameters-page keyboard-layout-selection)
(run-parameters-page keyboard-layout-selection))
(define (dump-page steps)
(run-dump-page steps))
(define newt-installer
(installer
(name 'newt)
@ -142,4 +149,5 @@ problem. The backtrace is displayed below. Please report it by email to \
(services-page services-page)
(welcome-page welcome-page)
(parameters-menu parameters-menu)
(parameters-page parameters-page)))
(parameters-page parameters-page)
(dump-page dump-page)))

36
gnu/installer/newt/dump.scm 100644
View File

@ -0,0 +1,36 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu installer newt dump)
#:use-module (gnu installer dump)
#:use-module (gnu installer newt page)
#:use-module (guix i18n)
#:use-module (newt)
#:export (run-dump-page))
(define (run-dump-page dump)
"Run a dump page, proposing the user to upload the crash dump to Guix
servers."
(case (choice-window
(G_ "Crash dump upload")
(G_ "Yes")
(G_ "No")
(G_ "The installer failed. Do you accept to upload the crash dump \
to Guix servers, so that we can investigate the issue?"))
((1) (send-dump-report dump))
((2) #f)))

7
gnu/installer/record.scm
View File

@ -41,7 +41,8 @@
installer-services-page
installer-welcome-page
installer-parameters-menu
installer-parameters-page))
installer-parameters-page
installer-dump-page))
;;;
@ -91,4 +92,6 @@
;; procedure (menu-proc) -> void
(parameters-menu installer-parameters-menu)
;; procedure (keyboard-layout-selection) -> void
(parameters-page installer-parameters-page))
(parameters-page installer-parameters-page)
;; procedure (dump) -> void
(dump-page installer-dump-page))

9
gnu/installer/steps.scm
View File

@ -52,7 +52,13 @@
%installer-configuration-file
%installer-target-dir
format-configuration
configuration->file))
configuration->file
%current-result))
;; Hash table storing the step results. Use it only for logging and debug
;; purposes.
(define %current-result (make-hash-table))
;; This condition may be raised to abort the current step.
(define-condition-type &installer-step-abort &condition
@ -183,6 +189,7 @@ return the accumalated result so far."
(let* ((id (installer-step-id step))
(compute (installer-step-compute step))
(res (compute result done-steps)))
(hash-set! %current-result id res)
(run (alist-cons id res result)
#:todo-steps rest-steps
#:done-steps (append done-steps (list step))))))))

2
gnu/local.mk
View File

@ -758,6 +758,7 @@ GNU_SYSTEM_MODULES = \
INSTALLER_MODULES = \
%D%/installer.scm \
%D%/installer/connman.scm \
%D%/installer/dump.scm \
%D%/installer/final.scm \
%D%/installer/hostname.scm \
%D%/installer/keymap.scm \
@ -774,6 +775,7 @@ INSTALLER_MODULES = \
%D%/installer/user.scm \
%D%/installer/utils.scm \
\
%D%/installer/newt/dump.scm \
%D%/installer/newt/ethernet.scm \
%D%/installer/newt/final.scm \
%D%/installer/newt/parameters.scm \