aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2021-12-29 13:45:26 +0100
committerMathieu Othacehe <othacehe@gnu.org>2022-02-02 16:46:42 +0100
commit0d37a5df7e709cadca97cfbbf9c680dfe54b8302 (patch)
treef9b5877771fe70c92d7b7db327419dc2c6fd7c76 /gnu/installer
parent8f585083277e64ea1e9a0848ef3c49f12327618c (diff)
downloadguix-0d37a5df7e709cadca97cfbbf9c680dfe54b8302.tar
guix-0d37a5df7e709cadca97cfbbf9c680dfe54b8302.tar.gz
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.
Diffstat (limited to 'gnu/installer')
-rw-r--r--gnu/installer/dump.scm103
-rw-r--r--gnu/installer/newt.scm18
-rw-r--r--gnu/installer/newt/dump.scm36
-rw-r--r--gnu/installer/record.scm7
-rw-r--r--gnu/installer/steps.scm9
5 files changed, 165 insertions, 8 deletions
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))))))))