From patchwork Sat Jan 15 13:49:54 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36383 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 EFE3727BBEA; Sat, 15 Jan 2022 13:54:44 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 81A3527BBE9 for ; Sat, 15 Jan 2022 13:54:44 +0000 (GMT) Received: from localhost ([::1]:44296 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jVz-0000x1-OK for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:54:43 -0500 Received: from eggs.gnu.org ([209.51.188.92]:38002) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jTc-00066e-B1 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:16 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46644) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jTO-0004RA-Gs for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jTO-0001uP-GQ for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 01/18] installer: Use define instead of let at top-level. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:52: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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546757230 (code B ref 53063); Sat, 15 Jan 2022 13:52:02 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:51:15 +0000 Received: from localhost ([127.0.0.1]:39539 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jSc-0001sR-Fl for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:51:14 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48200) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRo-0001mJ-UT for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:40 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id EA4E4184F7F; Sat, 15 Jan 2022 13:50:23 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254624; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=AYAELU2YYSxP6xZiza7ofFvxFOT2oqZL5X+TXp7zLvg=; b=EXrIB8GKWho+sga9HxKSHyb05zmKkfJYzJsBVJ+KlAELJ2xD0gY9vIRkQzgPpy5GS3CewW QaQbOQdSTsOaujJ0dYPBFrzqcMX8AXLI88xeoL6Bv6wP/WdsO6FWJ1YZlkDr0Nw/m8aPii M4zawsDkcL23oLZGsbE5MXOYliTeWmjcc6286sltX/uopoYEtbr1qMIEVu9Fvtkqgf0mjs 14RXd0JotvwoNH+8cM28iYydmtKCjSdauUX628LCR7xQqGaZTZ9tYeBER5hzWPRitJaSb5 uisMlnoRmZvT2R+19ClNtDIGbCOTLfILD46bhSPTxtAAUCxXx6ccSwwFXF85Sw== Date: Sat, 15 Jan 2022 14:49:54 +0100 Message-Id: <20220115135011.5817-2-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer.scm (installer-program): Improve readability by using define at top-level. --- gnu/installer.scm | 88 +++++++++++++++++++++++------------------------ 1 file changed, 44 insertions(+), 44 deletions(-) diff --git a/gnu/installer.scm b/gnu/installer.scm index d57b1d673a..134fa2faaf 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -412,50 +412,50 @@ (define installer-builder ;; verbose. (terminal-width 200) - (let* ((current-installer newt-installer) - (steps (#$steps current-installer))) - ((installer-init current-installer)) - - (catch #t - (lambda () - (define results - (run-installer-steps - #:rewind-strategy 'menu - #:menu-proc (installer-menu-page current-installer) - #:steps steps)) - - (match (result-step results 'final) - ('success - ;; We did it! Let's reboot! - (sync) - (stop-service 'root)) - (_ - ;; The installation failed, exit so that it is restarted - ;; by login. - #f))) - (const #f) - (lambda (key . args) - (syslog "crashing due to uncaught exception: ~s ~s~%" - key args) - (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))) - (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))))))) + (define current-installer newt-installer) + (define steps (#$steps current-installer)) + ((installer-init current-installer)) + + (catch #t + (lambda () + (define results + (run-installer-steps + #:rewind-strategy 'menu + #:menu-proc (installer-menu-page current-installer) + #:steps steps)) + + (match (result-step results 'final) + ('success + ;; We did it! Let's reboot! + (sync) + (stop-service 'root)) + (_ + ;; The installation failed, exit so that it is restarted + ;; by login. + #f))) + (const #f) + (lambda (key . args) + (syslog "crashing due to uncaught exception: ~s ~s~%" + key args) + (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))) + (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)))))) (program-file "installer" From patchwork Sat Jan 15 13:49:55 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36369 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 43C2027BBEA; Sat, 15 Jan 2022 13:52:36 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 0C66B27BBE9 for ; Sat, 15 Jan 2022 13:52:36 +0000 (GMT) Received: from localhost ([::1]:39178 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jTv-0005sH-0p for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:35 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37768) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0005Dt-6o for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46620) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSR-0004Eq-OM for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSR-0001qq-N9 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 02/18] installer: Generalize logging facility. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:03 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546406976 (code B ref 53063); Sat, 15 Jan 2022 13:51:03 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:40 +0000 Received: from localhost ([127.0.0.1]:39496 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS2-0001o7-GA for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:39 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48304) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRp-0001mL-Mm for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:29 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id BF340184F80; Sat, 15 Jan 2022 13:50:24 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254625; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=comZ3T0WPU6rg1EpDXPEwhpUMK5cwKjVah2oaCEIaCs=; b=QE8BvtfJBM95AqVB2EV4lVvHLEsCLPJAFOeewadZw3p4Fx5KcokHOwf7tcBtIl8/WDeE3Y 3qEc1hHb3TA/QJI1wPiC2/+IuurOQ5Tusz2IGbE7bzmFAAUqwpTbbh3FE81kvhZIvkCau7 FYF+Y8D8DXbUUyWf+QHmnSeAiqzSMNHVK/5F3jrtoNNzx1L6iXrk/71clIRjzH9SisSx3j Jsoiizeih2Bj7jaPdL3q+4KiLjICoulk7Go5HLSBFqpyu17llSRs2ermD1Ks77ZEieBAlj 8ttaOw1oR94IV1DZtqleEHVHdijZJv//JpXHpUSr2FaawHaLdJfnSy4iqPdUoA== Date: Sat, 15 Jan 2022 14:49:55 +0100 Message-Id: <20220115135011.5817-3-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/utils.scm (%syslog-line-hook, open-new-log-port, installer-log-port, %installer-log-line-hook, %display-line-hook, %default-installer-line-hooks, installer-log-line): Add new variables. --- gnu/installer/utils.scm | 45 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 9bd41e2ca0..b1b6f8b23f 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -37,7 +37,12 @@ (define-module (gnu installer utils) run-command syslog-port + %syslog-line-hook syslog + installer-log-port + %installer-log-line-hook + %default-installer-line-hooks + installer-log-line call-with-time let/time @@ -142,6 +147,9 @@ (define syslog-port (set! port (open-syslog-port))) (or port (%make-void-port "w"))))) +(define (%syslog-line-hook line) + (format (syslog-port) "installer[~d]: ~a~%" (getpid) line)) + (define-syntax syslog (lambda (s) "Like 'format', but write to syslog." @@ -152,6 +160,43 @@ (define-syntax syslog (syntax->datum #'fmt)))) #'(format (syslog-port) fmt (getpid) args ...)))))) +(define (open-new-log-port) + (define now (localtime (time-second (current-time)))) + (define filename + (format #f "/tmp/installer.~a.log" + (strftime "%F.%T" now))) + (open filename (logior O_RDWR + O_CREAT))) + +(define installer-log-port + (let ((port #f)) + (lambda () + "Return an input and output port to the installer log." + (unless port + (set! port (open-new-log-port))) + port))) + +(define (%installer-log-line-hook line) + (format (installer-log-port) "~a~%" line)) + +(define (%display-line-hook line) + (display line) + (newline)) + +(define %default-installer-line-hooks + (list %syslog-line-hook + %installer-log-line-hook)) + +(define-syntax installer-log-line + (lambda (s) + "Like 'format', but uses the default line hooks, and only formats one line." + (syntax-case s () + ((_ fmt args ...) + (string? (syntax->datum #'fmt)) + #'(let ((formatted (format #f fmt args ...))) + (for-each (lambda (f) (f formatted)) + %default-installer-line-hooks)))))) + ;;; ;;; Client protocol. From patchwork Sat Jan 15 13:49:56 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36374 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 71C4A27BBEA; Sat, 15 Jan 2022 13:52:55 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 84CDB27BBE9 for ; Sat, 15 Jan 2022 13:52:54 +0000 (GMT) Received: from localhost ([::1]:40714 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUD-0006wT-M5 for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:53 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37780) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0005EA-TK for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46622) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0004FE-Ik for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSS-0001r5-Hu for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 03/18] installer: Use new installer-log-line everywhere. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:04 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546417007 (code B ref 53063); Sat, 15 Jan 2022 13:51:04 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:41 +0000 Received: from localhost ([127.0.0.1]:39504 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS4-0001om-LM for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:41 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48412) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRq-0001mM-IO for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:30 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 89F80184F87; Sat, 15 Jan 2022 13:50:25 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254625; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=DvsXtT9nZND/ZuxrHrAgnSgScpF7mg0C4ZDziXZH+kU=; b=foXZgQD6HGWNhZnWRsRBQxVHZw/YeB2tNhnuGGwDVb3s2XGXP17HxIXzENJGzysu5CLtkJ 6Y51cRqtVLme2jCZQhALWJQcMx3IApFwVSoceN/TG3xvIgTArwFYX/qezjMm4+ppdlBoL5 cGfhtPGcAfXpUaMgZjRBnbNXsxXnR2QEtZLEMJP4SX0nnv0L/7SyWHS9LVCbEr81QufBTI poR9eolzVlNHehelqKdDYBsjQuslda0/KTlYBfaSwTl0cStWFrcyuYW7BKA/IhYcihBD7u uUxVGdR9w4f0loPSJw5t33SQRFBPTAFJ63yXwb77/SPIpVWFbBU/5yrOHFj7wQ== Date: Sat, 15 Jan 2022 14:49:56 +0100 Message-Id: <20220115135011.5817-4-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer.scm (installer-program) * gnu/installer/final.scm (install-locale) * gnu/installer/newt.scm (init) * gnu/installer/newt/final.scm (run-final-page) * gnu/installer/newt/page.scm (run-form-with-clients) * gnu/installer/newt/partition.scm (run-partitioning-page) * gnu/installer/parted.scm (eligible-devices, mkpart, luks-format-and-open, luks-close, mount-user-partitions, umount-user-partitions, free-parted): * gnu/installer/steps.scm (run-installer-steps): * gnu/installer/utils.scm (run-command, send-to-clients): Use it. --- gnu/installer.scm | 2 +- gnu/installer/final.scm | 6 ++-- gnu/installer/newt.scm | 2 +- gnu/installer/newt/final.scm | 4 +-- gnu/installer/newt/page.scm | 13 +++++---- gnu/installer/newt/partition.scm | 4 +-- gnu/installer/parted.scm | 50 ++++++++++++++++---------------- gnu/installer/steps.scm | 2 +- gnu/installer/utils.scm | 13 +++++---- 9 files changed, 49 insertions(+), 47 deletions(-) diff --git a/gnu/installer.scm b/gnu/installer.scm index 134fa2faaf..d0d012f04b 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -435,7 +435,7 @@ (define results #f))) (const #f) (lambda (key . args) - (syslog "crashing due to uncaught exception: ~s ~s~%" + (installer-log-line "crashing due to uncaught exception: ~s ~s" key args) (let ((error-file "/tmp/last-installer-error") (dump-archive "/tmp/dump.tgz")) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 276af908f7..fbfac1f692 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -125,15 +125,15 @@ (define (install-locale locale) (setlocale LC_ALL locale)))) (if supported? (begin - (syslog "install supported locale ~a~%." locale) + (installer-log-line "install supported locale ~a." locale) (setenv "LC_ALL" locale)) (begin ;; If the selected locale is not supported, install a default UTF-8 ;; locale. This is required to copy some files with UTF-8 ;; characters, in the nss-certs package notably. Set LANGUAGE ;; anyways, to have translated messages if possible. - (syslog "~a locale is not supported, installating en_US.utf8 \ -locale instead.~%" locale) + (installer-log-line "~a locale is not supported, installing \ +en_US.utf8 locale instead." locale) (setlocale LC_ALL "en_US.utf8") (setenv "LC_ALL" "en_US.utf8") (setenv "LANGUAGE" diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index d48e2c0129..61fb9cf2ca 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -48,7 +48,7 @@ (define (init) (newt-init) (clear-screen) (set-screen-size!) - (syslog "Display is ~ax~a.~%" (screen-columns) (screen-rows)) + (installer-log-line "Display is ~ax~a." (screen-columns) (screen-rows)) (push-help-line (format #f (G_ "Press for installation parameters.")))) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index 7f6dd9f075..efe422f4f4 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -109,7 +109,7 @@ (define* (run-install-shell locale (define (run-final-page result prev-steps) (define (wait-for-clients) (unless (null? (current-clients)) - (syslog "waiting with clients before starting final step~%") + (installer-log-line "waiting with clients before starting final step") (send-to-clients '(starting-final-step)) (match (select (current-clients) '() '()) (((port _ ...) _ _) @@ -119,7 +119,7 @@ (define (wait-for-clients) ;; things such as changing the swap partition label. (wait-for-clients) - (syslog "proceeding with final step~%") + (installer-log-line "proceeding with final step") (let* ((configuration (format-configuration prev-steps result)) (user-partitions (result-step result 'partition)) (locale (result-step result 'locale)) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 4209674c28..d9901c33a1 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -93,9 +93,9 @@ (define* (run-form-with-clients form exp) Like 'run-form', return two values: the exit reason, and an \"argument\"." (define* (discard-client! port #:optional errno) (if errno - (syslog "removing client ~d due to ~s~%" + (installer-log-line "removing client ~d due to ~s" (fileno port) (strerror errno)) - (syslog "removing client ~d due to EOF~%" + (installer-log-line "removing client ~d due to EOF" (fileno port))) ;; XXX: Watch out! There's no 'form-unwatch-fd' procedure in Newt so we @@ -124,7 +124,7 @@ (define title (send-to-clients exp) (let loop () - (syslog "running form ~s (~s) with ~d clients~%" + (installer-log-line "running form ~s (~s) with ~d clients" form title (length (current-clients))) ;; Call 'watch-clients!' within the loop because there might be new @@ -146,7 +146,7 @@ (define title (discard-client! port) (loop)) (obj - (syslog "form ~s (~s): client ~d replied ~s~%" + (installer-log-line "form ~s (~s): client ~d replied ~s" form title (fileno port) obj) (values 'exit-fd-ready obj)))) (lambda args @@ -156,8 +156,9 @@ (define title ;; Accept a new client and send it EXP. (match (accept port) ((client . _) - (syslog "accepting new client ~d while on form ~s~%" - (fileno client) form) + (installer-log-line + "accepting new client ~d while on form ~s" + (fileno client) form) (catch 'system-error (lambda () (write exp client) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index ccc7686906..6a3aa3daff 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -801,9 +801,9 @@ (define (run-page devices) ;; Make sure the disks are not in use before proceeding to formatting. (free-parted eligible-devices) (format-user-partitions user-partitions-with-pass) - (syslog "formatted ~a user partitions~%" + (installer-log-line "formatted ~a user partitions" (length user-partitions-with-pass)) - (syslog "user-partitions: ~a~%" user-partitions) + (installer-log-line "user-partitions: ~a" user-partitions) (destroy-form-and-pop form) user-partitions)) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 66e07574c9..ced7a757d7 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -371,7 +371,8 @@ (define (small-device? device) (let ((length (device-length device)) (sector-size (device-sector-size device))) (and (< (* length sector-size) %min-device-size) - (syslog "~a is not eligible because it is smaller than ~a.~%" + (installer-log-line "~a is not eligible because it is smaller than \ +~a." (device-path device) (unit-format-custom-byte device %min-device-size @@ -391,7 +392,8 @@ (define (installation-device? device) (string=? the-installer-root-partition-path (partition-get-path partition))) (disk-partitions disk))))) - (syslog "~a is not eligible because it is the installation device.~%" + (installer-log-line "~a is not eligible because it is the \ +installation device." (device-path device)))) (remove @@ -817,24 +819,22 @@ (define* (extend-ranges! start-range end-range (disk-add-partition disk partition no-constraint))) (partition-ok? (or partition-constraint-ok? partition-no-contraint-ok?))) - (syslog "Creating partition: -~/type: ~a -~/filesystem-type: ~a -~/start: ~a -~/end: ~a -~/start-range: [~a, ~a] -~/end-range: [~a, ~a] -~/constraint: ~a -~/no-constraint: ~a -" - partition-type - (filesystem-type-name filesystem-type) - start-sector* - end-sector - (geometry-start start-range) (geometry-end start-range) - (geometry-start end-range) (geometry-end end-range) - partition-constraint-ok? - partition-no-contraint-ok?) + (installer-log-line "Creating partition:") + (installer-log-line "~/type: ~a" partition-type) + (installer-log-line "~/filesystem-type: ~a" + (filesystem-type-name filesystem-type)) + (installer-log-line "~/start: ~a" start-sector*) + (installer-log-line "~/end: ~a" end-sector) + (installer-log-line "~/start-range: [~a, ~a]" + (geometry-start start-range) + (geometry-end start-range)) + (installer-log-line "~/end-range: [~a, ~a]" + (geometry-start end-range) + (geometry-end end-range)) + (installer-log-line "~/constraint: ~a" + partition-constraint-ok?) + (installer-log-line "~/no-constraint: ~a" + partition-no-contraint-ok?) ;; Set the partition name if supported. (when (and partition-ok? has-name? name) (partition-set-name partition name)) @@ -1188,7 +1188,7 @@ (define (luks-format-and-open user-partition) (call-with-luks-key-file password (lambda (key-file) - (syslog "formatting and opening LUKS entry ~s at ~s~%" + (installer-log-line "formatting and opening LUKS entry ~s at ~s" label file-name) (system* "cryptsetup" "-q" "luksFormat" file-name key-file) (system* "cryptsetup" "open" "--type" "luks" @@ -1197,7 +1197,7 @@ (define (luks-format-and-open user-partition) (define (luks-close user-partition) "Close the encrypted partition pointed by USER-PARTITION." (let ((label (user-partition-crypt-label user-partition))) - (syslog "closing LUKS entry ~s~%" label) + (installer-log-line "closing LUKS entry ~s" label) (system* "cryptsetup" "close" label))) (define (format-user-partitions user-partitions) @@ -1279,7 +1279,7 @@ (define (mount-user-partitions user-partitions) (file-name (user-partition-upper-file-name user-partition))) (mkdir-p target) - (syslog "mounting ~s on ~s~%" file-name target) + (installer-log-line "mounting ~s on ~s" file-name target) (mount file-name target mount-type))) sorted-partitions))) @@ -1295,7 +1295,7 @@ (define (umount-user-partitions user-partitions) (target (string-append (%installer-target-dir) mount-point))) - (syslog "unmounting ~s~%" target) + (installer-log-line "unmounting ~s" target) (umount target) (when crypt-label (luks-close user-partition)))) @@ -1486,6 +1486,6 @@ (define (free-parted devices) (error (format #f (G_ "Device ~a is still in use.") file-name)) - (syslog "Syncing ~a took ~a seconds.~%" + (installer-log-line "Syncing ~a took ~a seconds." file-name (time-second time))))) device-file-names))) diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index 55433cff31..d9b3d6d07e 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -185,7 +185,7 @@ (define* (run result #:key todo-steps done-steps) #:done-steps '()))))) ((installer-step-break? c) (reverse result))) - (syslog "running step '~a'~%" (installer-step-id step)) + (installer-log-line "running step '~a'" (installer-step-id step)) (let* ((id (installer-step-id step)) (compute (installer-step-compute step)) (res (compute result done-steps))) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index b1b6f8b23f..74046c9cab 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -100,13 +100,13 @@ (define (pause) (format (current-error-port) (G_ "Command failed with exit code ~a.~%") (invoke-error-exit-status c)) - (syslog "command ~s failed with exit code ~a" - command (invoke-error-exit-status c)) + (installer-log-line "command ~s failed with exit code ~a" + command (invoke-error-exit-status c)) (pause) #f)) - (syslog "running command ~s~%" command) + (installer-log-line "running command ~s" command) (apply invoke command) - (syslog "command ~s succeeded~%" command) + (installer-log-line "command ~s succeeded" command) (newline) (pause) #t)) @@ -259,8 +259,9 @@ (define remainder (let ((errno (system-error-errno args))) (if (memv errno (list EPIPE ECONNRESET ECONNABORTED)) (begin - (syslog "removing client ~s due to ~s while replying~%" - (fileno client) (strerror errno)) + (installer-log-line + "removing client ~s due to ~s while replying" + (fileno client) (strerror errno)) (false-if-exception (close-port client)) remainder) (cons client remainder)))))) From patchwork Sat Jan 15 13:49:57 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36367 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 714D627BBEA; Sat, 15 Jan 2022 13:51:59 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 4C1CC27BBE9 for ; Sat, 15 Jan 2022 13:51:59 +0000 (GMT) Received: from localhost ([::1]:38352 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jTK-0005Fh-C0 for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:51:58 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37744) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSR-0005DT-7L for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46618) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSQ-0004EW-Tr for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSQ-0001qb-T6 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 04/18] installer: Un-export syslog syntax. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51: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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546316903 (code B ref 53063); Sat, 15 Jan 2022 13:51:02 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:31 +0000 Received: from localhost ([127.0.0.1]:39476 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRu-0001n6-J7 for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:31 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48598) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRr-0001mP-K3 for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:29 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 6B7C9184F8C; Sat, 15 Jan 2022 13:50:26 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254626; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=1UGdk/Tsmn+K6CeX0ZenTHSoePhaEwpApfdz4xQckOQ=; b=b6O7RZocB9btV/Gt8EXKg5diw47sH8N1UT2j9j3o0tJ9jTQ53j1wvY5+UMBMOJDY57NBOA UWD6vwO1rM6RQF5BE1053VPVuwafhYx8BK+u/rvGWsbBmMGH0x7aopj7/EVARzjpbx1hIn QBjkJJ78swlJZ5T3WIRuz7vAZK4A+1PEjcpa8L56ogLiHz56cLh06VwZkagCCDpgDrWIYv 7a2Ri2IRVozB4WiHaEiRxNPHLnQvTSt76vPMz54y0Ht380QXVCyHsEWPIFZjPEJcOhFsGS pFdavUAHlUgcRhJojCF1A7w/n2mt9mm5I4so3knusEnV1/+vaWIiFNodfvuaig== Date: Sat, 15 Jan 2022 14:49:57 +0100 Message-Id: <20220115135011.5817-5-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/utils.scm (syslog): Remove export. --- gnu/installer/utils.scm | 1 - 1 file changed, 1 deletion(-) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 74046c9cab..1bff1e1229 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -38,7 +38,6 @@ (define-module (gnu installer utils) syslog-port %syslog-line-hook - syslog installer-log-port %installer-log-line-hook %default-installer-line-hooks From patchwork Sat Jan 15 13:49:58 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36371 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 EDE2D27BBEA; Sat, 15 Jan 2022 13:52:43 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 C2C6327BBE9 for ; Sat, 15 Jan 2022 13:52:43 +0000 (GMT) Received: from localhost ([::1]:39888 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jU2-0006NY-RY for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:42 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37764) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0005Ds-5J for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46619) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSR-0004Ek-Ag for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSR-0001qi-AU for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 05/18] installer: Keep PATH inside the install container. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:03 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546386954 (code B ref 53063); Sat, 15 Jan 2022 13:51:03 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:38 +0000 Received: from localhost ([127.0.0.1]:39492 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS2-0001o3-3N for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:38 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48758) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRs-0001ma-Qa for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:29 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 68A3F18506B; Sat, 15 Jan 2022 13:50:27 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254627; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=tOwdgrzuOYtn3xYvEURZFgaseGrFEkEaeRODXcanMsI=; b=Q5APLl2/x3t4kufa+FDJRhIsEJ+ZSRYezbWDNnz+y5gBeiIvtEsh9QUsBjfhlocewgzW7y e1kS/EY5Hdo0qcyh/HE3j8mPKvAdyyWrZocSJyImgCJntjtsoDwEKMr1UVl/Ce9LI0qycN YbHbHHLlHAuttQy6Cjo7yE5ODDE+FGk/hv4V0qjhogj8nDaHtvutKXfvbmNsdP9VX2Jy0S tCXBUFR8BlkEPIv8yqg0FLWygoj7poNYHR58q+djNolMlgp5veMiPZ/2IyeNtDZwthSVof x5r8nKB8ffjHKX6Pn0u39mGJorWX2KhuakWSve8UIyiUdFnoL1IEGlYr9swk9A== Date: Sat, 15 Jan 2022 14:49:58 +0100 Message-Id: <20220115135011.5817-6-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/final.scm (install-system): Set PATH inside the container. --- gnu/installer/final.scm | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index fbfac1f692..7d5eca4c7e 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -169,7 +169,8 @@ (define (assert-exit x) (database-dir "/var/guix/db") (database-file (string-append database-dir "/db.sqlite")) (saved-database (string-append database-dir "/db.save")) - (ret #f)) + (ret #f) + (path (getenv "PATH"))) (mkdir-p (%installer-target-dir)) ;; We want to initialize user passwords but we don't want to store them in @@ -208,6 +209,8 @@ (define (assert-exit x) (setvbuf (current-output-port) 'none) (setvbuf (current-error-port) 'none) + (setenv "PATH" path) + ;; If there are any connected clients, assume that we are running ;; installation tests. In that case, dump the standard and error ;; outputs to syslog. From patchwork Sat Jan 15 13:49:59 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36368 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 AE01B27BBEA; Sat, 15 Jan 2022 13:52:01 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 81AF627BBE9 for ; Sat, 15 Jan 2022 13:52:01 +0000 (GMT) Received: from localhost ([::1]:38424 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jTM-0005Jo-MP for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:00 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37772) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0005E9-FC for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46621) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0004F3-59 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSS-0001qx-4q for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 06/18] installer: Remove specific logging code. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:04 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546406998 (code B ref 53063); Sat, 15 Jan 2022 13:51:04 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:40 +0000 Received: from localhost ([127.0.0.1]:39502 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS3-0001oO-QC for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:40 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48812) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRt-0001md-6L for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:29 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 3C4EC184F8D; Sat, 15 Jan 2022 13:50:28 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254628; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=z2vI4D6Fy8gvcaN540bXzGA36skxT+wNDOijw0fnnQs=; b=Unb0wPE8d5s6KJZbMJtf7M33FlM+9Xn2SA+yfj1P7eeMRAXeFuesb2k9MzU6clHkK7xqD+ /v6e8GP4KE4B/5Q5ms4fSHmNsAcx+4aIje1BUXmPY+5RYujOWncTDeD+pNKRbH8l8HHAzf nSsjo4YRlJq3PSY5wCumEc1pN+xT0fMzBYZvlrrEDm+Vdpll6Vvg5h+ktdNNMfoyycd/T6 FMyaNWaONFsFjwnooaoSXqCWP6T4IXWfU/ueo9BKXCRJqBPYCyEL6kYNMpIOXlxuhNDRiP ZfxMYh/xsHdoGqgx4PqkME1VuIsWdQFMURuZ+5wOCk5ddg2y3PaFC7jk3aJLBw== Date: Sat, 15 Jan 2022 14:49:59 +0100 Message-Id: <20220115135011.5817-7-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/final.scm (install-system): Remove command logging to syslog, as this is taken care of by the new facilities. --- gnu/installer/final.scm | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 7d5eca4c7e..63e5073ff4 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -211,17 +211,7 @@ (define (assert-exit x) (setenv "PATH" path) - ;; If there are any connected clients, assume that we are running - ;; installation tests. In that case, dump the standard and error - ;; outputs to syslog. - (set! ret - (if (not (null? (current-clients))) - (with-output-to-file "/dev/console" - (lambda () - (with-error-to-file "/dev/console" - (lambda () - (run-command install-command))))) - (run-command install-command)))) + (set! ret (run-command install-command))) (lambda () ;; Restart guix-daemon so that it does no keep the MNT namespace ;; alive. From patchwork Sat Jan 15 13:50:00 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36381 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 1500027BBEA; Sat, 15 Jan 2022 13:54:12 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 7DD4527BBE9 for ; Sat, 15 Jan 2022 13:54:11 +0000 (GMT) Received: from localhost ([::1]:43854 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jVS-0000ei-NH for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:54:10 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37786) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jST-0005EC-98 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:05 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46623) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSS-0004FM-W5 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSS-0001rC-VO for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 07/18] installer: Capture external commands output. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:04 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546427015 (code B ref 53063); Sat, 15 Jan 2022 13:51:04 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:42 +0000 Received: from localhost ([127.0.0.1]:39506 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS5-0001oy-Mn for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:42 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48758) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRt-0001ma-Nn for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:30 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 178BD18506C; Sat, 15 Jan 2022 13:50:29 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254629; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=3eREbZa2+KugnerobItWN+D8awUsc0i5/edHw9BlSyo=; b=LUQsO1yV0w2lyzdYvg9/SjXTi0oO1dcph3QhWzrwpZUoul+D1zEIcEk+fb1sn2mreRl0ht 13GmtIv2IWiVjpJiTpTk8X+o48XHuSqdZ6anryIfFYDACyu7GXU4iugYBul379Q8/XnUp7 AqR16FoaPS3O3V4PvNcHuPFikgWRQTqDE/7vQK3HuwHDSJh9SHltasdOBaomErMTU4YbFj 41mURoZy+hPK318IjeL4kYRbfO+cHjnkc6GMyqLVepMDo5ifMVvO1VZonQFqJp45VJKCkT d8Mogl6k4RSo/jbI/H2iSBtATSrO7bMBoW4h/NE7DoVHP3f4I1kSgxufALisVQ== Date: Sat, 15 Jan 2022 14:50:00 +0100 Message-Id: <20220115135011.5817-8-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/utils.scm (run-external-command-with-handler, run-external-command-with-line-hooks): New variables. (run-command): Use run-external-command-with-line-hooks. --- gnu/installer/utils.scm | 97 ++++++++++++++++++++++++++++++++--------- 1 file changed, 77 insertions(+), 20 deletions(-) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 1bff1e1229..9cfff0054b 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -25,7 +25,9 @@ (define-module (gnu installer utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-34) + #:use-module (ice-9 control) #:use-module (ice-9 match) + #:use-module (ice-9 popen) #:use-module (ice-9 rdelim) #:use-module (ice-9 regex) #:use-module (ice-9 format) @@ -34,6 +36,8 @@ (define-module (gnu installer utils) read-all nearest-exact-integer read-percentage + run-external-command-with-handler + run-external-command-with-line-hooks run-command syslog-port @@ -78,37 +82,90 @@ (define (read-percentage percentage) (and result (string->number (match:substring result 1))))) +(define* (run-external-command-with-handler handler command) + "Run command specified by the list COMMAND in a child with output handler +HANDLER. HANDLER is a procedure taking an input port, to which the command +will write its standard output and error. Returns the integer status value of +the child process as returned by waitpid." + (match-let (((input . output) (pipe))) + ;; Hack to work around Guile bug 52835 + (define dup-output (duplicate-port output "w")) + ;; Void pipe, but holds the pid for close-pipe. + (define dummy-pipe + (with-input-from-file "/dev/null" + (lambda () + (with-output-to-port output + (lambda () + (with-error-to-port dup-output + (lambda () + (apply open-pipe* (cons "" command))))))))) + (close-port output) + (close-port dup-output) + (handler input) + (close-port input) + (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." + (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))) + (run-external-command-with-handler handler command)) + (define* (run-command command) "Run COMMAND, a list of strings. Return true if COMMAND exited successfully, #f otherwise." - (define env (environ)) - (define (pause) (format #t (G_ "Press Enter to continue.~%")) (send-to-clients '(pause)) - (environ env) ;restore environment variables (match (select (cons (current-input-port) (current-clients)) '() '()) (((port _ ...) _ _) (read-line port)))) - (setenv "PATH" "/run/current-system/profile/bin") - - (guard (c ((invoke-error? c) - (newline) - (format (current-error-port) - (G_ "Command failed with exit code ~a.~%") - (invoke-error-exit-status c)) - (installer-log-line "command ~s failed with exit code ~a" - command (invoke-error-exit-status c)) - (pause) - #f)) - (installer-log-line "running command ~s" command) - (apply invoke command) - (installer-log-line "command ~s succeeded" command) - (newline) - (pause) - #t)) + (installer-log-line "running command ~s" command) + (define result (run-external-command-with-line-hooks + (list %display-line-hook) + command)) + (define exit-val (status:exit-val result)) + (define term-sig (status:term-sig result)) + (define stop-sig (status:stop-sig result)) + (define succeeded? + (cond + ((and exit-val (not (zero? exit-val))) + (installer-log-line "command ~s exited with value ~a" + command exit-val) + (format #t (G_ "Command ~s exited with value ~a") + command exit-val) + #f) + (term-sig + (installer-log-line "command ~s killed by signal ~a" + command term-sig) + (format #t (G_ "Command ~s killed by signal ~a") + command term-sig) + #f) + (stop-sig + (installer-log-line "command ~s stopped by signal ~a" + command stop-sig) + (format #t (G_ "Command ~s stopped by signal ~a") + command stop-sig) + #f) + (else + (installer-log-line "command ~s succeeded" command) + (format #t (G_ "Command ~s succeeded") command) + #t))) + (newline) + (pause) + succeeded?) ;;; From patchwork Sat Jan 15 13:50:01 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36372 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 C886627BBE9; Sat, 15 Jan 2022 13:52:45 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 2A48627BBEA for ; Sat, 15 Jan 2022 13:52:45 +0000 (GMT) Received: from localhost ([::1]:40030 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jU4-0006T2-BS for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:44 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37792) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0005Eo-77 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46624) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jST-0004FU-Cv for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:05 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jST-0001rJ-Cn for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 08/18] installer: Add installer-specific run command process. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:05 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546437022 (code B ref 53063); Sat, 15 Jan 2022 13:51:05 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:43 +0000 Received: from localhost ([127.0.0.1]:39510 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS6-0001p6-9I for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:43 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48812) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRu-0001md-I5 for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:31 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id D4D72184F80; Sat, 15 Jan 2022 13:50:29 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254630; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=FsbknpGBFmZ5SSimoDNsxDI3hBbYL2EBu1X8xGCZ+TE=; b=bXVpnsByqH/CDl4J219ktRUmJUzvFlVY9r2IPM6vp04e7Uxbf1mlrQ7LUcMBajDEITakrU BVi8jPbPyPi5G4wgQCeSX06bXCF8bbaxZbcDxOqGxUqpFxQVPznHvFeJdo6HaHUzJgfVIW y1ndq2ZWrzsA33sQx/eXn/famQSts2JD2XDS5qUH6mMtmsOgVZ57K4InJ3d1zXj3qJ6K5O kxngeS0RXUpMkyIL0JLFBKPi4xUh73AMzHEccM71Ejj7/NTdvHRn+vWGBfusP+fhpiyaV3 D1pf8xa7RR6sIu5uOwtAoCZpwsHwybhLibFlEXw1T7tPxe1H4cljBuiC49BLtA== Date: Sat, 15 Jan 2022 14:50:01 +0100 Message-Id: <20220115135011.5817-9-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/record.scm (installer)[run-command]: Add field. * gnu/installer/utils.scm (run-command-in-installer): Add parameter. * gnu/installer.scm (installer-program): Parameterize run-command-in-installer with current installer's run-command. * gnu/installer/newt.scm (newt-run-command): New variable. (newt-installer): Use it. --- gnu/installer.scm | 79 +++++++++++++++++++++------------------- gnu/installer/newt.scm | 10 ++++- gnu/installer/record.scm | 7 +++- gnu/installer/utils.scm | 10 +++++ 4 files changed, 65 insertions(+), 41 deletions(-) diff --git a/gnu/installer.scm b/gnu/installer.scm index d0d012f04b..3cc5c79d4e 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -416,44 +416,47 @@ (define current-installer newt-installer) (define steps (#$steps current-installer)) ((installer-init current-installer)) - (catch #t - (lambda () - (define results - (run-installer-steps - #:rewind-strategy 'menu - #:menu-proc (installer-menu-page current-installer) - #:steps steps)) - - (match (result-step results 'final) - ('success - ;; We did it! Let's reboot! - (sync) - (stop-service 'root)) - (_ - ;; 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) - (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))) - (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))) + (parameterize + ((run-command-in-installer + (installer-run-command current-installer))) + (catch #t + (lambda () + (define results + (run-installer-steps + #:rewind-strategy 'menu + #:menu-proc (installer-menu-page current-installer) + #:steps steps)) + + (match (result-step results 'final) + ('success + ;; We did it! Let's reboot! + (sync) + (stop-service 'root)) + (_ + ;; 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) + (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))) + (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/newt.scm b/gnu/installer/newt.scm index 61fb9cf2ca..fc851339d1 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -79,6 +79,13 @@ (define (exit-error file report key args) (newt-finish) (clear-screen)) +(define (newt-run-command . args) + (newt-suspend) + (clear-screen) + (define result (run-command args)) + (newt-resume) + result) + (define (final-page result prev-steps) (run-final-page result prev-steps)) @@ -150,4 +157,5 @@ (define newt-installer (welcome-page welcome-page) (parameters-menu parameters-menu) (parameters-page parameters-page) - (dump-page dump-page))) + (dump-page dump-page) + (run-command newt-run-command))) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index e7cd45ee83..23db3edd70 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm @@ -42,7 +42,8 @@ (define-module (gnu installer record) installer-welcome-page installer-parameters-menu installer-parameters-page - installer-dump-page)) + installer-dump-page + installer-run-command)) ;;; @@ -94,4 +95,6 @@ (define-record-type* ;; procedure (keyboard-layout-selection) -> void (parameters-page installer-parameters-page) ;; procedure (dump) -> void - (dump-page installer-dump-page)) + (dump-page installer-dump-page) + ;; procedure command -> bool + (run-command installer-run-command)) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 9cfff0054b..4f7c691690 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -25,6 +25,7 @@ (define-module (gnu installer utils) #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (ice-9 control) #:use-module (ice-9 match) #:use-module (ice-9 popen) @@ -39,6 +40,7 @@ (define-module (gnu installer utils) run-external-command-with-handler run-external-command-with-line-hooks run-command + run-command-in-installer syslog-port %syslog-line-hook @@ -167,6 +169,14 @@ (define succeeded? (pause) succeeded?) +(define run-command-in-installer + (make-parameter + (lambda (. args) + (raise + (condition + (&serious) + (&message (message "run-command-in-installer not set"))))))) + ;;; ;;; Logging. From patchwork Sat Jan 15 13:50:02 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36373 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 13B5B27BBEA; Sat, 15 Jan 2022 13:52:48 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 8BC1C27BBE9 for ; Sat, 15 Jan 2022 13:52:47 +0000 (GMT) Received: from localhost ([::1]:40152 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jU6-0006Y0-Nd for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:46 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37800) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0005FZ-Lc for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46625) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jST-0004Fd-QO for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jST-0001rR-Pl for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:05 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 09/18] installer: Use run-command-in-installer in (gnu installer parted). Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:05 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546447037 (code B ref 53063); Sat, 15 Jan 2022 13:51:05 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:44 +0000 Received: from localhost ([127.0.0.1]:39512 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS7-0001pD-2W for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:43 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48758) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRv-0001ma-Cn for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:31 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id B3969184F87; Sat, 15 Jan 2022 13:50:30 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254631; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=PSREt5ETZiXWQ8qm7QSd/ScalJZ07QaEydkk3Jt/kyE=; b=tor7QKiNxypHp2EiAPWrh7b9ikt6nrGFa/sjuV9wgkbWtoKyV+p6TeaQz69LlAOsuYJyVj VdlhWAfV8Y4ll2HMKGiXG8s2riwGLz4f70t0MZXAdq4852zU21v5UZGoyZCyRYb5jDb4rF jykQUzRRerjejtF9GshANFUgCyP8DEOqB8CxH96jAVCbdIbApLegm9IFcnyt9R2fB5o3Rr /wOiy5y4GDUP6L1+DGpUUALlGEWb5AOdztVIJe3ddr10FnAXq8eIAfBBpFHU//d7Ur9tjH xN47knNlQZOkrphOD/10s6t5v6GXGbT0ZYIDL/yiZIOF4aEaMddEBXk+pIE2LA== Date: Sat, 15 Jan 2022 14:50:02 +0100 Message-Id: <20220115135011.5817-10-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/parted.scm (remove-logical-devices, create-btrfs-file-system, create-ext4-file-system, create-fat16-file-system, create-fat32-file-system, create-jfs-file-system, create-ntfs-file-system, create-xfs-file-system, create-swap-partition, luks-format-and-open, luks-close): Use run-command-in-installer. (with-null-output-ports): Remove. --- gnu/installer/parted.scm | 44 +++++++++++++--------------------------- 1 file changed, 14 insertions(+), 30 deletions(-) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index ced7a757d7..c8bb73ee64 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -343,8 +343,7 @@ (define* (force-device-sync device) (define (remove-logical-devices) "Remove all active logical devices." - (with-null-output-ports - (invoke "dmsetup" "remove_all"))) + ((run-command-in-installer) "dmsetup" "remove_all")) (define (installer-root-partition-path) "Return the root partition path, or #f if it could not be detected." @@ -1115,53 +1114,37 @@ (define (set-user-partitions-file-name user-partitions) (file-name file-name)))) user-partitions)) -(define-syntax-rule (with-null-output-ports exp ...) - "Evaluate EXP with both the output port and the error port pointing to the -bit bucket." - (with-output-to-port (%make-void-port "w") - (lambda () - (with-error-to-port (%make-void-port "w") - (lambda () exp ...))))) - (define (create-btrfs-file-system partition) "Create a btrfs file-system for PARTITION file-name." - (with-null-output-ports - (invoke "mkfs.btrfs" "-f" partition))) + ((run-command-in-installer) "mkfs.btrfs" "-f" partition)) (define (create-ext4-file-system partition) "Create an ext4 file-system for PARTITION file-name." - (with-null-output-ports - (invoke "mkfs.ext4" "-F" partition))) + ((run-command-in-installer) "mkfs.ext4" "-F" partition)) (define (create-fat16-file-system partition) "Create a fat16 file-system for PARTITION file-name." - (with-null-output-ports - (invoke "mkfs.fat" "-F16" partition))) + ((run-command-in-installer) "mkfs.fat" "-F16" partition)) (define (create-fat32-file-system partition) "Create a fat32 file-system for PARTITION file-name." - (with-null-output-ports - (invoke "mkfs.fat" "-F32" partition))) + ((run-command-in-installer) "mkfs.fat" "-F32" partition)) (define (create-jfs-file-system partition) "Create a JFS file-system for PARTITION file-name." - (with-null-output-ports - (invoke "jfs_mkfs" "-f" partition))) + ((run-command-in-installer) "jfs_mkfs" "-f" partition)) (define (create-ntfs-file-system partition) "Create a JFS file-system for PARTITION file-name." - (with-null-output-ports - (invoke "mkfs.ntfs" "-F" "-f" partition))) + ((run-command-in-installer) "mkfs.ntfs" "-F" "-f" partition)) (define (create-xfs-file-system partition) "Create an XFS file-system for PARTITION file-name." - (with-null-output-ports - (invoke "mkfs.xfs" "-f" partition))) + ((run-command-in-installer) "mkfs.xfs" "-f" partition)) (define (create-swap-partition partition) "Set up swap area on PARTITION file-name." - (with-null-output-ports - (invoke "mkswap" "-f" partition))) + ((run-command-in-installer) "mkswap" "-f" partition)) (define (call-with-luks-key-file password proc) "Write PASSWORD in a temporary file and pass it to PROC as argument." @@ -1190,15 +1173,16 @@ (define (luks-format-and-open user-partition) (lambda (key-file) (installer-log-line "formatting and opening LUKS entry ~s at ~s" label file-name) - (system* "cryptsetup" "-q" "luksFormat" file-name key-file) - (system* "cryptsetup" "open" "--type" "luks" - "--key-file" key-file file-name label))))) + ((run-command-in-installer) "cryptsetup" "-q" "luksFormat" + file-name key-file) + ((run-command-in-installer) "cryptsetup" "open" "--type" "luks" + "--key-file" key-file file-name label))))) (define (luks-close user-partition) "Close the encrypted partition pointed by USER-PARTITION." (let ((label (user-partition-crypt-label user-partition))) (installer-log-line "closing LUKS entry ~s" label) - (system* "cryptsetup" "close" label))) + ((run-command-in-installer) "cryptsetup" "close" label))) (define (format-user-partitions user-partitions) "Format the records in USER-PARTITIONS list with From patchwork Sat Jan 15 13:50:03 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36382 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 2AB2927BBEA; Sat, 15 Jan 2022 13:54:22 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 00CC727BBE9 for ; Sat, 15 Jan 2022 13:54:22 +0000 (GMT) Received: from localhost ([::1]:44060 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jVd-0000nh-6v for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:54:21 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37794) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0005Ev-Er for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46626) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSU-0004Fe-6S for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSU-0001rY-5b for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:06 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 10/18] installer: Raise condition when mklabel fails. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:06 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546447044 (code B ref 53063); Sat, 15 Jan 2022 13:51:06 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:44 +0000 Received: from localhost ([127.0.0.1]:39514 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS7-0001pS-Ov for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:44 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48812) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRw-0001md-5y for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:32 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 86F0F184F8C; Sat, 15 Jan 2022 13:50:31 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254631; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=j1+E8H+8d39neV6FFL1ihLD+RKMyC2d6miPvlu5wODs=; b=NUZhwSFoLRaoxWDJ3nrzztwsI8X9KVDgSjzGg4OS9Hx3ZYrC7QEPZS/rj8YX8mHip8eshm y2OodG4RrKHnIhjngN3jq0w1wlTnpHJrNPrTTLYTkkoNJHcUE8MHuVzJScecMXwaqGaa1s QtMYo2a7uy1FUoFsD8JbeAG9JHu77Uue2r/XxwthxowF4JCK72GfXXtoLatgHdXxyY1WZc vF2propvGSKhw1uh/eWcnTHfOXKca6Y3XO/Iu2vJWUE4z0iv37orsNO50243u6eDkN572Q zNBeVNv6aT93kLWpcf/rSV6J1i/fQ2NyqKeY7ibTAHPnj0qNMmBocPmiPCXS+A== Date: Sat, 15 Jan 2022 14:50:03 +0100 Message-Id: <20220115135011.5817-11-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/parted.scm (mklabel): Do it. --- gnu/installer/parted.scm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index c8bb73ee64..e33ef5f8fd 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -635,8 +635,14 @@ (define (user-partition-description user-partition) (define (mklabel device type-name) "Create a partition table on DEVICE. TYPE-NAME is the type of the partition table, \"msdos\" or \"gpt\"." - (let ((type (disk-type-get type-name))) - (disk-new-fresh device type))) + (let* ((type (disk-type-get type-name)) + (disk (disk-new-fresh device type))) + (or disk + (raise + (condition + (&error) + (&message (message (format #f "Cannot create partition table of type +~a on device ~a." type-name (device-path device))))))))) ;; From patchwork Sat Jan 15 13:50:04 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36376 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 6EFEB27BBEA; Sat, 15 Jan 2022 13:52:58 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 4AAC527BBE9 for ; Sat, 15 Jan 2022 13:52:58 +0000 (GMT) Received: from localhost ([::1]:41002 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUH-00078l-F8 for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:57 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37798) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0005FY-LU for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46627) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSU-0004Fh-Kb for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSU-0001rf-JW for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:06 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 11/18] installer: Fix run-file-textbox-page when edit-button is #f. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:06 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546447052 (code B ref 53063); Sat, 15 Jan 2022 13:51:06 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:44 +0000 Received: from localhost ([127.0.0.1]:39516 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS8-0001pZ-5I for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:44 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48758) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRx-0001ma-1O for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:33 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 4D1D5184F8D; Sat, 15 Jan 2022 13:50:32 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254632; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=jDNKfmntwHNwNyVkhNYLIggPOpaPQoGu7quYHQ4iJKI=; b=Gp7IO+xM2QdEWB3BXKCULv+zg4WImTBhYmwAaz3g82A9x9FSPtFRnZ3njo50IZ/Gqw3MYw n8pPCcIIFEKs5w+LubZpnm/OyOhpB9qcNpkCJy5X83NgKxM6U+fOxUqpkL9Jw3dx4emhr1 6cXjMMH1ylPEPOQY+Ql65amH4iPvWVfwCyRB+An4J4b11CUmXBHQ9NZ6hzK0Dveaaf6tM1 OIsMh/YMsi60N/E9ZLlynbiEYepATDcDwfft3ijMr+f8cFYNhwpj+DngYOgcFqPdfteDWu nz0o0/EyrgYPJ9EsEe0hSYDetVFJjCYqUwb5kzLLT1NVQAkZF0yyavuLluEOKw== Date: Sat, 15 Jan 2022 14:50:04 +0100 Message-Id: <20220115135011.5817-12-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/newt/page.scm (run-file-textbox-page): Check if edit-button is #f. --- gnu/installer/newt/page.scm | 1 + 1 file changed, 1 insertion(+) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index d9901c33a1..9c684a3899 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -812,6 +812,7 @@ (define result (destroy-form-and-pop form)))) (if (and (eq? exit-reason 'exit-component) + edit-button (components=? argument edit-button)) (loop) ;recurse in tail position result))))) From patchwork Sat Jan 15 13:50:05 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36375 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 80C1F27BBEA; Sat, 15 Jan 2022 13:52:57 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 5703227BBE9 for ; Sat, 15 Jan 2022 13:52:57 +0000 (GMT) Received: from localhost ([::1]:40866 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUG-00072m-E2 for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:56 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37796) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0005FR-Kt for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46628) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0004Fo-0n for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSV-0001rn-0A for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 12/18] installer: Replace run-command by invoke in newt/page.scm. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:06 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546447059 (code B ref 53063); Sat, 15 Jan 2022 13:51:06 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:44 +0000 Received: from localhost ([127.0.0.1]:39518 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS8-0001pj-Eq for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:44 -0500 Received: from jpoiret.xyz ([206.189.101.64]:48812) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jRy-0001md-3g for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:34 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 2B63318506B; Sat, 15 Jan 2022 13:50:33 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254633; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=INDOUGYDKcNnnbQK3QgwDm1WQsdfX4OfOc7hc2OziM0=; b=ElZ7oRedx0xH3cgoi68/7C11mO/kEblL76SW7wh+f/2rneQN3ZiFOk8qOep/o+hi5lxfWb J3hcQVgxwAREjQWgFewufyTVrHOOjP84EVe9m/N+4hYKZU12PLYaZ/DAHISvR1hluXp7JU nX9R1IJ9F/+pjHkU2gBg76K89J3MDjEkJm0KvxHH8vQaK8WjYqbWTTnR4L3ZgW1SdwcSBL KhLDHJtZk5maSvX9qM/NYkx87LQomweh6BsZ6lf9AGuw9/6vebSIaxseyrLMP35e0keE0F x9kSHzmq+RLfljmdKjfe7KhSxzU674gFmMH0NaRoFF2eobATvSxrrucs5gPf4Q== Date: Sat, 15 Jan 2022 14:50:05 +0100 Message-Id: <20220115135011.5817-13-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/newt/page.scm (edit-file): Replace it. --- gnu/installer/newt/page.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 9c684a3899..695c7d875f 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -22,6 +22,7 @@ (define-module (gnu installer newt page) #:use-module (gnu installer steps) #:use-module (gnu installer utils) #:use-module (gnu installer newt utils) + #:use-module (guix build utils) #:use-module (guix i18n) #:use-module (ice-9 i18n) #:use-module (ice-9 match) @@ -727,8 +728,7 @@ (define* (edit-file file #:key locale) (newt-suspend) ;; Use Nano because it syntax-highlights Scheme by default. ;; TODO: Add a menu to choose an editor? - (run-command (list "/run/current-system/profile/bin/nano" file) - #:locale locale) + (invoke "nano" file) (newt-resume)) (define* (run-file-textbox-page #:key From patchwork Sat Jan 15 13:50:06 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36370 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 8188D27BBEA; Sat, 15 Jan 2022 13:52:37 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 5B2D927BBE9 for ; Sat, 15 Jan 2022 13:52:37 +0000 (GMT) Received: from localhost ([::1]:39276 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jTw-0005wj-HP for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:52:36 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37802) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0005Fo-Oz for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:08 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46629) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jSV-0004G4-Eu for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jSV-0001ru-Ck for guix-patches@gnu.org; Sat, 15 Jan 2022 08:51:07 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 13/18] installer: Add nano to PATH. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:51:07 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546457065 (code B ref 53063); Sat, 15 Jan 2022 13:51:07 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:50:45 +0000 Received: from localhost ([127.0.0.1]:39520 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS8-0001po-N5 for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:44 -0500 Received: from jpoiret.xyz ([206.189.101.64]:49552) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS0-0001nt-Gr for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:37 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id E9DCE184F80; Sat, 15 Jan 2022 13:50:34 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254635; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=a5NavNMXyWd/T4GDB8ZFJNCUCvbrmMe+sBXKR6uBBKo=; b=Iv1f7RZ+GSmJhW0p5zaDwILNgDtciJ9B41gFDPqTMbBQT7bAS6e/GAdTKsXcXXKbV7zagI VIKOdadyP4haK2hocEe0ZuXqZY0wZWdFnI0C30qny0KAkijQykOVD+/As6icPFpbdARd11 gNuySGfNvNflNyDgW3OrxbLAlA029+vWDqAQPO9Ps/u8/9poxLoMOpFvEkq0V6jYD2jafJ 5mr+h7LBJcuR3BOX6GYqevhq3/CyE42z4f9f6hRgU5njpoJ2s4TTy9K5Te6eqbnAWGZB3e RYizqjCSDIeX4feQV+lYYzybPwKvYU2ZlU8iFoCZQmBl4hCdqdeGyAg98mAb8g== Date: Sat, 15 Jan 2022 14:50:06 +0100 Message-Id: <20220115135011.5817-14-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer.scm (installer-program): Add nano to the installer PATH. --- gnu/installer.scm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/gnu/installer.scm b/gnu/installer.scm index 3cc5c79d4e..c7e0921a19 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -43,6 +43,7 @@ (define-module (gnu installer) #:autoload (gnu packages gnupg) (guile-gcrypt) #:use-module (gnu packages iso-codes) #:use-module (gnu packages linux) + #:use-module (gnu packages nano) #:use-module (gnu packages ncurses) #:use-module (gnu packages package-management) #:use-module (gnu packages tls) @@ -336,6 +337,7 @@ (define set-installer-path kbd ;chvt guix ;guix system init call util-linux ;mkwap + nano shadow tar ;dump gzip ;dump From patchwork Sat Jan 15 13:50:07 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36378 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 67FF727BBEA; Sat, 15 Jan 2022 13:53:08 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 B00BD27BBE9 for ; Sat, 15 Jan 2022 13:53:06 +0000 (GMT) Received: from localhost ([::1]:41768 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUP-0007eV-Qr for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:53:05 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37972) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jTO-0005s6-OS for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46642) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jTN-0004R1-OD for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jTN-0001u9-OJ for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 14/18] installer: Use named prompt to abort or break installer steps. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:52:01 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546747215 (code B ref 53063); Sat, 15 Jan 2022 13:52:01 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:51:14 +0000 Received: from localhost ([127.0.0.1]:39535 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jSb-0001sG-3Y for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:51:14 -0500 Received: from jpoiret.xyz ([206.189.101.64]:49658) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS1-0001nw-Ee for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:39 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 759A1184F87; Sat, 15 Jan 2022 13:50:36 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254636; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=HlpGIb6/U4Ia1UlHFajSKDHbG9qE4Jq+hwlSuzKLxEI=; b=Rl0604L7LhJecd3Fp3r+3M0Rj8zXzVOWSUXKc0XQoCKaqejETOb/sOinQGkGd1UkvtHm0q TZJu5GicxBr6l0fZtWwbeIyRRXJxWrEEcKsY1Y7EL/mPM4UPp69X78Ojg8gyUOg51yaFrE GzjaJnHOv1BxEZpahMs3GoBB0K5rtp+qrtfqHRAHbLNm2g6sKSP3dKfvpR6iYb1UdOPS+g Y1WyeyuSHGOwvPCoeufYmJtSSRbp4XtXqbfirGr+nTP+5irUcF7RsqIr0lqw2dlVhQThPa ajCnYkYZ/ceVfmAyncIUBAoCISKjiFfoinM/ulJ7MkiqcsAoFab9Tb3E0O+NvA== Date: Sat, 15 Jan 2022 14:50:07 +0100 Message-Id: <20220115135011.5817-15-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/steps.scm (run-installer-steps): Set up 'installer-step prompt. * gnu/installer/newt/ethernet.scm (run-ethernet-page) * gnu/installer/newt/final.scm (run-config-display-page, run-install-failed-page) * gnu/installer/newt/keymap.scm (run-layout-page, run-variant-page) * gnu/installer/newt/locale.scm (run-language-page, run-territory-page, run-codeset-page, run-modifier-page, run-locale-page) * gnu/installer/newt/network.scm (run-technology-page, wait-service-online) * gnu/installer/newt/page.scm (run-listbox-selection-page, run-checkbox-tree-page) * gnu/installer/newt/partition.scm (button-exit-action) * gnu/installer/newt/services.scm (run-desktop-environments-cbt-page, run-networking-cbt-page, run-other-services-cbt-page, run-network-management-page) * gnu/installer/newt/timezone.scm (run-timezone-page) * gnu/installer/newt/user.scm (run-user-page) * gnu/installer/newt/welcome.scm (run-menu-page) * gnu/installer/newt/wifi.scm (run-wifi-page): Use the 'installer-step prompt to abort. --- gnu/installer/newt/ethernet.scm | 8 +- gnu/installer/newt/final.scm | 8 +- gnu/installer/newt/keymap.scm | 8 +- gnu/installer/newt/locale.scm | 25 ++---- gnu/installer/newt/network.scm | 16 +--- gnu/installer/newt/page.scm | 4 +- gnu/installer/newt/partition.scm | 6 +- gnu/installer/newt/services.scm | 16 +--- gnu/installer/newt/timezone.scm | 4 +- gnu/installer/newt/user.scm | 5 +- gnu/installer/newt/welcome.scm | 2 +- gnu/installer/newt/wifi.scm | 4 +- gnu/installer/steps.scm | 127 +++++++++++++------------------ 13 files changed, 85 insertions(+), 148 deletions(-) diff --git a/gnu/installer/newt/ethernet.scm b/gnu/installer/newt/ethernet.scm index ecd22efbb2..d75a640519 100644 --- a/gnu/installer/newt/ethernet.scm +++ b/gnu/installer/newt/ethernet.scm @@ -65,9 +65,7 @@ (define (run-ethernet-page) (run-error-page (G_ "No ethernet service available, please try again.") (G_ "No service")) - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) ((service) ;; Only one service is available so return it directly. service) @@ -81,7 +79,5 @@ (define (run-ethernet-page) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) #:listbox-callback-procedure connect-ethernet-service)))) diff --git a/gnu/installer/newt/final.scm b/gnu/installer/newt/final.scm index efe422f4f4..7c3f73ee82 100644 --- a/gnu/installer/newt/final.scm +++ b/gnu/installer/newt/final.scm @@ -59,9 +59,7 @@ (define* (run-config-display-page #:key locale) #:file-textbox-height height #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-install-success-page) (match (current-clients) @@ -88,9 +86,7 @@ (define (run-install-failed-page) (G_ "Restart the installer") (G_ "The final system installation step failed. You can resume from \ a specific step, or restart the installer.")) - (1 (raise - (condition - (&installer-step-abort)))) + (1 (abort-to-prompt 'installer-step 'abort)) (2 ;; Keep going, the installer will be restarted later on. #t))) diff --git a/gnu/installer/newt/keymap.scm b/gnu/installer/newt/keymap.scm index 92f7f46f34..c5d4be6792 100644 --- a/gnu/installer/newt/keymap.scm +++ b/gnu/installer/newt/keymap.scm @@ -59,9 +59,7 @@ (define (run-layout-page layouts layout->text context) ((param) (const #f)) (else (lambda _ - (raise - (condition - (&installer-step-abort))))))))) + (abort-to-prompt 'installer-step 'abort))))))) (define (run-variant-page variants variant->text) (let ((title (G_ "Variant"))) @@ -74,9 +72,7 @@ (define (run-variant-page variants variant->text) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (sort-layouts layouts) "Sort LAYOUTS list by putting the US layout ahead and return it." diff --git a/gnu/installer/newt/locale.scm b/gnu/installer/newt/locale.scm index bfd89aca2c..01171e253f 100644 --- a/gnu/installer/newt/locale.scm +++ b/gnu/installer/newt/locale.scm @@ -43,9 +43,7 @@ (define result #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort)))))) + (abort-to-prompt 'installer-step 'abort)))) ;; Immediately install the chosen language so that the territory page that ;; comes after (optionally) is displayed in the chosen language. @@ -63,9 +61,7 @@ (define (run-territory-page territories territory->text) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-codeset-page codesets) (let ((title (G_ "Locale codeset"))) @@ -78,9 +74,7 @@ (define (run-codeset-page codesets) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-modifier-page modifiers modifier->text) (let ((title (G_ "Locale modifier"))) @@ -94,9 +88,7 @@ (define (run-modifier-page modifiers modifier->text) #:button-text (G_ "Back") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define* (run-locale-page #:key supported-locales @@ -110,11 +102,10 @@ (define* (run-locale-page #:key glibc format is returned." (define (break-on-locale-found locales) - "Raise the &installer-step-break condition if LOCALES contains exactly one + "Break to the installer step if LOCALES contains exactly one element." (and (= (length locales) 1) - (raise - (condition (&installer-step-break))))) + (abort-to-prompt 'installer-step 'break))) (define (filter-locales locales result) "Filter the list of locale records LOCALES using the RESULT returned by @@ -218,8 +209,8 @@ (define locale-steps ;; If run-installer-steps returns locally, it means that the user had to go ;; through all steps (language, territory, codeset and modifier) to select a - ;; locale. In that case, like if we exited by raising &installer-step-break - ;; condition, turn the result into a glibc locale string and return it. + ;; locale. In that case, like if we exited by breaking to the installer + ;; step, turn the result into a glibc locale string and return it. (result->locale-string supported-locales (run-installer-steps #:steps locale-steps))) diff --git a/gnu/installer/newt/network.scm b/gnu/installer/newt/network.scm index fb221483c3..0477a489be 100644 --- a/gnu/installer/newt/network.scm +++ b/gnu/installer/newt/network.scm @@ -65,12 +65,8 @@ (define (technology-items) (G_ "Exit") (G_ "The install process requires Internet access but no \ network devices were found. Do you want to continue anyway?")) - ((1) (raise - (condition - (&installer-step-break)))) - ((2) (raise - (condition - (&installer-step-abort)))))) + ((1) (abort-to-prompt 'installer-step 'break)) + ((2) (abort-to-prompt 'installer-step 'abort)))) ((technology) ;; Since there's only one technology available, skip the selection ;; screen. @@ -86,9 +82,7 @@ (define (technology-items) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort)))))))) + (abort-to-prompt 'installer-step 'abort)))))) (define (find-technology-by-type technologies type) "Find and return a technology with the given TYPE in TECHNOLOGIES list." @@ -156,9 +150,7 @@ (define (online?) (G_ "The selected network does not provide access to the \ Internet and the Guix substitute server, please try again.") (G_ "Connection error")) - (raise - (condition - (&installer-step-abort)))))) + (abort-to-prompt 'installer-step 'abort)))) (define (run-network-page) "Run a page to allow the user to configure connman so that it can access the diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 695c7d875f..8c675fa837 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -488,7 +488,7 @@ (define (choice->item str) (string=? str (listbox-item->text item)))) keys) ((key . item) item) - (#f (raise (condition (&installer-step-abort)))))) + (#f (abort-to-prompt 'installer-step 'abort)))) ;; On every listbox element change, check if we need to skip it. If yes, ;; depending on the 'last-listbox-key', jump forward or backward. If no, @@ -690,7 +690,7 @@ (define (choice->item str) (string=? str (item->text item)))) keys) ((key . item) item) - (#f (raise (condition (&installer-step-abort)))))) + (#f (abort-to-prompt 'installer-step 'abort)))) (add-form-to-grid grid form #t) (make-wrapped-grid-window grid title) diff --git a/gnu/installer/newt/partition.scm b/gnu/installer/newt/partition.scm index 6a3aa3daff..e7a97810ac 100644 --- a/gnu/installer/newt/partition.scm +++ b/gnu/installer/newt/partition.scm @@ -36,10 +36,8 @@ (define-module (gnu installer newt partition) #:export (run-partitioning-page)) (define (button-exit-action) - "Raise the &installer-step-abort condition." - (raise - (condition - (&installer-step-abort)))) + "Abort the installer step." + (abort-to-prompt 'installer-step 'abort)) (define (run-scheme-page) "Run a page asking the user for a partitioning scheme." diff --git a/gnu/installer/newt/services.scm b/gnu/installer/newt/services.scm index c218825813..9951ad2212 100644 --- a/gnu/installer/newt/services.scm +++ b/gnu/installer/newt/services.scm @@ -46,9 +46,7 @@ (define (run-desktop-environments-cbt-page) #:checkbox-tree-height 9 #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-networking-cbt-page) "Run a page allowing the user to select networking services." @@ -65,9 +63,7 @@ (define (run-networking-cbt-page) #:checkbox-tree-height 5 #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-printing-services-cbt-page) "Run a page allowing the user to select document services such as CUPS." @@ -85,9 +81,7 @@ (define (run-printing-services-cbt-page) #:checkbox-tree-height 9 #:exit-button-callback-procedure (lambda () - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-console-services-cbt-page) "Run a page to select various system adminstration services for non-graphical @@ -130,9 +124,7 @@ (define (run-network-management-page) #:button-text (G_ "Exit") #:button-callback-procedure (lambda _ - (raise - (condition - (&installer-step-abort))))))) + (abort-to-prompt 'installer-step 'abort))))) (define (run-services-page) (let ((desktop (run-desktop-environments-cbt-page))) diff --git a/gnu/installer/newt/timezone.scm b/gnu/installer/newt/timezone.scm index 67bf41ff84..bed9f9d5cb 100644 --- a/gnu/installer/newt/timezone.scm +++ b/gnu/installer/newt/timezone.scm @@ -65,9 +65,7 @@ (define (loop path) #:button-callback-procedure (if (null? path) (lambda _ - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) (lambda _ (loop (all-but-last path)))) #:listbox-callback-procedure diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm index 58bb86bf96..97141cfe64 100644 --- a/gnu/installer/newt/user.scm +++ b/gnu/installer/newt/user.scm @@ -20,7 +20,6 @@ (define-module (gnu installer newt user) #:use-module (gnu installer user) - #:use-module ((gnu installer steps) #:select (&installer-step-abort)) #:use-module (gnu installer newt page) #:use-module (gnu installer newt utils) #:use-module (gnu installer utils) @@ -257,9 +256,7 @@ (define (run users) (run users)) (reverse users)) ((components=? argument exit-button) - (raise - (condition - (&installer-step-abort)))))) + (abort-to-prompt 'installer-step 'abort)))) ('exit-fd-ready ;; Read the complete user list at once. (match argument diff --git a/gnu/installer/newt/welcome.scm b/gnu/installer/newt/welcome.scm index 5f461279e2..7a7ddfb7bd 100644 --- a/gnu/installer/newt/welcome.scm +++ b/gnu/installer/newt/welcome.scm @@ -84,7 +84,7 @@ (define (choice->item str) (string=? str (listbox-item->text item)))) keys) ((key . item) item) - (#f (raise (condition (&installer-step-abort)))))) + (#f (abort-to-prompt 'installer-step 'abort)))) (set-textbox-text logo-textbox (read-all logo)) diff --git a/gnu/installer/newt/wifi.scm b/gnu/installer/newt/wifi.scm index f5d8f1fdbf..8a87cbdf4b 100644 --- a/gnu/installer/newt/wifi.scm +++ b/gnu/installer/newt/wifi.scm @@ -237,9 +237,7 @@ (define (run-wifi-page) (run-wifi-scan-page) (run-wifi-page)) ((components=? argument exit-button) - (raise - (condition - (&installer-step-abort)))) + (abort-to-prompt 'installer-step 'abort)) ((components=? argument listbox) (let ((result (connect-wifi-service listbox service-items))) (unless result diff --git a/gnu/installer/steps.scm b/gnu/installer/steps.scm index d9b3d6d07e..8bc38181a7 100644 --- a/gnu/installer/steps.scm +++ b/gnu/installer/steps.scm @@ -28,13 +28,7 @@ (define-module (gnu installer steps) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (rnrs io ports) - #:export (&installer-step-abort - installer-step-abort? - - &installer-step-break - installer-step-break? - - + #:export ( installer-step make-installer-step installer-step? @@ -60,14 +54,6 @@ (define-module (gnu installer steps) ;; purposes. (define %current-result (make-hash-table)) -;; This condition may be raised to abort the current step. -(define-condition-type &installer-step-abort &condition - installer-step-abort?) - -;; This condition may be raised to break out from the steps execution. -(define-condition-type &installer-step-break &condition - installer-step-break?) - ;; An installer-step record is basically an id associated to a compute ;; procedure. The COMPUTE procedure takes exactly one argument, an association ;; list containing the results of previously executed installer-steps (see @@ -94,8 +80,10 @@ (define* (run-installer-steps #:key (rewind-strategy 'previous) (menu-proc (const #f))) "Run the COMPUTE procedure of all records in STEPS -sequentially. If the &installer-step-abort condition is raised, fallback to a -previous install-step, accordingly to the specified REWIND-STRATEGY. +sequentially, inside a the 'installer-step prompt. When aborted to with a +parameter of 'abort, fallback to a previous install-step, accordingly to the +specified REWIND-STRATEGY. When aborted to with a parameter of 'break, stop +the computation and return the accumalated result so far. REWIND-STRATEGY possible values are 'previous, 'menu and 'start. If 'previous is selected, the execution will resume at the previous installer-step. If @@ -112,10 +100,7 @@ (define* (run-installer-steps #:key where STEP-ID is the ID field of the installer-step and COMPUTE-RESULT the result of the associated COMPUTE procedure. This result association list is passed as argument of every COMPUTE procedure. It is finally returned when the -computation is over. - -If the &installer-step-break condition is raised, stop the computation and -return the accumalated result so far." +computation is over." (define (pop-result list) (cdr list)) @@ -149,63 +134,61 @@ (define* (run result #:key todo-steps done-steps) (match todo-steps (() (reverse result)) ((step . rest-steps) - (guard (c ((installer-step-abort? c) - (case rewind-strategy - ((previous) - (match done-steps - (() - ;; We cannot go previous the first step. So re-raise - ;; the exception. It might be useful in the case of - ;; nested run-installer-steps. Abort to 'raise-above - ;; prompt to prevent the condition from being catched - ;; by one of the previously installed guard. - (abort-to-prompt 'raise-above c)) - ((prev-done ... last-done) - (run (pop-result result) - #:todo-steps (cons last-done todo-steps) - #:done-steps prev-done)))) - ((menu) - (let ((goto-step (menu-proc - (append done-steps (list step))))) - (if (eq? goto-step step) - (run result - #:todo-steps todo-steps - #:done-steps done-steps) - (skip-to-step goto-step result - #:todo-steps todo-steps - #:done-steps done-steps)))) - ((start) - (if (null? done-steps) - ;; Same as above, it makes no sense to jump to start - ;; when we are at the first installer-step. Abort to - ;; 'raise-above prompt to re-raise the condition. - (abort-to-prompt 'raise-above c) - (run '() - #:todo-steps steps - #:done-steps '()))))) - ((installer-step-break? c) - (reverse result))) - (installer-log-line "running step '~a'" (installer-step-id step)) - (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)))))))) + (call-with-prompt 'installer-step + (lambda () + (installer-log-line "running step '~a'" (installer-step-id step)) + (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))))) + (lambda (k action) + (match action + ('abort + (case rewind-strategy + ((previous) + (match done-steps + (() + ;; We cannot go previous the first step. Abort again to + ;; 'installer-step prompt. It might be useful in the case + ;; of nested run-installer-steps. + (abort-to-prompt 'installer-step action)) + ((prev-done ... last-done) + (run (pop-result result) + #:todo-steps (cons last-done todo-steps) + #:done-steps prev-done)))) + ((menu) + (let ((goto-step (menu-proc + (append done-steps (list step))))) + (if (eq? goto-step step) + (run result + #:todo-steps todo-steps + #:done-steps done-steps) + (skip-to-step goto-step result + #:todo-steps todo-steps + #:done-steps done-steps)))) + ((start) + (if (null? done-steps) + ;; Same as above, it makes no sense to jump to start + ;; when we are at the first installer-step. Abort to + ;; 'installer-step prompt again. + (abort-to-prompt 'installer-step action) + (run '() + #:todo-steps steps + #:done-steps '()))))) + ('break + (reverse result)))))))) ;; Ignore SIGPIPE so that we don't die if a client closes the connection ;; prematurely. (sigaction SIGPIPE SIG_IGN) (with-server-socket - (call-with-prompt 'raise-above - (lambda () - (run '() - #:todo-steps steps - #:done-steps '())) - (lambda (k condition) - (raise condition))))) + (run '() + #:todo-steps steps + #:done-steps '()))) (define (find-step-by-id steps id) "Find and return the step in STEPS whose id is equal to ID." From patchwork Sat Jan 15 13:50:08 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36377 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 0C16B27BBEB; Sat, 15 Jan 2022 13:53:08 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 1D0AB27BBEA for ; Sat, 15 Jan 2022 13:53:07 +0000 (GMT) Received: from localhost ([::1]:41810 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUQ-0007g2-8J for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:53:06 -0500 Received: from eggs.gnu.org ([209.51.188.92]:37974) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jTO-0005s7-Od for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46643) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jTO-0004R2-4V for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jTO-0001uG-3z for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 15/18] installer: Add error page when running external commands. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:52: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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546747223 (code B ref 53063); Sat, 15 Jan 2022 13:52:02 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:51:14 +0000 Received: from localhost ([127.0.0.1]:39537 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jSc-0001sK-1a for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:51:14 -0500 Received: from jpoiret.xyz ([206.189.101.64]:49552) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS2-0001nt-1l for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:39 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 4AC9018506C; Sat, 15 Jan 2022 13:50:37 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254637; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=XoMruz0Kia1JiWglX8fML55Af/g72LAyaRJJM254d7Y=; b=HRMmXNG2EJKWazI/zQBGUrkWt/QX4V6TTPVD/sc1WXbYnIbvznFljvGne2JREPqySBIy0Q Ggu9zYaz1zUZSlWqLPIaLOS3cNl7RdWK0Z/UgDHENytNTdMjyg7JgTK95eyv03gNJn5ppo t9GYoSyWpGOEZ6kv/IGaCED1FaK7/HUoTu4ZFkCoY11rWHNSNYW4BeWEaSH+vQHuVAIf+z ahewc9sUD1xLQYXTnZN2ePDDKjwzrqixUCP0hIZOxdkZWPBWiLu+WU5o5MLNuIIjq7VH9a ZL92PFsP5MBLooLLM5EvEZ7y39W/oOhHjpUM/x/pqiLvdbeGH/TZZ5IH9NB+4g== Date: Sat, 15 Jan 2022 14:50:08 +0100 Message-Id: <20220115135011.5817-16-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/newt.scm (newt-run-command): Add it. * gnu/installer/newt/page.scm (%ok-button, %exit-button, %default-buttons, make-newt-buttons, run-textbox-page): Add them. --- gnu/installer/newt.scm | 54 +++++++++++++++++++++--- gnu/installer/newt/page.scm | 83 +++++++++++++++++++++++++++++++++++++ 2 files changed, 132 insertions(+), 5 deletions(-) diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index fc851339d1..352d2997bd 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -41,6 +41,8 @@ (define-module (gnu installer newt) #:use-module (guix discovery) #:use-module (guix i18n) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #:use-module (newt) #:export (newt-installer)) @@ -80,11 +82,53 @@ (define (exit-error file report key args) (clear-screen)) (define (newt-run-command . args) - (newt-suspend) - (clear-screen) - (define result (run-command args)) - (newt-resume) - result) + (define command-output "") + (define (line-accumulator line) + (set! command-output + (string-append/shared command-output line "\n"))) + (define displayed-command + (string-join + (map (lambda (s) (string-append "\"" s "\"")) args) + " ")) + (define result (run-external-command-with-line-hooks (list line-accumulator) + args)) + (define exit-val (status:exit-val result)) + (define term-sig (status:term-sig result)) + (define stop-sig (status:stop-sig result)) + + (if (and exit-val (zero? exit-val)) + #t + (let ((info-text + (cond + (exit-val + (format #f (G_ "External command ~s exited with code ~a") + args exit-val)) + (term-sig + (format #f (G_ "External command ~s terminated by signal ~a") + args term-sig)) + (stop-sig + (format #f (G_ "External command ~s stopped by signal ~a") + args stop-sig))))) + (run-textbox-page #:title (G_ "External command error") + #:info-text info-text + #:content command-output + #:buttons-spec + (list + (cons "Ignore" (const #t)) + (cons "Abort" + (lambda () + (abort-to-prompt 'installer-step 'abort))) + (cons "Dump" + (lambda () + (raise + (condition + ((@@ (guix build utils) + &invoke-error) + (program (car args)) + (arguments (cdr args)) + (exit-status exit-val) + (term-signal term-sig) + (stop-signal stop-sig))))))))))) (define (final-page result prev-steps) (run-final-page result prev-steps)) diff --git a/gnu/installer/newt/page.scm b/gnu/installer/newt/page.scm index 8c675fa837..b5d7c98094 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -44,6 +44,9 @@ (define-module (gnu installer newt page) run-scale-page run-checkbox-tree-page run-file-textbox-page + %ok-button + %exit-button + run-textbox-page run-form-with-clients)) @@ -816,3 +819,83 @@ (define result (components=? argument edit-button)) (loop) ;recurse in tail position result))))) + +(define %ok-button + (cons (G_ "Ok") (lambda () #t))) + +(define %exit-button + (cons (G_ "Exit") (lambda () (abort-to-prompt 'installer-step 'abort)))) + +(define %default-buttons + (list %ok-button %exit-button)) + +(define (make-newt-buttons buttons-spec) + (map + (match-lambda ((title . proc) + (cons (make-button -1 -1 title) proc))) + buttons-spec)) + +(define* (run-textbox-page #:key + title + info-text + content + (buttons-spec %default-buttons)) + "Run a page to display INFO-TEXT followed by CONTENT to the user, who has to +choose an action among the buttons specified by BUTTONS-SPEC. + +BUTTONS-SPEC is an association list with button labels as keys, and callback +procedures as values. + +This procedure returns the result of the callback procedure of the button +chosen by the user." + (define info-textbox + (make-reflowed-textbox -1 -1 info-text + 50 + #:flags FLAG-BORDER)) + (define content-textbox + (make-textbox -1 -1 + 50 + 30 + (logior FLAG-SCROLL FLAG-BORDER))) + (define buttons + (make-newt-buttons buttons-spec)) + (define grid + (vertically-stacked-grid + GRID-ELEMENT-COMPONENT info-textbox + GRID-ELEMENT-COMPONENT content-textbox + GRID-ELEMENT-SUBGRID + (apply + horizontal-stacked-grid + (append-map (match-lambda ((button . proc) + (list GRID-ELEMENT-COMPONENT button))) + buttons)))) + (define form (make-form #:flags FLAG-NOF12)) + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid title) + (set-textbox-text content-textbox + (receive (_w _h text) + (reflow-text content + 50 + 0 0) + text)) + + (receive (exit-reason argument) + (run-form-with-clients form + `(contents-dialog (title ,title) + (text ,info-text) + (content ,content))) + (destroy-form-and-pop form) + (match exit-reason + ('exit-component + (let ((proc (assq-ref buttons argument))) + (if proc + (proc) + (raise + (condition + (&serious) + (&message + (message (format #f "Unable to find corresponding PROC for \ +component ~a." argument)))))))) + ;; TODO + ('exit-fd-ready + (raise (condition (&serious))))))) From patchwork Sat Jan 15 13:50:09 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36384 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 1080327BBEA; Sat, 15 Jan 2022 13:55:00 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 9589C27BBE9 for ; Sat, 15 Jan 2022 13:54:59 +0000 (GMT) Received: from localhost ([::1]:44508 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jWE-00017c-QS for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:54:58 -0500 Received: from eggs.gnu.org ([209.51.188.92]:38004) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jTc-00067b-I4 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:16 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46645) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jTO-0004RG-TS for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:14 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jTO-0001uW-TM for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 16/18] installer: Use dynamic-wind to setup installer. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:52: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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546757237 (code B ref 53063); Sat, 15 Jan 2022 13:52:02 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:51:15 +0000 Received: from localhost ([127.0.0.1]:39541 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jSc-0001sZ-Rw for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:51:15 -0500 Received: from jpoiret.xyz ([206.189.101.64]:49868) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS3-0001oE-15 for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:40 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 248C3185147; Sat, 15 Jan 2022 13:50:38 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254638; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=BOAk/vlMLDBj4I3CkbJ9WnydFu0uFGXy77b8BIlkFbQ=; b=drvOvfL/RZdRmhMkX9JP+dt44pfkdsrcQB+/FbtAH+jDixCA2nm31IErkD+7YoL8CNF8H2 cjt7/dtDYPwLZHjpBlpYjKMV4UpbhHE0ut7E+ZZjg+goLekB52pGbXM5Pdos7XiI9qycqg ld5lKrckCA74ueqptGNUeMOv3CEUk/B4WExN+aZ3YgU93XnR1ox+PIOWdSj6BYGru/bqn5 Et7GpP1ZLQO9TzLC72FvY50sy27OdD9X00PyLZxlEz9KozxbdMP3fSUasgubuXTQv+eFXz LkAPaN08k7CkZ3RvLNxjXXQfa/LcE+lDq4FuRB9AoZiRAAqM+D5HGdDGnY3x9w== Date: Sat, 15 Jan 2022 14:50:09 +0100 Message-Id: <20220115135011.5817-17-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer.scm (installer-program): Use dynamic-wind, so that completely uncaught exceptions can be printed properly. --- gnu/installer.scm | 92 ++++++++++++++++++++++++----------------------- 1 file changed, 47 insertions(+), 45 deletions(-) diff --git a/gnu/installer.scm b/gnu/installer.scm index c7e0921a19..86495a067b 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -416,51 +416,53 @@ (define installer-builder (define current-installer newt-installer) (define steps (#$steps current-installer)) - ((installer-init current-installer)) - - (parameterize - ((run-command-in-installer - (installer-run-command current-installer))) - (catch #t - (lambda () - (define results - (run-installer-steps - #:rewind-strategy 'menu - #:menu-proc (installer-menu-page current-installer) - #:steps steps)) - - (match (result-step results 'final) - ('success - ;; We did it! Let's reboot! - (sync) - (stop-service 'root)) - (_ - ;; 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) - (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))) - (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)))))) + (dynamic-wind + (installer-init current-installer) + + (lambda () + (parameterize + ((run-command-in-installer + (installer-run-command current-installer))) + (catch #t + (lambda () + (define results + (run-installer-steps + #:rewind-strategy 'menu + #:menu-proc (installer-menu-page current-installer) + #:steps steps)) + + (match (result-step results 'final) + ('success + ;; We did it! Let's reboot! + (sync) + (stop-service 'root)) + (_ + ;; 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) + (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))) + (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)))))) (program-file "installer" From patchwork Sat Jan 15 13:50:10 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36379 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 75F6627BBEA; Sat, 15 Jan 2022 13:53:15 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 F324127BBE9 for ; Sat, 15 Jan 2022 13:53:14 +0000 (GMT) Received: from localhost ([::1]:42442 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUY-00085O-3w for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:53:14 -0500 Received: from eggs.gnu.org ([209.51.188.92]:38006) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jTc-00067d-Jh for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:16 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46646) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jTP-0004RN-97 for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:14 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jTP-0001ud-9U for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 17/18] installer: Turn passwords into opaque records. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:52:03 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546757245 (code B ref 53063); Sat, 15 Jan 2022 13:52:03 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:51:15 +0000 Received: from localhost ([127.0.0.1]:39543 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jSd-0001sg-8t for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:51:15 -0500 Received: from jpoiret.xyz ([206.189.101.64]:49658) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS3-0001nw-J1 for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:40 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id E1B61185148; Sat, 15 Jan 2022 13:50:38 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254639; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=mgahbeW99p08uqGuUoQSrqa3yRE4WTyhH8DCGFxLk5c=; b=W/p+G0xRU+ZoDEi6PIrFpUTc503oYj18Om1eD3MsQMuodjZP3LICSgR1GsWrkwCdVya6nN y61eces6/kDQhld9SZlVo6/atIchs2FH7ceAXg7pTW6SephK2MrVlJzcZ8RITKAj/QmaAl vDz4VL4WTJr+HTfS2s1iGMCW+XTkjMktmWww4HUx/JWFMLMlzo5+J5C9XazhRcaSFBCpod UfKrpmaMI1dQ1c7+wB9OQv9cj6hos20Sic7Mtitxwn6AaNxNX3xMD/7O5sRsqKAhzsnNP+ DCR4jHS/A3lunSxrZ159qYBhHhrBZ04SPW9xzymJYyCptNrXVxUiHiGhR5LjhQ== Date: Sat, 15 Jan 2022 14:50:10 +0100 Message-Id: <20220115135011.5817-18-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: / Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer/user.scm (, secret?, make-secret, secret-content): Add opaque record that boxes its contents, with a custom printer that doesn't display anything. * gnu/installer/newt/user.scm (run-user-add-page, run-user-page): Box it. * gnu/installer/final.scm (create-user-database): Unbox it. --- gnu/installer/final.scm | 5 +++-- gnu/installer/newt/user.scm | 6 +++--- gnu/installer/user.scm | 18 +++++++++++++++++- 3 files changed, 23 insertions(+), 6 deletions(-) diff --git a/gnu/installer/final.scm b/gnu/installer/final.scm index 63e5073ff4..2087536502 100644 --- a/gnu/installer/final.scm +++ b/gnu/installer/final.scm @@ -85,8 +85,9 @@ (define root? (uid (if root? 0 #f)) (home-directory (user-home-directory user)) - (password (crypt (user-password user) - (salt))) + (password (crypt + (secret-content (user-password user)) + (salt))) ;; We need a string here, not a file-like, hence ;; this choice. diff --git a/gnu/installer/newt/user.scm b/gnu/installer/newt/user.scm index 97141cfe64..7c1cc2249d 100644 --- a/gnu/installer/newt/user.scm +++ b/gnu/installer/newt/user.scm @@ -143,7 +143,7 @@ (define (pad-label label) (name name) (real-name real-name) (home-directory home-directory) - (password password)) + (password (make-secret password))) (run-user-add-page #:name name #:real-name real-name #:home-directory @@ -266,7 +266,7 @@ (define (run users) (map (lambda (name real-name home password) (user (name name) (real-name real-name) (home-directory home) - (password password))) + (password (make-secret password)))) names real-names homes passwords)))))) (lambda () (destroy-form-and-pop form)))))) @@ -274,5 +274,5 @@ (define (run users) ;; Add a "root" user simply to convey the root password. (cons (user (name "root") (home-directory "/root") - (password (run-root-password-page))) + (password (make-secret (run-root-password-page)))) (run '()))) diff --git a/gnu/installer/user.scm b/gnu/installer/user.scm index 4e701e64ce..13114e9832 100644 --- a/gnu/installer/user.scm +++ b/gnu/installer/user.scm @@ -19,7 +19,14 @@ (define-module (gnu installer user) #:use-module (guix records) #:use-module (srfi srfi-1) - #:export ( + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:export ( + secret? + make-secret + secret-content + + user make-user user-name @@ -30,6 +37,15 @@ (define-module (gnu installer user) users->configuration)) +(define-record-type + (make-secret content) + secret? + (content secret-content)) +(set-record-type-printer! + + (lambda (secret port) + (format port ""))) + (define-record-type* user make-user user? From patchwork Sat Jan 15 13:50:11 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Josselin Poiret X-Patchwork-Id: 36380 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 170CD27BBEA; Sat, 15 Jan 2022 13:53:24 +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=-0.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FROM_SUSPICIOUS_NTLD,MAILING_LIST_MULTI,PDS_OTHER_BAD_TLD, RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=no 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 0EDB027BBE9 for ; Sat, 15 Jan 2022 13:53:23 +0000 (GMT) Received: from localhost ([::1]:42910 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUg-0008OQ-8H for patchwork@mira.cbaines.net; Sat, 15 Jan 2022 08:53:22 -0500 Received: from eggs.gnu.org ([209.51.188.92]:38008) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n8jTc-00067e-Jr for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:16 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:46647) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n8jTP-0004RX-MJ for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:14 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n8jTP-0001un-MA for guix-patches@gnu.org; Sat, 15 Jan 2022 08:52:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH v2 wip-harden-installer 18/18] installer: Make dump archive creation optional and selective. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 15 Jan 2022 13:52:03 +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: Mathieu Othacehe Cc: 53063@debbugs.gnu.org, ludo@gnu.org, Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.16422546767258 (code B ref 53063); Sat, 15 Jan 2022 13:52:03 +0000 Received: (at 53063) by debbugs.gnu.org; 15 Jan 2022 13:51:16 +0000 Received: from localhost ([127.0.0.1]:39545 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jSd-0001so-Kh for submit@debbugs.gnu.org; Sat, 15 Jan 2022 08:51:16 -0500 Received: from jpoiret.xyz ([206.189.101.64]:50078) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n8jS5-0001ow-K0 for 53063@debbugs.gnu.org; Sat, 15 Jan 2022 08:50:43 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id B42DA185149; Sat, 15 Jan 2022 13:50:39 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1642254640; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=nqmDo2lJ1u3KBUKSB65efrKXRVa+rWRUcON7Sq0ljGc=; b=c1qGoNBHB757Jzyl0qNMVpKRrWo6ewrpZUxYoX9kFhMr9J5fZ0YswwTTJ6ouvkatV+AybI MPXvBAuujA6ThnNbZHmyAtXuRjNaBn7PbRMW7jGf82HdGGk6S1Ex1mct/7f5csX5B1ZSTO emv9E/Lbx8fqYP0unyiYJQJ+rGUhGO7uG4gZG+B0AJJev9Gm1VWvIxz3MqutPnluUOwvIW BtwLPrYzvF+SPcG5aboHL3t8TcYPO+V4e8lymEVSMuk0HNReMlhrhg4V840KwGDj2voR0X bmV7LeRWHFP0pLzTkzQliZGTJ5HY76wmFCm1Yk/HPTkd2RjPOrLF937SxPpZuQ== Date: Sat, 15 Jan 2022 14:50:11 +0100 Message-Id: <20220115135011.5817-19-dev@jpoiret.xyz> In-Reply-To: <20220115135011.5817-1-dev@jpoiret.xyz> References: <8735lz4xsv.fsf@gnu.org> <20220115135011.5817-1-dev@jpoiret.xyz> MIME-Version: 1.0 X-Spamd-Bar: --- Authentication-Results: jpoiret.xyz; auth=pass smtp.auth=jpoiret@jpoiret.xyz smtp.mailfrom=dev@jpoiret.xyz 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" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches X-Patchwork-Original-From: Josselin Poiret via Guix-patches via From: Josselin Poiret X-getmail-retrieved-from-mailbox: Patches * gnu/installer.scm (installer-program): Let the installer customize the dump archive. * gnu/installer/dump.scm (prepare-dump, make-dump): Split make-dump in prepare-dump, which copies the files necessary for the dump, and make-dump which creates the archive. * gnu/installer/record.scm (installer): Add report-page field. Change documented return value of exit-error. * gnu/installer/newt.scm (exit-error): Change arguments to be a string containing the error. Let the user choose between exiting and initiating a dump. (report-page): Add new variable. * gnu/installer/newt/page.scm (run-dump-page): New variable. * gnu/installer/newt/dump.scm: Delete it. --- gnu/installer.scm | 38 ++++++++++---------- gnu/installer/dump.scm | 67 ++++++++++++++++++++-------------- gnu/installer/newt.scm | 72 ++++++++++++++++++++++++------------- gnu/installer/newt/dump.scm | 36 ------------------- gnu/installer/newt/page.scm | 58 ++++++++++++++++++++++++++++++ gnu/installer/record.scm | 9 +++-- gnu/local.mk | 1 - 7 files changed, 173 insertions(+), 108 deletions(-) delete mode 100644 gnu/installer/newt/dump.scm diff --git a/gnu/installer.scm b/gnu/installer.scm index 86495a067b..01eda04774 100644 --- a/gnu/installer.scm +++ b/gnu/installer.scm @@ -386,7 +386,8 @@ (define installer-builder (guix build utils) ((system repl debug) #:select (terminal-width)) - (ice-9 match)) + (ice-9 match) + (ice-9 textual-ports)) ;; Initialize gettext support so that installers can use ;; (guix i18n) module. @@ -416,6 +417,7 @@ (define installer-builder (define current-installer newt-installer) (define steps (#$steps current-installer)) + (dynamic-wind (installer-init current-installer) @@ -444,23 +446,23 @@ (define results (lambda (key . args) (installer-log-line "crashing due to uncaught exception: ~s ~s" key args) - (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))) - (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))))) + (define dump-dir (prepare-dump key args + #:result %current-result)) + (define action + ((installer-exit-error current-installer) + (get-string-all + (open-input-file + (string-append dump-dir "/installer-backtrace"))))) + (match action + ('dump + (let* ((dump-files + ((installer-dump-page current-installer) + dump-dir)) + (dump-archive (make-dump dump-dir dump-files))) + ((installer-report-page current-installer) + dump-archive))) + (_ #f)) + (exit 1))))) (installer-exit current-installer)))))) diff --git a/gnu/installer/dump.scm b/gnu/installer/dump.scm index 49c40a26af..daa02f205a 100644 --- a/gnu/installer/dump.scm +++ b/gnu/installer/dump.scm @@ -28,7 +28,8 @@ (define-module (gnu installer dump) #:use-module (web http) #:use-module (web response) #:use-module (webutils multipart) - #:export (make-dump + #:export (prepare-dump + make-dump send-dump-report)) ;; The installer crash dump type. @@ -40,35 +41,49 @@ (define (result->list result) (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") +(define* (prepare-dump key args #:key result) + "Create a crash dump directory. KEY and ARGS represent the thrown error. +RESULT is the installer result hash table. Returns the created directory path." + (define now (localtime (current-time))) + (define dump-dir + (format #f "/tmp/dump.~a" + (strftime "%F.%H.%M.%S" now))) + (mkdir-p dump-dir) + (with-directory-excursion dump-dir + ;; backtrace + (call-with-output-file "installer-backtrace" + (lambda (port) + (display-backtrace (make-stack #t) port) + (print-exception port + (stack-ref (make-stack #t) 1) + key args))) - ;; installer result - (call-with-output-file "installer-result" - (lambda (port) - (write (result->list result) port))) + ;; installer result + (call-with-output-file "installer-result" + (lambda (port) + (write (result->list result) port))) - ;; syslog - (copy-file "/var/log/messages" "syslog") + ;; 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))))) + ;; dmesg + (let ((pipe (open-pipe* OPEN_READ "dmesg"))) + (call-with-output-file "dmesg" + (lambda (port) + (dump-port pipe port) + (close-pipe pipe))))) + dump-dir) - (with-directory-excursion (dirname dump-dir) - (system* "tar" "-zcf" output (basename dump-dir))))) +(define* (make-dump dump-dir file-choices) + "Create a crash dump archive from DUMP-DIR containing FILE-CHOICES. +Returns the archive path." + (define output (string-append (basename dump-dir) ".tar.gz")) + (with-directory-excursion (dirname dump-dir) + (apply system* "tar" "-zcf" output + (map (lambda (f) + (string-append (basename dump-dir) "/" f)) + file-choices))) + (canonicalize-path (string-append (dirname dump-dir) "/" output))) (define* (send-dump-report dump #:key diff --git a/gnu/installer/newt.scm b/gnu/installer/newt.scm index 352d2997bd..2646b5d369 100644 --- a/gnu/installer/newt.scm +++ b/gnu/installer/newt.scm @@ -19,7 +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 dump) #:use-module (gnu installer newt ethernet) #:use-module (gnu installer newt final) #:use-module (gnu installer newt parameters) @@ -40,9 +40,11 @@ (define-module (gnu installer newt) #:use-module (guix config) #:use-module (guix discovery) #:use-module (guix i18n) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (ice-9 ftw) #:use-module (newt) #:export (newt-installer)) @@ -58,28 +60,52 @@ (define (exit) (newt-finish) (clear-screen)) -(define (exit-error file report key args) +(define (exit-error error) (newt-set-color COLORSET-ROOT "white" "red") - (let ((width (nearest-exact-integer - (* (screen-columns) 0.8))) - (height (nearest-exact-integer - (* (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~a. Please report it by email to \ -<~a>.") report %guix-bug-report-address) + (define action + (run-textbox-page + #:info-text (G_ "The installer has encountered an unexpected problem. \ +The backtrace is displayed below. You may choose to exit or create a dump \ +archive.") #:title (G_ "Unexpected problem") - #:file file - #:exit-button? #f - #:info-textbox-width width - #:file-textbox-width width - #:file-textbox-height height)) + #:content error + #:buttons-spec + (list + (cons (G_ "Exit") (const 'exit)) + (cons (G_ "Dump") (const 'dump))))) (newt-set-color COLORSET-ROOT "white" "blue") - (newt-finish) - (clear-screen)) + action) + +(define (report-page dump-archive) + (define text + (format #f (G_ "The dump archive was created as ~a. Would you like to \ +send this archive to the Guix servers?") dump-archive)) + (define title (G_ "Dump archive created")) + (when (run-confirmation-page text title) + (let* ((uploaded-name (send-dump-report dump-archive)) + (text (if uploaded-name + (format #f (G_ "The dump was uploaded as ~a. Please \ +report it by email to ~a.") uploaded-name %guix-bug-report-address) + (G_ "The dump could not be uploaded.")))) + (run-error-page + text + (G_ "Dump upload result"))))) + +(define (dump-page dump-dir) + (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)) + '() + (run-dump-page + dump-dir + (map (lambda (x) + (cons x #f)) + files)))) (define (newt-run-command . args) (define command-output "") @@ -178,9 +204,6 @@ (define (parameters-menu menu-proc) (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) @@ -202,4 +225,5 @@ (define newt-installer (parameters-menu parameters-menu) (parameters-page parameters-page) (dump-page dump-page) - (run-command newt-run-command))) + (run-command newt-run-command) + (report-page report-page))) diff --git a/gnu/installer/newt/dump.scm b/gnu/installer/newt/dump.scm deleted file mode 100644 index 64f0d58237..0000000000 --- a/gnu/installer/newt/dump.scm +++ /dev/null @@ -1,36 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021 Mathieu Othacehe -;;; -;;; 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 . - -(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/newt/page.scm b/gnu/installer/newt/page.scm index b5d7c98094..060e633254 100644 --- a/gnu/installer/newt/page.scm +++ b/gnu/installer/newt/page.scm @@ -47,6 +47,7 @@ (define-module (gnu installer newt page) %ok-button %exit-button run-textbox-page + run-dump-page run-form-with-clients)) @@ -899,3 +900,60 @@ (define form (make-form #:flags FLAG-NOF12)) ;; TODO ('exit-fd-ready (raise (condition (&serious))))))) + +(define* (run-dump-page base-dir file-choices) + (define info-textbox + (make-reflowed-textbox -1 -1 "Please select files you wish to include in \ +the dump." + 50 + #:flags FLAG-BORDER)) + (define components + (map (match-lambda ((file . enabled) + (list + (make-button -1 -1 "Edit") + (make-checkbox -1 -1 file (if enabled #\x #\ ) " x") + file))) + file-choices)) + (define grid + (apply 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"))))) + (define form (make-form #:flags FLAG-NOF12)) + + (add-form-to-grid grid form #t) + (make-wrapped-grid-window grid "Installer dump") + + (define prompt-tag (make-prompt-tag)) + + (let loop () + (call-with-prompt prompt-tag + (lambda () + (receive (exit-reason argument) + (run-form-with-clients form + `(dump-page)) + (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))) + (destroy-form-and-pop form) + result)) + ;; TODO + ('exit-fd-ready + (raise (condition (&serious))))))) + (lambda (k file) + (edit-file (string-append base-dir "/" file)) + (loop))))) diff --git a/gnu/installer/record.scm b/gnu/installer/record.scm index 23db3edd70..20519a26c3 100644 --- a/gnu/installer/record.scm +++ b/gnu/installer/record.scm @@ -43,7 +43,8 @@ (define-module (gnu installer record) installer-parameters-menu installer-parameters-page installer-dump-page - installer-run-command)) + installer-run-command + installer-report-page)) ;;; @@ -63,7 +64,7 @@ (define-record-type* (init installer-init) ;; procedure: void -> void (exit installer-exit) - ;; procedure (key arguments) -> void + ;; procedure (key arguments) -> (action) (exit-error installer-exit-error) ;; procedure void -> void (final-page installer-final-page) @@ -97,4 +98,6 @@ (define-record-type* ;; procedure (dump) -> void (dump-page installer-dump-page) ;; procedure command -> bool - (run-command installer-run-command)) + (run-command installer-run-command) + ;; procedure (report) -> void + (report-page installer-report-page)) diff --git a/gnu/local.mk b/gnu/local.mk index a3818cdcbf..adb3d64e29 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -773,7 +773,6 @@ 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 \