From patchwork Thu Jan 6 22:48: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: 36054 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 9BEF127BBE9; Thu, 6 Jan 2022 22:49:28 +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 B278727BBEA for ; Thu, 6 Jan 2022 22:49:25 +0000 (GMT) Received: from localhost ([::1]:44776 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n5bZU-000878-TI for patchwork@mira.cbaines.net; Thu, 06 Jan 2022 17:49:24 -0500 Received: from eggs.gnu.org ([209.51.188.92]:57556) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n5bZ9-0007Pg-IU for guix-patches@gnu.org; Thu, 06 Jan 2022 17:49:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:49725) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n5bZ9-00074b-8k for guix-patches@gnu.org; Thu, 06 Jan 2022 17:49:03 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n5bZ9-00005B-8i for guix-patches@gnu.org; Thu, 06 Jan 2022 17:49:03 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53063] [PATCH wip-harden-installer 03/14] installer: Use new installer-log-line everywhere. Resent-From: Josselin Poiret Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 06 Jan 2022 22:49: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: 53063@debbugs.gnu.org Cc: Josselin Poiret Received: via spool by 53063-submit@debbugs.gnu.org id=B53063.164150931932612 (code B ref 53063); Thu, 06 Jan 2022 22:49:03 +0000 Received: (at 53063) by debbugs.gnu.org; 6 Jan 2022 22:48:39 +0000 Received: from localhost ([127.0.0.1]:42588 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n5bYk-0008Th-Aj for submit@debbugs.gnu.org; Thu, 06 Jan 2022 17:48:39 -0500 Received: from jpoiret.xyz ([206.189.101.64]:36022) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n5bYi-0008TD-34 for 53063@debbugs.gnu.org; Thu, 06 Jan 2022 17:48:36 -0500 Received: from authenticated-user (jpoiret.xyz [206.189.101.64]) by jpoiret.xyz (Postfix) with ESMTPA id 4FB16184D98; Thu, 6 Jan 2022 22:48:35 +0000 (UTC) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=jpoiret.xyz; s=dkim; t=1641509315; 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=QpjHn3IefyC9oYHERzv+eUl6anpcbWJovVP3zwpzAIocpMYF5CqsSW6IYsUgZ4A/3z7OAv pFxJ8VkcUXaI6YsRZw1qwpItZbN27S1KN2guejqyLO/4eEA+RJrK8kP3fPSDCjZV94+F2/ CZ321ilA2NwBCdIdecwozRDjceglAPVGwBv9OXcUAaQ9CFbb3mSmWHiDni/72ks57A2eY5 6/dX9s7FI6EPVp5vc1sYevUmRT+57DhK5zc0py2rHMpcJXjhxKrLITFf/dqf3hJbW92223 UpE9L2eZpT7skfURF+dCdnTXPnRj8ZM+Vx1HdfNW9RoQPoLP440wQy0dDc7Ceg== Date: Thu, 6 Jan 2022 23:48:01 +0100 Message-Id: In-Reply-To: References: 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))))))