From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp12.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms0.migadu.com with LMTPS id CDq6NcDR4mGHtwAAgWs5BA (envelope-from ) for ; Sat, 15 Jan 2022 14:53:04 +0100 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp12.migadu.com with LMTPS id 4LOdMsDR4mHJkgAAauVa8A (envelope-from ) for ; Sat, 15 Jan 2022 14:53:04 +0100 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 46B132A03C for ; Sat, 15 Jan 2022 14:53:04 +0100 (CET) Received: from localhost ([::1]:41810 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n8jUN-0007g2-Fq for larch@yhetil.org; Sat, 15 Jan 2022 08:53:03 -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 Content-Transfer-Encoding: 8bit X-Spamd-Bar: / 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+larch=yhetil.org@gnu.org Sender: "Guix-patches" Reply-to: Josselin Poiret X-ACL-Warn: , Josselin Poiret via Guix-patches From: Josselin Poiret via Guix-patches via X-Migadu-Flow: FLOW_IN X-Migadu-Country: US ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1642254784; h=from:from:sender:sender:reply-to:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:cc:mime-version:mime-version: content-transfer-encoding:content-transfer-encoding:resent-cc: resent-from:resent-sender:resent-message-id:in-reply-to:in-reply-to: references:references:list-id:list-help:list-unsubscribe: list-subscribe:list-post:dkim-signature; bh=XoMruz0Kia1JiWglX8fML55Af/g72LAyaRJJM254d7Y=; b=H+189RXvKfgE0tS9Y+Pv635OjzTl/LVZkP0vO/ZPjciuwOCx46/+QFJVMBoXwEy17DaYvn aKOHBNiWIoyHxHwb4LfWpFGt6+mACY1Qdr+HbICZtkMZgDPLnvy822p08utldvsuXMMY5d pPkluGoCcxbW2Vy+5hh2FtEPvzDOAUQkVFTogSdLLdOpBxikV8L4EfF0WrYz3DbywAfTaT fUzS1av2Lj/qxXav6faLjSI585G1AxLKax/Akbzu1b/YaDxDLTSYmATCAMN5BRaAUEHNbB 9cnEeTqjcmcky8julrf+Osdhm/BUqUoOD+NqZ29X1W2njPAu8IVWtH1pyEQUiA== ARC-Seal: i=1; s=key1; d=yhetil.org; t=1642254784; a=rsa-sha256; cv=none; b=i0g3RKBZJZH5Z0G2j5XM9S/C48cGKxAI8m8xNQaxNaROLdlrM204pC25//cBuh2W8rn2GJ 5dzH1SSiUGWifoMldktgojbIJgiUkF4HvVgvcGJllWU9P/Hq77iXYMst5HYvOQ3dXg426R whucnBQEOIT1SOQFckf7t5uATVFYgif4uN48MacDEauJxvfuhGn5FoGzMUQFjzBuWV5ZjT oa6A2ablAJcAx319i8F/QPxHg7MAtsTfeyp9c1O28MiJnn7wD6/TYNc7ZM2BuEJ/hoJK+F mTASLzpHfLHLcsem3xXi30ld7puB2lEAJ59uO3vGXBAIUvY7NzqAKiGeJuMNXA== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=jpoiret.xyz header.s=dkim header.b=HRMmXNG2; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Spam-Score: -3.93 Authentication-Results: aspmx1.migadu.com; dkim=fail ("headers rsa verify failed") header.d=jpoiret.xyz header.s=dkim header.b=HRMmXNG2; dmarc=pass (policy=none) header.from=gnu.org; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org" X-Migadu-Queue-Id: 46B132A03C X-Spam-Score: -3.93 X-Migadu-Scanner: scn0.migadu.com X-TUID: lG0wwwG3CXhD * 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))))))) -- 2.34.0