unofficial mirror of bug-guix@gnu.org 
 help / color / mirror / code / Atom feed
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: Mon, 08 Jun 2020 15:24:15 +0200	[thread overview]
Message-ID: <878sgxbshs.fsf@gnu.org> (raw)
In-Reply-To: <87zh9eaqq9.fsf@gnu.org> (Mathieu Othacehe's message of "Mon, 08 Jun 2020 10:47:42 +0200")

[-- Attachment #1: Type: text/plain, Size: 249 bytes --]


Hey,

Turns out using "invoke/quiet" is not really convenient because it
stores all the command output, which can be pretty big, in memory.

Instead I did reimplement the command in (gnu installer utils) in the
attached patch :).

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: 7779 bytes --]

From 7c1a03b03d5e62876a88d87aff36776c8ce4ddf2 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 | 166 +++++++++++++++++++++++++++++-----------
 1 file changed, 122 insertions(+), 44 deletions(-)

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 5f8fe8ca01..b9d88e46d9 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,120 @@ 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)
+              (let-syntax ((G_ (syntax-rules ()   ;for xgettext
+                                 ((_ str) str))))
+                (raise (condition
+                        (&message
+                         (message (format #f (G_ "'~a~{ ~a~}' exited \
+with status ~a.")
+                                          program args
+                                          (or (status:exit-val status)
+                                              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


  reply	other threads:[~2020-06-08 13:25 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 [this message]
2020-06-09 11:18           ` Mathieu Othacehe
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

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=878sgxbshs.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 public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).