From: Mathieu Othacehe <othacehe@gnu.org>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: 41668@debbugs.gnu.org, Brice Waegeneire <brice@waegenei.re>
Subject: bug#41668: Failing test: gui-installed-desktop-os-encrypted
Date: Tue, 09 Jun 2020 13:18:25 +0200 [thread overview]
Message-ID: <87v9k0o5by.fsf@gnu.org> (raw)
In-Reply-To: <878sgxbshs.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 08 Jun 2020 15:24:15 +0200")
[-- Attachment #1: Type: text/plain, Size: 261 bytes --]
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
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-installer-utils-Dump-command-output-to-syslog-when-t.patch --]
[-- Type: text/x-diff, Size: 7696 bytes --]
From 18754c8c62eabb341e0f710d83ff435ef950ca8e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
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))
-
\f
;;;
;;; Logging.
@@ -219,3 +180,118 @@ accepting socket."
(current-clients (reverse remainder))
exp)
+
+\f
+;;;
+;;; 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
next prev parent reply other threads:[~2020-06-09 11:19 UTC|newest]
Thread overview: 17+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-06-02 18:52 bug#41668: Failing test: gui-installed-desktop-os-encrypted Brice Waegeneire
2020-06-06 10:16 ` Mathieu Othacehe
2020-06-07 15:28 ` Mathieu Othacehe
2020-06-07 19:54 ` Ludovic Courtès
2020-06-08 8:47 ` Mathieu Othacehe
2020-06-08 13:24 ` Mathieu Othacehe
2020-06-09 11:18 ` Mathieu Othacehe [this message]
2020-06-09 14:22 ` Ludovic Courtès
2020-06-09 16:01 ` Mathieu Othacehe
2020-06-08 14:26 ` Danny Milosavljevic
2020-06-09 14:24 ` Ludovic Courtès
2020-06-14 16:16 ` Mathieu Othacehe
2020-06-14 20:28 ` Ludovic Courtès
2020-06-16 15:40 ` Mathieu Othacehe
2020-06-17 12:33 ` Ludovic Courtès
2020-09-11 7:32 ` Mathieu Othacehe
2020-09-11 14:42 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87v9k0o5by.fsf@gnu.org \
--to=othacehe@gnu.org \
--cc=41668@debbugs.gnu.org \
--cc=brice@waegenei.re \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.