[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/06: installer: Add crash dump upload support.
From: |
guix-commits |
Subject: |
03/06: installer: Add crash dump upload support. |
Date: |
Thu, 30 Dec 2021 05:38:23 -0500 (EST) |
mothacehe pushed a commit to branch wip-harden-installer
in repository guix.
commit 22158d407af89d2f3df3abd8005ec2321df45c74
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Wed Dec 29 13:45:26 2021 +0100
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.
---
gnu/installer.scm | 20 +++++++--
gnu/installer/dump.scm | 103 ++++++++++++++++++++++++++++++++++++++++++++
gnu/installer/newt.scm | 18 +++++---
gnu/installer/newt/dump.scm | 36 ++++++++++++++++
gnu/installer/record.scm | 7 ++-
gnu/installer/steps.scm | 9 +++-
gnu/local.mk | 2 +
7 files changed, 183 insertions(+), 12 deletions(-)
diff --git a/gnu/installer.scm b/gnu/installer.scm
index c8b7a66cfc..d57b1d673a 100644
--- a/gnu/installer.scm
+++ b/gnu/installer.scm
@@ -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)))))))
diff --git a/gnu/installer/dump.scm b/gnu/installer/dump.scm
new file mode 100644
index 0000000000..49c40a26af
--- /dev/null
+++ b/gnu/installer/dump.scm
@@ -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)))))
diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm
index 4f7fc6f4dc..d48e2c0129 100644
--- a/gnu/installer/newt.scm
+++ b/gnu/installer/newt.scm
@@ -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)))
diff --git a/gnu/installer/newt/dump.scm b/gnu/installer/newt/dump.scm
new file mode 100644
index 0000000000..64f0d58237
--- /dev/null
+++ b/gnu/installer/newt/dump.scm
@@ -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)))
diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm
index 0b34318c45..e7cd45ee83 100644
--- a/gnu/installer/record.scm
+++ b/gnu/installer/record.scm
@@ -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))
diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm
index c05dfa567a..55433cff31 100644
--- a/gnu/installer/steps.scm
+++ b/gnu/installer/steps.scm
@@ -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))))))))
diff --git a/gnu/local.mk b/gnu/local.mk
index fc8927df9f..96d004ddb8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -753,6 +753,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 \
@@ -769,6 +770,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 \
- branch wip-harden-installer created (now edf808ddb3), guix-commits, 2021/12/30
- 02/06: installer: Check if ci.guix.gnu.org can be reached., guix-commits, 2021/12/30
- 01/06: installer: Ignore small devices., guix-commits, 2021/12/30
- 03/06: installer: Add crash dump upload support.,
guix-commits <=
- 05/06: installer: Do not set the locale in run-command., guix-commits, 2021/12/30
- 06/06: installer: Install the locale before mounting the cow-store., guix-commits, 2021/12/30
- 04/06: installer: Remove an unused procedure., guix-commits, 2021/12/30