From patchwork Mon Jan 17 10:16:56 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Mathieu Othacehe X-Patchwork-Id: 36414 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id DBBB427BBEA; Mon, 17 Jan 2022 10:18:11 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 23CFA27BBE9 for ; Mon, 17 Jan 2022 10:18:11 +0000 (GMT) Received: from localhost ([::1]:55542 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n9P5W-00075m-AR for patchwork@mira.cbaines.net; Mon, 17 Jan 2022 05:18:10 -0500 Received: from eggs.gnu.org ([209.51.188.92]:55648) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n9P5O-000739-FO for guix-patches@gnu.org; Mon, 17 Jan 2022 05:18:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:51929) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n9P5O-0004Pu-5W for guix-patches@gnu.org; Mon, 17 Jan 2022 05:18:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n9P5O-0005x3-2F for guix-patches@gnu.org; Mon, 17 Jan 2022 05:18:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH wip-harden-installer 00/14] General improvements to the installer Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 17 Jan 2022 10:18:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53063 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: Josselin Poiret Cc: 53063@debbugs.gnu.org, ludo@gnu.org Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.164241463522819 (code B ref 53063); Mon, 17 Jan 2022 10:18:02 +0000 Received: (at 53063) by debbugs.gnu.org; 17 Jan 2022 10:17:15 +0000 Received: from localhost ([127.0.0.1]:44832 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n9P4c-0005vz-OB for submit@debbugs.gnu.org; Mon, 17 Jan 2022 05:17:15 -0500 Received: from eggs.gnu.org ([209.51.188.92]:54764) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n9P4a-0005vm-W3 for 53063@debbugs.gnu.org; Mon, 17 Jan 2022 05:17:13 -0500 Received: from [2001:470:142:3::e] (port=34902 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n9P4Q-0004Lw-1R; Mon, 17 Jan 2022 05:17:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:In-Reply-To:Date:References:Subject:To: From; bh=Ud26A82hwWwexdIHnjFe2tYEMyc3oPTUJ+jY40oVcuo=; b=F/kRBc40t6QKDzdI/Q1/ BREmAVDWd7emOfvCXHxiBR2rvojjBYhuYkJ/Y4+YiPu9JlnY/jpteLQT8otHw6KBHaFB92VmZH+eh COOkNb2hqf0Vmc6ug9Mtlahq8hrnTRuyKt0AwWJh8jy2Kg03fFVIHvpi0MisbuFHUVw56Kj8r5xEy eDdqoJ68upFPOdivkPzEDlx7SCJIrGTiRHWTb9h31UHzMot3BkkzoVijFA0r15j/KKY9vZuW3v0j+ EtvurVvnCBh7Y9ab9TTWDIV4mZqbX1o8r2GjMg0jTfBkph+lCy71sOBXAE8lbG5rfK16ELqtU2Fdl 12idVVBwML2zhA==; Received: from 2a01cb0011931a00ba95d96066391583.ipv6.abo.wanadoo.fr ([2a01:cb00:1193:1a00:ba95:d960:6639:1583]:46328 helo=meije) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n9P4O-0006cA-CD; Mon, 17 Jan 2022 05:17:01 -0500 From: Mathieu Othacehe References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> Date: Mon, 17 Jan 2022 11:16:56 +0100 In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> (Josselin Poiret's message of "Sat, 15 Jan 2022 14:49:53 +0100") Message-ID: <87mtju3bvr.fsf_-_@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches Hey Josselin, Great work! > It expands upon the initial work of Mathieu in 84d0d8ad3d. For now, > you can choose to include the installer backtrace, the installer > result alist, and the syslog and dmesg. We could also include a more > stripped down installer-log that the new logging facility produces, > but I think that it should be enough for now. I tweaked this commit a little bit to add an horizontal left anchor. > Things work smoothly on my end, but the installer test > "gui-installed-os" seems to fail while running `guix system init`, > when building linux-libre, but it seems unrelated to this patchset. Things works really fine here too, I pushed the series on the wip-harden-installer to have Cuirass run the installer tests. Here are the few modifications I made: --8<---------------cut here---------------start------------->8--- <---------------cut here---------------end--------------->8--- If it's OK for you, I think we can proceed as the concerns that Ludo raised on the dump mechanism are addressed. Ludo do you agree? Thanks, Mathieu diff --git a/gnu/installer.scm b/gnu/installer.scm index 01eda04774..7b2914be98 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -420,7 +420,6 @@ (define steps (#$steps current-installer)) (dynamic-wind (installer-init current-installer) - (lambda () (parameterize ((run-command-in-installer @@ -439,15 +438,15 @@ (define results (sync) (stop-service 'root)) (_ - ;; The installation failed, exit so that it is restarted - ;; by login. + ;; The installation failed, exit so that it is + ;; restarted by login. #f))) (const #f) (lambda (key . args) (installer-log-line "crashing due to uncaught exception: ~s ~s" key args) - (define dump-dir (prepare-dump key args - #:result %current-result)) + (define dump-dir + (prepare-dump key args #:result %current-result)) (define action ((installer-exit-error current-installer) (get-string-all @@ -458,7 +457,8 @@ (define action (let* ((dump-files ((installer-dump-page current-installer) dump-dir)) - (dump-archive (make-dump dump-dir dump-files))) + (dump-archive + (make-dump dump-dir dump-files))) ((installer-report-page current-installer) dump-archive))) (_ #f)) diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index 2646b5d369..1db78e6f0d 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -45,6 +45,7 @@ (define-module (gnu installer newt) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 ftw) + #:use-module (ice-9 match) #:use-module (newt) #:export (newt-installer)) @@ -71,8 +72,8 @@ (define action #:content error #:buttons-spec (list - (cons (G_ "Exit") (const 'exit)) - (cons (G_ "Dump") (const 'dump))))) + (cons (G_ "Dump") (const 'dump)) + (cons (G_ "Exit") (const 'exit))))) (newt-set-color COLORSET-ROOT "white" "blue") action) @@ -96,10 +97,11 @@ (define files (scandir dump-dir (lambda (x) (not (or (string=? x ".") (string=? x "..")))))) - (fold (lambda (file-choice acc) - (if (cdr file-choice) - (cons (car file-choice) acc) - acc)) + (fold (match-lambda* + (((file . enable?) acc) + (if enable? + (cons file acc) + acc))) '() (run-dump-page dump-dir @@ -144,7 +146,7 @@ (define stop-sig (status:stop-sig result)) (cons "Abort" (lambda () (abort-to-prompt 'installer-step 'abort))) - (cons "Dump" + (cons "Report" (lambda () (raise (condition diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 060e633254..0f508a31c0 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -910,22 +910,29 @@ (define info-textbox (define components (map (match-lambda ((file . enabled) (list - (make-button -1 -1 "Edit") + (make-compact-button -1 -1 "Edit") (make-checkbox -1 -1 file (if enabled #\x #\ ) " x") file))) file-choices)) + + (define sub-grid (make-grid 2 (length components))) + + (for-each + (match-lambda* (((button checkbox _) index) + (set-grid-field sub-grid 0 index + GRID-ELEMENT-COMPONENT checkbox + #:anchor ANCHOR-LEFT) + (set-grid-field sub-grid 1 index + GRID-ELEMENT-COMPONENT button + #:anchor ANCHOR-LEFT))) + components (iota (length components))) + (define grid - (apply vertically-stacked-grid + (vertically-stacked-grid GRID-ELEMENT-COMPONENT info-textbox - (append - (append-map - (match-lambda ((button checkbox _) - (list GRID-ELEMENT-SUBGRID - (horizontal-stacked-grid - GRID-ELEMENT-COMPONENT checkbox - GRID-ELEMENT-COMPONENT button)))) - components) - (list GRID-ELEMENT-COMPONENT (make-button -1 -1 "Create"))))) + GRID-ELEMENT-SUBGRID sub-grid + GRID-ELEMENT-COMPONENT (make-button -1 -1 "Create"))) + (define form (make-form #:flags FLAG-NOF12)) (add-form-to-grid grid form #t) @@ -942,13 +949,13 @@ (define prompt-tag (make-prompt-tag)) (match exit-reason ('exit-component (let ((result - (map (match-lambda - ((edit checkbox filename) - (if (components=? edit argument) - (abort-to-prompt prompt-tag filename) - (cons filename (eq? #\x - (checkbox-value checkbox)))))) - components))) + (map (match-lambda + ((edit checkbox filename) + (if (components=? edit argument) + (abort-to-prompt prompt-tag filename) + (cons filename (eq? #\x + (checkbox-value checkbox)))))) + components))) (destroy-form-and-pop form) result)) ;; TODO diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm index 13114e9832..c894a91dc8 100644 --- a/gnu/installer/user.scm +++ b/gnu/installer/user.scm @@ -41,6 +41,7 @@ (define-record-type (make-secret content) secret? (content secret-content)) + (set-record-type-printer! (lambda (secret port) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 4f7c691690..fb62fb8896 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -108,19 +108,20 @@ (define dummy-pipe (close-pipe dummy-pipe))) (define (run-external-command-with-line-hooks line-hooks command) - "Run command specified by ARGS in a child, processing each output line with -the procedures in LINE-HOOKS. Returns the integer status value of -the child process as returned by waitpid." + "Run command specified by the list COMMAND in a child, processing each +output line with the procedures in LINE-HOOKS. Returns the integer status +value of the child process as returned by waitpid." (define (handler input) - (and (and=> (get-line input) - (lambda (line) - (if (eof-object? line) - #f - (begin (for-each (lambda (f) (f line)) - (append line-hooks - %default-installer-line-hooks)) - #t)))) - (handler input))) + (and + (and=> (get-line input) + (lambda (line) + (if (eof-object? line) + #f + (begin (for-each (lambda (f) (f line)) + (append line-hooks + %default-installer-line-hooks)) + #t)))) + (handler input))) (run-external-command-with-handler handler command)) (define* (run-command command)--8