unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: "Ludovic Courtès" <ludo@gnu.org>
To: 30498@debbugs.gnu.org
Subject: [bug#30498] [PATCH 2/3] Simplify 'make-shepherd-output-port'.
Date: Wed,  7 Mar 2018 12:04:53 +0100	[thread overview]
Message-ID: <20180307110454.17110-3-ludo@gnu.org> (raw)
In-Reply-To: <20180307110454.17110-1-ludo@gnu.org>

* modules/shepherd/comm.scm (%not-newline): New variable.
(make-shepherd-output-port): Rewrite second method to simplify and make
a single 'display' call per line.
---
 modules/shepherd/comm.scm | 36 ++++++++++++++++--------------------
 1 file changed, 16 insertions(+), 20 deletions(-)

diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 596a258..e686bfa 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -216,6 +216,9 @@ on service '~a':")
   ;; 'strftime' format strings for entries in the log file.
   (make-parameter default-logfile-date-format))
 
+(define %not-newline
+  (char-set-complement (char-set #\newline)))
+
 ;; We provide our own output mechanism, because we have certain
 ;; special needs; most importantly, we want to send output to herd
 ;; sometimes.
@@ -242,26 +245,19 @@ on service '~a':")
         ;; completed line.
         (if (not (string-index str #\newline))
             (set! buffer (cons str buffer))
-            (let* ((log (lambda (x)
-                          (display x (log-output-port))))
-                   (init-line (lambda ()
-                                (log (strftime (%current-logfile-date-format)
-                                               (localtime (current-time)))))))
-              (init-line)
-              (for-each log (reverse buffer))
-              (let* ((lines (string-split str #\newline))
-                     (last-line (car (take-right lines 1)))
-                     (is-first #t))
-                (for-each (lambda (line)
-                            (if is-first
-                                (set! is-first #f)
-                                (init-line))
-                            (log line)
-                            (log #\newline))
-                          (drop-right lines 1))
-                (set! buffer (if (string-null? last-line)
-                                 '()
-                                 (list last-line))))))))
+            (let* ((str   (string-concatenate-reverse (cons str buffer)))
+                   (lines (string-tokenize str %not-newline)))
+              (define prefix
+                (strftime (%current-logfile-date-format)
+                          (localtime (current-time))))
+
+              ;; Make exactly one 'display' call per line to make sure we
+              ;; don't create several entries for each line.
+              (for-each (lambda (line)
+                          (display (string-append prefix line "\n")
+                                   (log-output-port)))
+                        lines)
+              (set! buffer '())))))
 
     ;; Flush output.
     (lambda ()
-- 
2.16.2

  parent reply	other threads:[~2018-03-07 11:06 UTC|newest]

Thread overview: 20+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2018-02-17 12:20 [bug#30498] [PATCH shepherd] shepherd: If /dev/kmsg is writable, use it for logging Danny Milosavljevic
2018-02-17 12:25 ` Danny Milosavljevic
2018-02-17 16:48 ` [bug#30498] [WIP v2 " Danny Milosavljevic
2018-02-17 16:49   ` Danny Milosavljevic
2018-02-26 18:04   ` Ludovic Courtès
2018-02-26 21:51     ` Danny Milosavljevic
2018-02-27  9:22       ` Ludovic Courtès
2018-02-26 22:32     ` Danny Milosavljevic
2018-02-27  9:19       ` Ludovic Courtès
2018-03-03 21:54         ` Ludovic Courtès
2018-03-03 22:37           ` Danny Milosavljevic
2018-03-05 16:51             ` Ludovic Courtès
2018-03-06  8:09               ` Danny Milosavljevic
2018-03-07 12:46                 ` Ludovic Courtès
2018-03-07 11:04               ` [bug#30498] [PATCH 0/3] Log to syslog whenever possible Ludovic Courtès
2018-03-07 11:04                 ` [bug#30498] [PATCH 1/3] Turn 'log-output-port' into a parameter Ludovic Courtès
2018-03-07 11:04                 ` Ludovic Courtès [this message]
2018-03-07 11:04                 ` [bug#30498] [PATCH 3/3] Use syslog for logging when running as root Ludovic Courtès
2018-03-07 15:25                 ` [bug#30498] [PATCH 0/3] Log to syslog whenever possible Ludovic Courtès
2018-03-15 17:00                 ` bug#30498: " 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=20180307110454.17110-3-ludo@gnu.org \
    --to=ludo@gnu.org \
    --cc=30498@debbugs.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).