From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp1 ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms11 with LMTPS id uJNrG0Bw317PfQAA0tVLHw (envelope-from ) for ; Tue, 09 Jun 2020 11:19:28 +0000 Received: from aspmx1.migadu.com ([2001:41d0:2:4a6f::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp1 with LMTPS id oChXF0Bw315TXwAAbx9fmQ (envelope-from ) for ; Tue, 09 Jun 2020 11:19:28 +0000 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 93F1A940276 for ; Tue, 9 Jun 2020 11:19:27 +0000 (UTC) Received: from localhost ([::1]:45250 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jicHu-00005a-HY for larch@yhetil.org; Tue, 09 Jun 2020 07:19:26 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:35252) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1jicHW-0008LY-Dt for bug-guix@gnu.org; Tue, 09 Jun 2020 07:19:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:47534) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1jicHW-0003AG-1l for bug-guix@gnu.org; Tue, 09 Jun 2020 07:19:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1jicHV-0003Pf-Sp for bug-guix@gnu.org; Tue, 09 Jun 2020 07:19:01 -0400 X-Loop: help-debbugs@gnu.org Subject: bug#41668: Failing test: gui-installed-desktop-os-encrypted Resent-From: Mathieu Othacehe Original-Sender: "Debbugs-submit" Resent-CC: bug-guix@gnu.org Resent-Date: Tue, 09 Jun 2020 11:19:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 41668 X-GNU-PR-Package: guix X-GNU-PR-Keywords: To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Received: via spool by 41668-submit@debbugs.gnu.org id=B41668.159170151713087 (code B ref 41668); Tue, 09 Jun 2020 11:19:01 +0000 Received: (at 41668) by debbugs.gnu.org; 9 Jun 2020 11:18:37 +0000 Received: from localhost ([127.0.0.1]:59080 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jicH7-0003P1-8q for submit@debbugs.gnu.org; Tue, 09 Jun 2020 07:18:37 -0400 Received: from eggs.gnu.org ([209.51.188.92]:55298) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1jicH4-0003Om-9T for 41668@debbugs.gnu.org; Tue, 09 Jun 2020 07:18:35 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:39429) by eggs.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1jicGx-000350-J6; Tue, 09 Jun 2020 07:18:27 -0400 Received: from [2a01:e0a:fa:a50:d939:1174:2a3f:75c2] (port=51158 helo=meru) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1jicGw-0004Np-Px; Tue, 09 Jun 2020 07:18:27 -0400 From: Mathieu Othacehe References: <3f66774219bb18c47b305b8760f58abe@waegenei.re> <87mu5glcse.fsf@gnu.org> <877dwidhf0.fsf@gnu.org> <87blluslc8.fsf@gnu.org> <87zh9eaqq9.fsf@gnu.org> <878sgxbshs.fsf@gnu.org> Date: Tue, 09 Jun 2020 13:18:25 +0200 In-Reply-To: <878sgxbshs.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 08 Jun 2020 15:24:15 +0200") Message-ID: <87v9k0o5by.fsf@gnu.org> User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Spam-Score: -2.3 (--) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-Spam-Score: -3.3 (---) X-BeenThere: bug-guix@gnu.org List-Id: Bug reports for GNU Guix List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: 41668@debbugs.gnu.org, Brice Waegeneire Errors-To: bug-guix-bounces+larch=yhetil.org@gnu.org Sender: "bug-Guix" X-Scanner: scn0 Authentication-Results: aspmx1.migadu.com; dkim=none; dmarc=none; spf=pass (aspmx1.migadu.com: domain of bug-guix-bounces@gnu.org designates 209.51.188.17 as permitted sender) smtp.mailfrom=bug-guix-bounces@gnu.org X-Spam-Score: -1.01 X-TUID: X5wn8EF07OSr --=-=-= Content-Type: text/plain Hey, > Instead I did reimplement the command in (gnu installer utils) in the > attached patch :). There were an issue with exception handling, here's a v2. Note that it uses the &invoke-error constructor that should be made public I guess. Thanks, Mathieu --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-installer-utils-Dump-command-output-to-syslog-when-t.patch >From 18754c8c62eabb341e0f710d83ff435ef950ca8e Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Mon, 8 Jun 2020 15:14:49 +0200 Subject: [PATCH] installer: utils: Dump command output to syslog when testing. When debugging the installation tests, it can be very handy to be able to read "run-command" output, for instance when executing "guix system init". Introduce a new "invoke-with-log" procedure that is able to log a command standard and error outputs to the syslog. Use it, only when running the installation tests, to dump "run-command" output. * gnu/installer/utils.scm (open-pipe-with-stderr, invoke-with-log): New procedures, (invoke-log-port): new variable, (run-command): move to the end of the file and use invoke-with-log when running the installation tests. --- gnu/installer/utils.scm | 164 +++++++++++++++++++++++++++++----------- 1 file changed, 120 insertions(+), 44 deletions(-) diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm index 5f8fe8ca01..68b3dd5009 100644 --- a/gnu/installer/utils.scm +++ b/gnu/installer/utils.scm @@ -22,8 +22,13 @@ #:use-module (guix build utils) #:use-module (guix i18n) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-35) #: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) @@ -68,50 +73,6 @@ number. If no percentage is found, return #f" (and result (string->number (match:substring result 1))))) -(define* (run-command command #:key locale) - "Run COMMAND, a list of strings, in the given LOCALE. 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") - - (when locale - (let ((supported? (false-if-exception - (setlocale LC_ALL locale)))) - ;; If LOCALE is not supported, then set LANGUAGE, which might at - ;; least give us translated messages. - (if supported? - (setenv "LC_ALL" locale) - (setenv "LANGUAGE" - (string-take locale - (or (string-index locale #\_) - (string-length locale))))))) - - (guard (c ((invoke-error? c) - (newline) - (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)) - (pause) - #f)) - (syslog "running command ~s~%" command) - (apply invoke command) - (syslog "command ~s succeeded~%" command) - (newline) - (pause) - #t)) - ;;; ;;; Logging. @@ -219,3 +180,118 @@ accepting socket." (current-clients (reverse remainder)) exp) + + +;;; +;;; Run commands. +;;; + +;; XXX: This is taken from (guix build utils) and could be factorized. +(define (open-pipe-with-stderr program . args) + "Run PROGRAM with ARGS in an input pipe, but, unlike 'open-pipe*', redirect +both its standard output and standard error to the pipe. Return two value: +the pipe to read PROGRAM's data from, and the PID of the child process running +PROGRAM." + ;; 'open-pipe*' doesn't attempt to capture stderr in any way, which is why + ;; we need to roll our own. + (match (pipe) + ((input . output) + (match (primitive-fork) + (0 + (dynamic-wind + (const #t) + (lambda () + (close-port input) + (close-port (syslog-port)) + (dup2 (fileno output) 1) + (dup2 (fileno output) 2) + (apply execlp program program args)) + (lambda () + (primitive-exit 127)))) + (pid + (close-port output) + (values input pid)))))) + +(define invoke-log-port + ;; Port used by INVOKE-WITH-LOG for logging. + (make-parameter #f)) + +(define* (invoke-with-log program . args) + "Invoke PROGRAM with ARGS and log PROGRAM's standard output and standard +error to INVOKE-LOG-PORT. If PROGRAM succeeds, print nothing and return the +unspecified value; otherwise, raise a '&message' error condition with the +status code. This procedure is very similar to INVOKE/QUIET with the +noticeable difference that the program output, that can be quite heavy, is not +stored but directly sent to INVOKE-LOG-PORT if defined." + (let-values (((pipe pid) + (apply open-pipe-with-stderr program args))) + (let loop () + (match (read-line pipe) + ((? eof-object?) + (close-port pipe) + (match (waitpid pid) + ((_ . status) + (unless (zero? status) + (raise + (condition ((@@ (guix build utils) &invoke-error) + (program program) + (arguments args) + (exit-status (status:exit-val status)) + (term-signal (status:term-sig status)) + (stop-signal (status:stop-sig status))))))))) + (line + (and=> (invoke-log-port) (cut format <> "~a~%" line)) + (loop)))))) + +(define* (run-command command #:key locale) + "Run COMMAND, a list of strings, in the given LOCALE. 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") + + (when locale + (let ((supported? (false-if-exception + (setlocale LC_ALL locale)))) + ;; If LOCALE is not supported, then set LANGUAGE, which might at + ;; least give us translated messages. + (if supported? + (setenv "LC_ALL" locale) + (setenv "LANGUAGE" + (string-take locale + (or (string-index locale #\_) + (string-length locale))))))) + + (guard (c ((invoke-error? c) + (newline) + (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)) + (pause) + #f)) + (syslog "running command ~s~%" command) + ;; If there are any connected clients, assume that we are running + ;; installation tests. In that case, dump the standard and error outputs + ;; to syslog. + (let ((testing? (not (null? (current-clients))))) + (if testing? + (parameterize ((invoke-log-port (syslog-port))) + (apply invoke-with-log command)) + (apply invoke command))) + (syslog "command ~s succeeded~%" command) + (newline) + (pause) + #t)) + +;;; utils.scm ends here -- 2.26.2 --=-=-=--