branch master updated: Revert "installer: utils: Dump command output to syslog when testing."

[guix-commits]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 5f7c441  Revert "installer: utils: Dump command output to syslog when 
testing."
5f7c441 is described below

commit 5f7c4416b5afb95ece26bdb1d000e026387d002f
Author: Mathieu Othacehe <othacehe@gnu.org>
AuthorDate: Tue Jun 9 10:33:04 2020 +0200

    Revert "installer: utils: Dump command output to syslog when testing."
    
    This reverts commit f73ed5579157a074093bae7a2ffb59a85412be0d. This was 
pushed
    by error, as this is not reviewed yet.
---
 gnu/installer/utils.scm | 164 +++++++++++++-----------------------------------
 1 file changed, 44 insertions(+), 120 deletions(-)

diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index d73698d..5f8fe8c 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -22,13 +22,8 @@
   #: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)
@@ -73,6 +68,50 @@ 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.
@@ -180,118 +219,3 @@ 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 (&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