[bug#30498] [PATCH shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[bug#30498] [PATCH shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

* modules/shepherd.scm (main): If /dev/kmsg is used, don't log to console
again - use only /dev/kmsg.
* modules/shepherd/comm.scm (%current-logfile-date-format): New variable.
(make-shepherd-output-port): Use it.  Export.
* modules/shepherd/support.scm (default-logfile-date-format): New variable.
(default-logfile): Use /dev/kmsg if writable.
(default-logfile-date-format): Drop duplicate timestamp.
---
 modules/shepherd.scm         |  6 +++++-
 modules/shepherd/comm.scm    | 11 ++++++-----
 modules/shepherd/support.scm | 11 ++++++++++-
 3 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5334657..2db56a1 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -141,8 +141,12 @@
     ;; Enable logging as first action.
     (start-logging logfile)
 
+    (if (string=? logfile "/dev/kmsg")
+        ;; Prevent duplicate messages.
+        (set-current-output-port (%make-void-port "w")))
+
     ;; Send output to log and clients.
-    (set-current-output-port shepherd-output-port)
+    (set-current-output-port (make-shepherd-output-port (current-output-port)))
 
     ;; Start the 'root' service.
     (start root-service)
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 0228f63..6cea6f0 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -51,7 +51,8 @@
             start-logging
             stop-logging
             %current-client-socket
-            shepherd-output-port))
+            %current-logfile-date-format
+            make-shepherd-output-port))
 
 \f
 ;; Command for shepherd.
@@ -200,6 +201,9 @@ on service '~a':")
   ;; Socket of the client currently talking to the daemon.
   (make-parameter #f))
 
+(define %current-logfile-date-format
+  (make-parameter default-logfile-date-format))
+
 ;; We provide our own output mechanism, because we have certain
 ;; special needs; most importantly, we want to send output to herd
 ;; sometimes.
@@ -228,7 +232,7 @@ on service '~a':")
             (let* ((log (lambda (x)
                           (display x log-output-port)))
                    (init-line (lambda ()
-                                (log (strftime "%Y-%m-%d %H:%M:%S "
+                                (log (strftime (%current-logfile-date-format)
                                                (localtime (current-time)))))))
               (init-line)
               (for-each log (reverse buffer))
@@ -259,6 +263,3 @@ on service '~a':")
 
    ;; It's an output-only port.
    "w"))
-
-(define shepherd-output-port
-  (make-shepherd-output-port (current-output-port)))
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index bb01edc..585aef9 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -22,6 +22,7 @@
 (define-module (shepherd support)
   #:use-module (shepherd config)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:export (call/ec
             caught-error
             assert
@@ -43,6 +44,7 @@
 
             user-homedir
             default-logfile
+            default-logfile-date-format
             default-config-file
             default-socket-dir
             default-socket-file
@@ -282,9 +284,16 @@ TARGET should be a string representing a filepath + name."
 ;; Logfile.
 (define default-logfile
   (if (zero? (getuid))
-      (string-append %localstatedir "/log/shepherd.log")
+      (if (access? "/dev/kmsg" W_OK)
+          "/dev/kmsg"
+          (string-append %localstatedir "/log/shepherd.log"))
       (string-append %user-config-dir "/shepherd.log")))
 
+(define default-logfile-date-format
+   (if (and (zero? (getuid)) (string=? default-logfile "/dev/kmsg"))
+       (format #f "shepherd[~d]: " (getpid))
+       "%Y-%m-%d %H:%M:%S "))
+
 ;; Configuration file.
 (define (default-config-file)
   "Return the default configuration file---either the user's file, or the

[bug#30498] [PATCH shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

It's nice to be able to correlate all the stuff that happens at startup now:

Now you can actually see the communication between the processes sometimes :)

Example output:

$ dmesg
...
[    2.893529] usb 1-6: Manufacturer: Chicony Electronics Co., Ltd.
[    3.056972] shepherd[1]: Service root has been started.
[    3.456744] shepherd[1]: starting services...
[    3.457110] shepherd[1]: Service root-file-system has been started.
[    3.466479] shepherd[1]: waiting for udevd...
[    3.522308] udevd[186]: starting version 3.2.2
[    3.574506] udevd[186]: starting eudev-3.2.2
[    3.967420] udevd[186]: no sender credentials received, message ignored
[    4.030350] Non-volatile memory driver v1.3
[    4.059448] thinkpad_acpi: ThinkPad ACPI Extras v0.25
...
[    5.298348] ath9k_htc 2-2:1.0 wlp0s29f7u2: renamed from wlan0
[    5.381098] fbcon: inteldrmfb (fb0) is primary device
[    5.938603] Console: switching to colour frame buffer device 160x50
[    5.958004] i915 0000:00:02.0: fb0: inteldrmfb frame buffer device
[    5.993028] shepherd[1]: Service udev has been started.
[   10.953719] Btrfs loaded, crc32c=crc32c-generic
[   10.955704] BTRFS: device label dayas-home devid 1 transid 260833 /dev/dm-0
[   10.983703] shepherd[1]: Service device-mapping-dayas-home has been started.
[   10.984000] shepherd[1]: Service user-file-systems has been started.
[   11.049660] BTRFS info (device dm-0): disk space caching is enabled
[   11.049663] BTRFS info (device dm-0): has skinny extents
[   11.219716] BTRFS info (device dm-0): enabling ssd optimizations
[   11.236633] shepherd[1]: Service file-system-/home has been started.
[   11.237366] shepherd[1]: Service file-system-/dev/pts has been started.
[   11.237997] shepherd[1]: Service file-system-/dev/shm has been started.
[   11.238568] shepherd[1]: Service file-system-/gnu/store has been started.
[   11.239180] shepherd[1]: Service file-system-/run/systemd has been started.
[   11.239839] shepherd[1]: Service file-system-/run/user has been started.
[   11.240465] shepherd[1]: Service file-system-/sys/fs/cgroup has been started.
[   11.241261] shepherd[1]: Service file-system-/sys/fs/cgroup/elogind has been started.
[   16.538532] shepherd[1]: Respawning thermald.
...
[   21.862151] IPv6: ADDRCONF(NETDEV_CHANGE): wlp0s29f7u2: link becomes ready
[  345.176995] shepherd[1]: Respawning xorg-server.
[  345.178541] shepherd[1]: Service xorg-server has been started.
[  764.782498] perf: interrupt took too long (2526 > 2500), lowering kernel.perf_event_max_sample_rate to 79000

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

* modules/shepherd.scm (main): If /dev/kmsg is used, don't log to console
again - use only /dev/kmsg.  Also redirect stderr to /dev/kmsg in
that case.
* modules/shepherd/comm.scm (%current-logfile-date-format): New variable.
(make-shepherd-output-port): Use it.  Export.
* modules/shepherd/support.scm (default-logfile-date-format): New variable.
(default-logfile): Use /dev/kmsg if writable.
(default-logfile-date-format): Drop duplicate timestamp.
---
 modules/shepherd.scm         | 10 +++++++++-
 modules/shepherd/comm.scm    | 20 ++++++++++++--------
 modules/shepherd/support.scm | 11 ++++++++++-
 3 files changed, 31 insertions(+), 10 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5334657..2893143 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -141,12 +141,20 @@
     ;; Enable logging as first action.
     (start-logging logfile)
 
+    (if (string=? logfile "/dev/kmsg")
+        ;; Prevent duplicate messages.
+        (set-current-output-port (%make-void-port "w")))
+
     ;; Send output to log and clients.
-    (set-current-output-port shepherd-output-port)
+    (set-current-output-port
+     (make-shepherd-output-port (current-output-port)))
 
     ;; Start the 'root' service.
     (start root-service)
 
+    (set-current-error-port
+     (make-shepherd-output-port (current-error-port) (const #f)))
+
     ;; This _must_ succeed.  (We could also put the `catch' around
     ;; `main', but it is often useful to get the backtrace, and
     ;; `caught-error' does not do this yet.)
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 0228f63..dc7d740 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -51,7 +51,8 @@
             start-logging
             stop-logging
             %current-client-socket
-            shepherd-output-port))
+            %current-logfile-date-format
+            make-shepherd-output-port))
 
 \f
 ;; Command for shepherd.
@@ -200,10 +201,16 @@ on service '~a':")
   ;; Socket of the client currently talking to the daemon.
   (make-parameter #f))
 
+(define %current-logfile-date-format
+  (make-parameter default-logfile-date-format))
+
 ;; We provide our own output mechanism, because we have certain
 ;; special needs; most importantly, we want to send output to herd
 ;; sometimes.
-(define (make-shepherd-output-port original-output-port)
+(define* (make-shepherd-output-port original-output-port
+                                   #:optional
+                                   (current-client-socket-thunk
+                                    %current-client-socket))
   (make-soft-port
    (vector
 
@@ -216,9 +223,9 @@ on service '~a':")
       (lambda (str)
         ;; When herd is connected, send it the output; otherwise, in the
         ;; unlikely case nobody is listening, send to the standard output.
-        (if (%current-client-socket)
+        (if (current-client-socket-thunk)
             (catch-system-error
-             (display str (%current-client-socket)))
+             (display str (current-client-socket-thunk)))
             (display str original-output-port))
 
         ;; Logfile, buffer line-wise and output time for each
@@ -228,7 +235,7 @@ on service '~a':")
             (let* ((log (lambda (x)
                           (display x log-output-port)))
                    (init-line (lambda ()
-                                (log (strftime "%Y-%m-%d %H:%M:%S "
+                                (log (strftime (%current-logfile-date-format)
                                                (localtime (current-time)))))))
               (init-line)
               (for-each log (reverse buffer))
@@ -259,6 +266,3 @@ on service '~a':")
 
    ;; It's an output-only port.
    "w"))
-
-(define shepherd-output-port
-  (make-shepherd-output-port (current-output-port)))
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index bb01edc..585aef9 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -22,6 +22,7 @@
 (define-module (shepherd support)
   #:use-module (shepherd config)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:export (call/ec
             caught-error
             assert
@@ -43,6 +44,7 @@
 
             user-homedir
             default-logfile
+            default-logfile-date-format
             default-config-file
             default-socket-dir
             default-socket-file
@@ -282,9 +284,16 @@ TARGET should be a string representing a filepath + name."
 ;; Logfile.
 (define default-logfile
   (if (zero? (getuid))
-      (string-append %localstatedir "/log/shepherd.log")
+      (if (access? "/dev/kmsg" W_OK)
+          "/dev/kmsg"
+          (string-append %localstatedir "/log/shepherd.log"))
       (string-append %user-config-dir "/shepherd.log")))
 
+(define default-logfile-date-format
+   (if (and (zero? (getuid)) (string=? default-logfile "/dev/kmsg"))
+       (format #f "shepherd[~d]: " (getpid))
+       "%Y-%m-%d %H:%M:%S "))
+
 ;; Configuration file.
 (define (default-config-file)
   "Return the default configuration file---either the user's file, or the

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

(WIP because the cryptsetup passphrase entry prompt is now invisible.  Oops?
Works if one blindly enters it, though)

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Ludovic Courtès]

Hi!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> * modules/shepherd.scm (main): If /dev/kmsg is used, don't log to console
> again - use only /dev/kmsg.  Also redirect stderr to /dev/kmsg in
> that case.
> * modules/shepherd/comm.scm (%current-logfile-date-format): New variable.
> (make-shepherd-output-port): Use it.  Export.
> * modules/shepherd/support.scm (default-logfile-date-format): New variable.
> (default-logfile): Use /dev/kmsg if writable.
> (default-logfile-date-format): Drop duplicate timestamp.

[...]

> --- a/modules/shepherd.scm
> +++ b/modules/shepherd.scm
> @@ -141,12 +141,20 @@
>      ;; Enable logging as first action.
>      (start-logging logfile)
>  
> +    (if (string=? logfile "/dev/kmsg")
> +        ;; Prevent duplicate messages.
> +        (set-current-output-port (%make-void-port "w")))

Nitpick: I’d use ‘when’ here since there’s no ‘else’ branch.

> +(define %current-logfile-date-format
> +  (make-parameter default-logfile-date-format))

Please add a one-line comment explaining what the format is.

Could you also add a couple of lines in the .texi file explaining that
/dev/kmsg is used when it’s available and we’re running as root?

As for cryptsetup, what if the service that runs crypsetup simply
parameterizes ‘log-output-port’ to /dev/console?  That would give us the
current behavior, right?

Apart from that it LGTM, thank you!

Ludo’.

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

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

Hi Ludo,

thanks for the review!  Does that mean that I should push to shepherd?

If not, new patch attached :)

[-- Attachment #2: 0001-shepherd-If-dev-kmsg-is-writable-use-it-for-logging.patch --]
[-- Type: text/x-patch, Size: 5980 bytes --]

From 40426570679e83fff25eadbcc20476ebc321740f Mon Sep 17 00:00:00 2001
From: Danny Milosavljevic <dannym@scratchpost.org>
Date: Sat, 17 Feb 2018 17:44:34 +0100
Subject: [PATCH v2] shepherd: If /dev/kmsg is writable, use it for logging.
Tags: patch

* modules/shepherd.scm (main): If /dev/kmsg is used, don't log to console
again - use only /dev/kmsg.  Also redirect stderr to /dev/kmsg in
that case.
* modules/shepherd/comm.scm (%current-logfile-date-format): New variable.
(make-shepherd-output-port): Use it.  Export.
* modules/shepherd/support.scm (default-logfile-date-format): New variable.
(default-logfile): Use /dev/kmsg if writable.
(default-logfile-date-format): Drop duplicate timestamp.
* doc/shepherd.texi (logging): Document /dev/kmsg.
---
 doc/shepherd.texi            |  3 ++-
 modules/shepherd.scm         | 11 ++++++++++-
 modules/shepherd/comm.scm    | 22 ++++++++++++++--------
 modules/shepherd/support.scm | 11 ++++++++++-
 4 files changed, 36 insertions(+), 11 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 810336c..3c02d92 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -405,7 +405,8 @@ permissions are not as expected.
 @cindex logging
 @cindex log file
 Log output into @var{file}, or if @var{file} is not given,
-@code{/var/log/shepherd.log} when running as superuser,
+@code{/dev/kmsg} when running as superuser (except when this is not possible --
+then it uses @code{/var/log/shepherd.log}),
 @code{$XDG_CONFIG_HOME/shepherd/shepherd.log} otherwise.
 
 @item --pid[=@var{file}]
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5334657..6acd41e 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -141,8 +141,17 @@
     ;; Enable logging as first action.
     (start-logging logfile)
 
+    (when (string=? logfile "/dev/kmsg")
+      ;; Prevent duplicate messages.
+      (set-current-output-port (%make-void-port "w")))
+
     ;; Send output to log and clients.
-    (set-current-output-port shepherd-output-port)
+    (set-current-output-port
+     (make-shepherd-output-port (current-output-port)))
+
+    ;; Send errors to log.
+    (set-current-error-port
+     (make-shepherd-output-port (current-error-port) (const #f)))
 
     ;; Start the 'root' service.
     (start root-service)
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 0228f63..99b8d04 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -51,7 +51,8 @@
             start-logging
             stop-logging
             %current-client-socket
-            shepherd-output-port))
+            %current-logfile-date-format
+            make-shepherd-output-port))
 
 \f
 ;; Command for shepherd.
@@ -200,10 +201,18 @@ on service '~a':")
   ;; Socket of the client currently talking to the daemon.
   (make-parameter #f))
 
+;; Every entry in the logfile is prefixed with
+;; (strftime %current-logfile-date-format).
+(define %current-logfile-date-format
+  (make-parameter default-logfile-date-format))
+
 ;; We provide our own output mechanism, because we have certain
 ;; special needs; most importantly, we want to send output to herd
 ;; sometimes.
-(define (make-shepherd-output-port original-output-port)
+(define* (make-shepherd-output-port original-output-port
+                                   #:optional
+                                   (current-client-socket-thunk
+                                    %current-client-socket))
   (make-soft-port
    (vector
 
@@ -216,9 +225,9 @@ on service '~a':")
       (lambda (str)
         ;; When herd is connected, send it the output; otherwise, in the
         ;; unlikely case nobody is listening, send to the standard output.
-        (if (%current-client-socket)
+        (if (current-client-socket-thunk)
             (catch-system-error
-             (display str (%current-client-socket)))
+             (display str (current-client-socket-thunk)))
             (display str original-output-port))
 
         ;; Logfile, buffer line-wise and output time for each
@@ -228,7 +237,7 @@ on service '~a':")
             (let* ((log (lambda (x)
                           (display x log-output-port)))
                    (init-line (lambda ()
-                                (log (strftime "%Y-%m-%d %H:%M:%S "
+                                (log (strftime (%current-logfile-date-format)
                                                (localtime (current-time)))))))
               (init-line)
               (for-each log (reverse buffer))
@@ -259,6 +268,3 @@ on service '~a':")
 
    ;; It's an output-only port.
    "w"))
-
-(define shepherd-output-port
-  (make-shepherd-output-port (current-output-port)))
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index bb01edc..585aef9 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -22,6 +22,7 @@
 (define-module (shepherd support)
   #:use-module (shepherd config)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:export (call/ec
             caught-error
             assert
@@ -43,6 +44,7 @@
 
             user-homedir
             default-logfile
+            default-logfile-date-format
             default-config-file
             default-socket-dir
             default-socket-file
@@ -282,9 +284,16 @@ TARGET should be a string representing a filepath + name."
 ;; Logfile.
 (define default-logfile
   (if (zero? (getuid))
-      (string-append %localstatedir "/log/shepherd.log")
+      (if (access? "/dev/kmsg" W_OK)
+          "/dev/kmsg"
+          (string-append %localstatedir "/log/shepherd.log"))
       (string-append %user-config-dir "/shepherd.log")))
 
+(define default-logfile-date-format
+   (if (and (zero? (getuid)) (string=? default-logfile "/dev/kmsg"))
+       (format #f "shepherd[~d]: " (getpid))
+       "%Y-%m-%d %H:%M:%S "))
+
 ;; Configuration file.
 (define (default-config-file)
   "Return the default configuration file---either the user's file, or the

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Ludovic Courtès]

Hi!

Danny Milosavljevic <dannym@scratchpost.org> skribis:

> From 40426570679e83fff25eadbcc20476ebc321740f Mon Sep 17 00:00:00 2001
> From: Danny Milosavljevic <dannym@scratchpost.org>
> Date: Sat, 17 Feb 2018 17:44:34 +0100
> Subject: [PATCH v2] shepherd: If /dev/kmsg is writable, use it for logging.
> Tags: patch
>
> * modules/shepherd.scm (main): If /dev/kmsg is used, don't log to console
> again - use only /dev/kmsg.  Also redirect stderr to /dev/kmsg in
> that case.
> * modules/shepherd/comm.scm (%current-logfile-date-format): New variable.
> (make-shepherd-output-port): Use it.  Export.
> * modules/shepherd/support.scm (default-logfile-date-format): New variable.
> (default-logfile): Use /dev/kmsg if writable.
> (default-logfile-date-format): Drop duplicate timestamp.
> * doc/shepherd.texi (logging): Document /dev/kmsg.
                       ^
“Logging”.

> --- a/doc/shepherd.texi
> +++ b/doc/shepherd.texi
> @@ -405,7 +405,8 @@ permissions are not as expected.
>  @cindex logging
>  @cindex log file
>  Log output into @var{file}, or if @var{file} is not given,
> -@code{/var/log/shepherd.log} when running as superuser,
> +@code{/dev/kmsg} when running as superuser (except when this is not possible --
> +then it uses @code{/var/log/shepherd.log}),

Nitpick: it should be three hyphens without surrounding spaces, leading
to an em dash, “like---this”.

Let’s just make sure we have a solution for cryptsetup and then you’re
welcome to push it to shepherd.git!

Thank you,
Ludo’.

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

Hi Ludo,

> As for cryptsetup, what if the service that runs crypsetup simply
> parameterizes ‘log-output-port’ to /dev/console?  That would give us the
> current behavior, right?

I don't understand why this current-output-port stuff is somehow passed on to
forked processes in the first place (why does cryptsetup care what I do
to guile variables?).

scheme@(guile-user)> (current-output-port (%make-void-port "w"))
scheme@(guile-user)> (system* "ls" "/")
scheme@(guile-user)>

WTF?

It wasn't my intention to inherit them as file descriptors... also, for guile
buffering ports, how does it inherit those as file descriptors?  Will it still
do the custom line buffering that shepherd does, also when a child process
writes there?

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Ludovic Courtès]

Hi Danny,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> As for cryptsetup, what if the service that runs crypsetup simply
>> parameterizes ‘log-output-port’ to /dev/console?  That would give us the
>> current behavior, right?
>
> I don't understand why this current-output-port stuff is somehow passed on to
> forked processes in the first place (why does cryptsetup care what I do
> to guile variables?).
>
> scheme@(guile-user)> (current-output-port (%make-void-port "w"))
> scheme@(guile-user)> (system* "ls" "/")
> scheme@(guile-user)>

Funny no?  :-)

This is in libguile/posix.c, ‘scm_open_process’ and ‘start_child’: when
the current input/output/error port isn’t a file port, FDs 0/1/2 in the
child are made to point to /dev/null.  Otherwise, they are inherited as
file descriptors.

For cryptsetup, this should be what we want if we do:

  (call-with-output-file "/dev/console"
    (lambda (port)
      (parameterize ((log-output-port port)
                     (current-input-port port)
                     (current-error-port port))
        (invoke "cryptsetup" …))))

Or do we even need to care about ‘log-output-port’?  Thoughts?

> It wasn't my intention to inherit them as file descriptors... also, for guile
> buffering ports, how does it inherit those as file descriptors?  Will it still
> do the custom line buffering that shepherd does, also when a child process
> writes there?

Shepherd does not process the stdout/err of child processes in any way,
so there shouldn’t be buffering there.

Ludo’.

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Ludovic Courtès]

Hey Danny,

Looks like we’ve accumulated stuff that justifies a new Shepherd release
this time.  It’d be nice if we could get this patch in as well!  What
are we missing?

Ludo’.

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

[-- Attachment #1.1: Type: text/plain, Size: 2939 bytes --]

I think that just something like this is missing:

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 83600e4..481203d 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -728,20 +728,37 @@ false."
        ;; it for something unrelated, which can confuse some packages.
        (dup2 (open-fdes "/dev/null" O_RDONLY) 0)
 
-       (when log-file
-         (catch #t
-           (lambda ()
-             ;; Redirect stout and stderr to use LOG-FILE.
-             (catch-system-error (close-fdes 1))
-             (catch-system-error (close-fdes 2))
-             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 1)
-             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 2))
-           (lambda (key . args)
-             (format (current-error-port)
-                     "failed to open log-file ~s:~%" log-file)
-             (print-exception (current-error-port) #f key args)
-             (primitive-exit 1))))
-
+       (if log-file
+           (catch #t
+             (lambda ()
+               ;; Redirect stout and stderr to use LOG-FILE.
+               (catch-system-error (close-fdes 1))
+               (catch-system-error (close-fdes 2))
+               (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 1)
+               (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 2))
+             (lambda (key . args)
+               (format (current-error-port)
+                       "failed to open log-file ~s:~%" log-file)
+               (print-exception (current-error-port) #f key args)
+               (primitive-exit 1)))
+           (catch #t
+             (lambda ()
+               ;; Make sure the child has stdout/stderr that can be used.
+               ;; We sometimes set current-error-port to a softport.
+               ;; libguile would then autoconnect /dev/null -
+               ;; which we don't want.
+               ;; Also, cryptsetup interactively asks for a password,
+               ;; so we don't want /dev/kmsg either.
+               ;; In a user shepherd all this is not necessary -
+               ;; but then, port->fdes will not fail.
+               (when (not (false-if-exception (port->fdes (current-output-port))))
+                 (dup2 (open-fdes "/dev/console" (logior O_WRONLY)) 1))
+               (when (not (false-if-exception (port->fdes (current-error-port))))
+                 (dup2 (open-fdes "/dev/console" (logior O_WRONLY)) 2)))
+             (lambda (key . args)
+               (format (current-error-port) "failed to open stdout/stderr\n")
+               (print-exception (current-error-port) #f key args)
+               (primitive-exit 1))))
        (let loop ((i 3))
          (when (< i max-fd)
            ;; First try to close any ports associated with file descriptor I.

Patch starting from master attached for convenience.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: shepherd-klog.patch --]
[-- Type: text/x-patch, Size: 7946 bytes --]

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 810336c..88b39e3 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -405,7 +405,7 @@ permissions are not as expected.
 @cindex logging
 @cindex log file
 Log output into @var{file}, or if @var{file} is not given,
-@code{/var/log/shepherd.log} when running as superuser,
+@code{/dev/kmsg} when running as superuser (except when this is not possible---then it uses @code{/var/log/shepherd.log}),
 @code{$XDG_CONFIG_HOME/shepherd/shepherd.log} otherwise.
 
 @item --pid[=@var{file}]
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 5334657..6acd41e 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -141,8 +141,17 @@
     ;; Enable logging as first action.
     (start-logging logfile)
 
+    (when (string=? logfile "/dev/kmsg")
+      ;; Prevent duplicate messages.
+      (set-current-output-port (%make-void-port "w")))
+
     ;; Send output to log and clients.
-    (set-current-output-port shepherd-output-port)
+    (set-current-output-port
+     (make-shepherd-output-port (current-output-port)))
+
+    ;; Send errors to log.
+    (set-current-error-port
+     (make-shepherd-output-port (current-error-port) (const #f)))
 
     ;; Start the 'root' service.
     (start root-service)
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 0228f63..99b8d04 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -51,7 +51,8 @@
             start-logging
             stop-logging
             %current-client-socket
-            shepherd-output-port))
+            %current-logfile-date-format
+            make-shepherd-output-port))
 
 \f
 ;; Command for shepherd.
@@ -200,10 +201,18 @@ on service '~a':")
   ;; Socket of the client currently talking to the daemon.
   (make-parameter #f))
 
+;; Every entry in the logfile is prefixed with
+;; (strftime %current-logfile-date-format).
+(define %current-logfile-date-format
+  (make-parameter default-logfile-date-format))
+
 ;; We provide our own output mechanism, because we have certain
 ;; special needs; most importantly, we want to send output to herd
 ;; sometimes.
-(define (make-shepherd-output-port original-output-port)
+(define* (make-shepherd-output-port original-output-port
+                                   #:optional
+                                   (current-client-socket-thunk
+                                    %current-client-socket))
   (make-soft-port
    (vector
 
@@ -216,9 +225,9 @@ on service '~a':")
       (lambda (str)
         ;; When herd is connected, send it the output; otherwise, in the
         ;; unlikely case nobody is listening, send to the standard output.
-        (if (%current-client-socket)
+        (if (current-client-socket-thunk)
             (catch-system-error
-             (display str (%current-client-socket)))
+             (display str (current-client-socket-thunk)))
             (display str original-output-port))
 
         ;; Logfile, buffer line-wise and output time for each
@@ -228,7 +237,7 @@ on service '~a':")
             (let* ((log (lambda (x)
                           (display x log-output-port)))
                    (init-line (lambda ()
-                                (log (strftime "%Y-%m-%d %H:%M:%S "
+                                (log (strftime (%current-logfile-date-format)
                                                (localtime (current-time)))))))
               (init-line)
               (for-each log (reverse buffer))
@@ -259,6 +268,3 @@ on service '~a':")
 
    ;; It's an output-only port.
    "w"))
-
-(define shepherd-output-port
-  (make-shepherd-output-port (current-output-port)))
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 83600e4..481203d 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -728,20 +728,37 @@ false."
        ;; it for something unrelated, which can confuse some packages.
        (dup2 (open-fdes "/dev/null" O_RDONLY) 0)
 
-       (when log-file
-         (catch #t
-           (lambda ()
-             ;; Redirect stout and stderr to use LOG-FILE.
-             (catch-system-error (close-fdes 1))
-             (catch-system-error (close-fdes 2))
-             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 1)
-             (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 2))
-           (lambda (key . args)
-             (format (current-error-port)
-                     "failed to open log-file ~s:~%" log-file)
-             (print-exception (current-error-port) #f key args)
-             (primitive-exit 1))))
-
+       (if log-file
+           (catch #t
+             (lambda ()
+               ;; Redirect stout and stderr to use LOG-FILE.
+               (catch-system-error (close-fdes 1))
+               (catch-system-error (close-fdes 2))
+               (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 1)
+               (dup2 (open-fdes log-file (logior O_CREAT O_WRONLY)) 2))
+             (lambda (key . args)
+               (format (current-error-port)
+                       "failed to open log-file ~s:~%" log-file)
+               (print-exception (current-error-port) #f key args)
+               (primitive-exit 1)))
+           (catch #t
+             (lambda ()
+               ;; Make sure the child has stdout/stderr that can be used.
+               ;; We sometimes set current-error-port to a softport.
+               ;; libguile would then autoconnect /dev/null -
+               ;; which we don't want.
+               ;; Also, cryptsetup interactively asks for a password,
+               ;; so we don't want /dev/kmsg either.
+               ;; In a user shepherd all this is not necessary -
+               ;; but then, port->fdes will not fail.
+               (when (not (false-if-exception (port->fdes (current-output-port))))
+                 (dup2 (open-fdes "/dev/console" (logior O_WRONLY)) 1))
+               (when (not (false-if-exception (port->fdes (current-error-port))))
+                 (dup2 (open-fdes "/dev/console" (logior O_WRONLY)) 2)))
+             (lambda (key . args)
+               (format (current-error-port) "failed to open stdout/stderr\n")
+               (print-exception (current-error-port) #f key args)
+               (primitive-exit 1))))
        (let loop ((i 3))
          (when (< i max-fd)
            ;; First try to close any ports associated with file descriptor I.
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index bb01edc..585aef9 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -22,6 +22,7 @@
 (define-module (shepherd support)
   #:use-module (shepherd config)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:export (call/ec
             caught-error
             assert
@@ -43,6 +44,7 @@
 
             user-homedir
             default-logfile
+            default-logfile-date-format
             default-config-file
             default-socket-dir
             default-socket-file
@@ -282,9 +284,16 @@ TARGET should be a string representing a filepath + name."
 ;; Logfile.
 (define default-logfile
   (if (zero? (getuid))
-      (string-append %localstatedir "/log/shepherd.log")
+      (if (access? "/dev/kmsg" W_OK)
+          "/dev/kmsg"
+          (string-append %localstatedir "/log/shepherd.log"))
       (string-append %user-config-dir "/shepherd.log")))
 
+(define default-logfile-date-format
+   (if (and (zero? (getuid)) (string=? default-logfile "/dev/kmsg"))
+       (format #f "shepherd[~d]: " (getpid))
+       "%Y-%m-%d %H:%M:%S "))
+
 ;; Configuration file.
 (define (default-config-file)
   "Return the default configuration file---either the user's file, or the

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Ludovic Courtès]

Heya,

I took the liberty to split this in several patches, which I think makes
it easier to follow.  I omitted the bits about redirecting stderr, for
now, to simplify things.

I tested it in a GuixSD VM and it works as advertised!  \o/

There’s one thing we need to improve though: syslogd reads /proc/kmsg
and prefixes everything that comes from there with “vmunix” (as if it
came from the kernel).  That’s inconvenient because it makes it
impossible to have syslogd rules to filter shepherd messages.

So I think we need to do instead use a ‘syslog’-style interface and,
similar to what ‘syslog’ does in glibc, write to /dev/log unless it’s
unavailable, in which case we fall back to /dev/kmsg.

Thoughts?

I’ll see if I can give it a try.

Thanks,
Ludo’.

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Danny Milosavljevic]

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

Hi,

On Mon, 05 Mar 2018 17:51:44 +0100
ludo@gnu.org (Ludovic Courtès) wrote:
> I tested it in a GuixSD VM and it works as advertised!  \o/

Yay!

> There’s one thing we need to improve though: syslogd reads /proc/kmsg
> and prefixes everything that comes from there with “vmunix” (as if it
> came from the kernel).  

Also, apparently syslogd uses the timestamp of "when it read the messages
out of /dev/kmsg" as syslog entry timestamp *although* /dev/kmsg contains its
own timestamps (as offsets-from-bootup).  Hrmmm...

>That’s inconvenient because it makes it
> impossible to have syslogd rules to filter shepherd messages.

I've added a shepherd "prefix" in the shepherd messages, so it should
end up as "vmunix: shepherd[1]: ..." (or so).

The somewhat heavyhanded way to fix it would be to replace

  strcpy (line, "vmunix: ");

by

  strcpy (line, "");

in inetutils-1.9.4/src/syslogd.c .  Or use another syslogd :)

According to the Linux kernel documentation the /dev/kmsg ring buffer is
specifically allowed to be used by user processes (although they must not
impersonate the kernel - if they try, the specified priority is ignored),
so we're in the clear there.

> So I think we need to do instead use a ‘syslog’-style interface and,
> similar to what ‘syslog’ does in glibc, write to /dev/log unless it’s
> unavailable, in which case we fall back to /dev/kmsg.

Yes, in the long run, we should do that.  I think for this shepherd
release it would be fine to use only /dev/kmsg - it's still an
improvement - and the risk that we introduced a new bug by this is
basically nonexistent.

Later on, we should use /dev/log and fall back to /dev/kmsg and
then again use /dev/log as it gets available etc.  I'm not sure
how to do the synchronisation (from shepherd's point of view,
syslogd asynchronously reads from /dev/kmsg and puts the messages
into its output files - so if we write to /dev/kmsg, then to
/dev/log, then to /dev/kmsg, then to /dev/log, is the message order
guaranteed?)

>I’ll see if I can give it a try.

Thanks :)

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]

[bug#30498] [WIP v2 shepherd] shepherd: If /dev/kmsg is writable, use it for logging.

[Ludovic Courtès]

Hello,

Danny Milosavljevic <dannym@scratchpost.org> skribis:

>> There’s one thing we need to improve though: syslogd reads /proc/kmsg
>> and prefixes everything that comes from there with “vmunix” (as if it
>> came from the kernel).  
>
> Also, apparently syslogd uses the timestamp of "when it read the messages
> out of /dev/kmsg" as syslog entry timestamp *although* /dev/kmsg contains its
> own timestamps (as offsets-from-bootup).  Hrmmm...

Yeah, we could teach Inetutils’s syslogd to interpret those timestamps,
although that’s a Linux-specific thing so care must be taken.

> According to the Linux kernel documentation the /dev/kmsg ring buffer is
> specifically allowed to be used by user processes (although they must not
> impersonate the kernel - if they try, the specified priority is ignored),
> so we're in the clear there.

Yeah but still.  From syslogd’s viewpoint, you can only assume that
these messages originate in the kernel.

> Later on, we should use /dev/log and fall back to /dev/kmsg and
> then again use /dev/log as it gets available etc.  I'm not sure
> how to do the synchronisation (from shepherd's point of view,
> syslogd asynchronously reads from /dev/kmsg and puts the messages
> into its output files - so if we write to /dev/kmsg, then to
> /dev/log, then to /dev/kmsg, then to /dev/log, is the message order
> guaranteed?)

syslogd will read a batch of messages from /dev/kmsg when it starts, so
the order is not really honored in this case.  I think that’s OK though,
because we don’t expect users to keep stopping/starting syslogd.   :-)

Thanks,
Ludo’.

[bug#30498] [PATCH 0/3] Log to syslog whenever possible

[Ludovic Courtès]

Hello!

These patches allow shepherd to use syslog, when /dev/log is reachable,
and to fall back to /dev/kmsg otherwise.

That leads to unified logging, which is nice.  By looking at
/var/log/messages one can see the sequence of events, which is often
more convenient than having to look at separate log files.  And we can
filter things via syslogd’s config.

However!  The downside is that messages upon shutdown written after
syslogd has been killed are lost: they go to /dev/kmsg, which goes to
the console at that point, but they’re not written anywhere.

Until now, everything until the root file system is unmounted (see
‘stop-logging’ call in (gnu services base)) would be written to
/var/log/shepherd.log, which is useful to debug shutdown (that’s how I
discovered the issue fixed by Guix commit
6c4458172d12dbda969c2eae5b3b6be19a068780, for instance.)

So, I don’t know.  Can we do better?  Should we switch to
/var/log/shepherd.log when syslogd disappears?  Ideas?  That’s a
situation where having syslogd inside PID 1 helps…

Ludo’.

Ludovic Courtès (3):
  Turn 'log-output-port' into a parameter.
  Simplify 'make-shepherd-output-port'.
  Use syslog for logging when running as root.

 doc/shepherd.texi            |  18 +++-
 modules/shepherd.scm         | 209 +++++++++++++++++++++++--------------------
 modules/shepherd/comm.scm    | 119 ++++++++++++++++++------
 modules/shepherd/support.scm |  19 ++--
 4 files changed, 224 insertions(+), 141 deletions(-)

-- 
2.16.2

[bug#30498] [PATCH 1/3] Turn 'log-output-port' into a parameter.

[Ludovic Courtès]

* modules/shepherd/comm.scm (log-output-port): Turn into a parameter and
publish it.
(start-logging, stop-logging): Adjust accordingly and mark as deprecated.
(make-shepherd-output-port): Adjust accordingly.
* modules/shepherd/support.scm (default-logfile): Remove.
(user-default-log-file): New procedure.
(default-logfile-date-format): Remove 'if'.
* modules/shepherd.scm (main): Have LOGFILE default to #f.  Parameterize
'log-output-port' and 'current-output-port'.
---
 modules/shepherd.scm         | 209 +++++++++++++++++++++++--------------------
 modules/shepherd/comm.scm    |  19 ++--
 modules/shepherd/support.scm |  19 ++--
 3 files changed, 129 insertions(+), 118 deletions(-)

diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index c869464..39fbe14 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -21,6 +21,7 @@
 
 (define-module (shepherd)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 rdelim)   ;; Line-based I/O.
   #:autoload   (ice-9 readline) (activate-readline) ;for interactive use
   #:use-module (oop goops)      ;; Defining classes and methods.
@@ -77,7 +78,7 @@
 	(socket-file default-socket-file)
         (pid-file    #f)
         (secure      #t)
-        (logfile     default-logfile))
+        (logfile     #f))
     ;; Process command line arguments.
     (process-args (program-name) args
 		  ""
@@ -161,104 +162,116 @@
     ;; We do this early so that we can abort early if necessary.
     (and socket-file
          (verify-dir (dirname socket-file) #:secure? secure))
-    ;; Enable logging as first action.
-    (start-logging logfile)
-
-    (when (string=? logfile "/dev/kmsg")
-      ;; By default we'd write both to /dev/kmsg and to stdout.  Redirect
-      ;; stdout to the bitbucket so we don't log twice.
-      (set-current-output-port (%make-void-port "w")))
-
-    ;; Send output to log and clients.
-    (set-current-output-port (make-shepherd-output-port))
-
-    ;; Start the 'root' service.
-    (start root-service)
-
-    ;; This _must_ succeed.  (We could also put the `catch' around
-    ;; `main', but it is often useful to get the backtrace, and
-    ;; `caught-error' does not do this yet.)
-    (catch #t
-      (lambda ()
-        (load-in-user-module (or config-file (default-config-file))))
-      (lambda (key . args)
-	(caught-error key args)
-	(quit 1)))
-    ;; Start what was started last time.
-    (and persistency
-	 (catch 'system-error
-	   (lambda ()
-	     (start-in-order (read (open-input-file
-				    persistency-state-file))))
-	   (lambda (key . args)
-	     (apply format #f (gettext (cadr args)) (caddr args))
-	     (quit 1))))
-
-    (when (provided? 'threads)
-      ;; XXX: This terrible hack allows us to make sure that signal handlers
-      ;; get a chance to run in a timely fashion.  Without it, after an EINTR,
-      ;; we could restart the accept(2) call below before the corresponding
-      ;; async has been queued.  See the thread at
-      ;; <https://lists.gnu.org/archive/html/guile-devel/2013-07/msg00004.html>.
-      (sigaction SIGALRM (lambda _ (alarm 1)))
-      (alarm 1))
-
-    ;; Stop everything when we get SIGINT.  When running as PID 1, that means
-    ;; rebooting; this is what happens when pressing ctrl-alt-del, see
-    ;; ctrlaltdel(8).
-    (sigaction SIGINT
-      (lambda _
-        (stop root-service)))
 
-    ;; Stop everything when we get SIGTERM.
-    (sigaction SIGTERM
-      (lambda _
-        (stop root-service)))
-
-    ;; Stop everything when we get SIGHUP.
-    (sigaction SIGHUP
-      (lambda _
-        (stop root-service)))
-
-    ;; Ignore SIGPIPE so that we don't die if a client closes the connection
-    ;; prematurely.
-    (sigaction SIGPIPE SIG_IGN)
-
-    (if (not socket-file)
-	;; Get commands from the standard input port.
-        (process-textual-commands (current-input-port))
-        ;; Process the data arriving at a socket.
-        (let ((sock   (open-server-socket socket-file))
-
-              ;; With Guile <= 2.0.9, we can get a system-error exception for
-              ;; EINTR, which happens anytime we receive a signal, such as
-              ;; SIGCHLD.  Thus, wrap the 'accept' call.
-              (accept (EINTR-safe accept)))
-
-          ;; Possibly write out our PID, which means we're ready to accept
-          ;; connections.  XXX: What if we daemonized already?
-          (match pid-file
-            ((? string? file)
-             (with-atomic-file-output pid-file
-               (cute display (getpid) <>)))
-            (#t (display (getpid)))
-            (_  #t))
-
-          (let next-command ()
-            (define (read-from sock)
-              (match (accept sock)
-                ((command-source . client-address)
-                 (setvbuf command-source _IOFBF 1024)
-                 (process-connection command-source))
-                (_ #f)))
-            (match (select (list sock) (list) (list) (if poll-services? 0.5 #f))
-              (((sock) _ _)
-               (read-from sock))
-              (_
-               #f))
-            (when poll-services?
-              (check-for-dead-services))
-            (next-command))))))
+    ;; Enable logging as first action.
+    (parameterize ((log-output-port
+                    (cond (logfile
+                           (open-file logfile "al"))
+                          ((zero? (getuid))
+                           (open-file "/dev/kmsg" "wl"))
+                          (else
+                           (open-file (user-default-log-file) "al"))))
+                   (%current-logfile-date-format
+                    (if (and (not logfile) (zero? (getuid)))
+                        (format #f "shepherd[~d]: " (getpid))
+                        default-logfile-date-format))
+                   (current-output-port
+                    ;; Send output to log and clients.
+                    (make-shepherd-output-port
+                     (if (and (zero? (getuid)) (not logfile))
+                         ;; By default we'd write both to /dev/kmsg and to
+                         ;; stdout.  Redirect stdout to the bitbucket so we
+                         ;; don't log twice.
+                         (%make-void-port "w")
+                         (current-output-port)))))
+
+      ;; Start the 'root' service.
+      (start root-service)
+
+      ;; This _must_ succeed.  (We could also put the `catch' around
+      ;; `main', but it is often useful to get the backtrace, and
+      ;; `caught-error' does not do this yet.)
+      (catch #t
+        (lambda ()
+          (load-in-user-module (or config-file (default-config-file))))
+        (lambda (key . args)
+          (caught-error key args)
+          (quit 1)))
+      ;; Start what was started last time.
+      (and persistency
+           (catch 'system-error
+             (lambda ()
+               (start-in-order (read (open-input-file
+                                      persistency-state-file))))
+             (lambda (key . args)
+               (apply format #f (gettext (cadr args)) (caddr args))
+               (quit 1))))
+
+      (when (provided? 'threads)
+        ;; XXX: This terrible hack allows us to make sure that signal handlers
+        ;; get a chance to run in a timely fashion.  Without it, after an EINTR,
+        ;; we could restart the accept(2) call below before the corresponding
+        ;; async has been queued.  See the thread at
+        ;; <https://lists.gnu.org/archive/html/guile-devel/2013-07/msg00004.html>.
+        (sigaction SIGALRM (lambda _ (alarm 1)))
+        (alarm 1))
+
+      ;; Stop everything when we get SIGINT.  When running as PID 1, that means
+      ;; rebooting; this is what happens when pressing ctrl-alt-del, see
+      ;; ctrlaltdel(8).
+      (sigaction SIGINT
+        (lambda _
+          (stop root-service)))
+
+      ;; Stop everything when we get SIGTERM.
+      (sigaction SIGTERM
+        (lambda _
+          (stop root-service)))
+
+      ;; Stop everything when we get SIGHUP.
+      (sigaction SIGHUP
+        (lambda _
+          (stop root-service)))
+
+      ;; Ignore SIGPIPE so that we don't die if a client closes the connection
+      ;; prematurely.
+      (sigaction SIGPIPE SIG_IGN)
+
+      (if (not socket-file)
+          ;; Get commands from the standard input port.
+          (process-textual-commands (current-input-port))
+          ;; Process the data arriving at a socket.
+          (let ((sock   (open-server-socket socket-file))
+
+                ;; With Guile <= 2.0.9, we can get a system-error exception for
+                ;; EINTR, which happens anytime we receive a signal, such as
+                ;; SIGCHLD.  Thus, wrap the 'accept' call.
+                (accept (EINTR-safe accept)))
+
+            ;; Possibly write out our PID, which means we're ready to accept
+            ;; connections.  XXX: What if we daemonized already?
+            (match pid-file
+              ((? string? file)
+               (with-atomic-file-output pid-file
+                 (cute display (getpid) <>)))
+              (#t (display (getpid)))
+              (_  #t))
+
+            (let next-command ()
+              (define (read-from sock)
+                (match (accept sock)
+                  ((command-source . client-address)
+                   (setvbuf command-source _IOFBF 1024)
+                   (process-connection command-source))
+                  (_ #f)))
+              (match (select (list sock) (list) (list) (if poll-services? 0.5 #f))
+                (((sock) _ _)
+                 (read-from sock))
+                (_
+                 #f))
+              (when poll-services?
+                (check-for-dead-services))
+              (next-command)))))))
 
 (define (process-connection sock)
   "Process client connection SOCK, reading and processing commands."
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index aeb138e..596a258 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -49,6 +49,7 @@
             result->sexp
             report-command-error
 
+            log-output-port
             start-logging
             stop-logging
             make-shepherd-output-port
@@ -194,16 +195,18 @@ on service '~a':")
 
 \f
 
-;; Port for logging.  This must always be a valid port, never `#f'.
-(define log-output-port (%make-void-port "w"))
-(define (start-logging file)
+(define log-output-port
+  ;; Port for logging.  This must always be a valid port, never `#f'.
+  (make-parameter (%make-void-port "w")))
+
+(define (start-logging file)                      ;deprecated
   (let ((directory (dirname file)))
     (unless (file-exists? directory)
       (mkdir directory)))
-  (set! log-output-port (open-file file "al")))   ; line-buffered port
-(define (stop-logging)
-  (close-port log-output-port)
-  (set! log-output-port (%make-void-port "w")))
+  (log-output-port (open-file file "al")))
+(define (stop-logging)                            ;deprecated
+  (close-port (log-output-port))
+  (log-output-port (%make-void-port "w")))
 
 (define %current-client-socket
   ;; Socket of the client currently talking to the daemon.
@@ -240,7 +243,7 @@ on service '~a':")
         (if (not (string-index str #\newline))
             (set! buffer (cons str buffer))
             (let* ((log (lambda (x)
-                          (display x log-output-port)))
+                          (display x (log-output-port))))
                    (init-line (lambda ()
                                 (log (strftime (%current-logfile-date-format)
                                                (localtime (current-time)))))))
diff --git a/modules/shepherd/support.scm b/modules/shepherd/support.scm
index 45a2030..380866e 100644
--- a/modules/shepherd/support.scm
+++ b/modules/shepherd/support.scm
@@ -23,7 +23,6 @@
 (define-module (shepherd support)
   #:use-module (shepherd config)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 format)
   #:export (call/ec
             caught-error
             assert
@@ -47,7 +46,7 @@
             display-line
 
             user-homedir
-            default-logfile
+            user-default-log-file
             default-logfile-date-format
             default-config-file
             default-socket-dir
@@ -308,19 +307,15 @@ TARGET should be a string representing a filepath + name."
 ""(for-each start '())
 ")))))
 
-;; Logfile.
-(define default-logfile
-  (if (zero? (getuid))
-      (if (access? "/dev/kmsg" W_OK)
-          "/dev/kmsg"
-          (string-append %localstatedir "/log/shepherd.log"))
-      (string-append %user-config-dir "/shepherd.log")))
+;; Logging.
+(define (user-default-log-file)
+  "Return the file name of the user's default log file."
+  (mkdir-p %user-config-dir #o700)
+  (string-append %user-config-dir "/shepherd.log"))
 
 (define default-logfile-date-format
   ;; 'strftime' format string to prefix each entry in the log.
-  (if (string=? default-logfile "/dev/kmsg")
-      (format #f "shepherd[~d]: " (getpid))
-      "%Y-%m-%d %H:%M:%S "))
+  "%Y-%m-%d %H:%M:%S ")
 
 ;; Configuration file.
 (define (default-config-file)
-- 
2.16.2

[bug#30498] [PATCH 2/3] Simplify 'make-shepherd-output-port'.

[Ludovic Courtès]

* 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

[bug#30498] [PATCH 3/3] Use syslog for logging when running as root.

[Ludovic Courtès]

* modules/shepherd/comm.scm (call-with-syslog-port, syslog-output-port):
New procedures.
* modules/shepherd.scm (main): Set 'log-output-port'
to (syslog-output-port) when running as root.
* doc/shepherd.texi (Invoking shepherd): Adjust accordingly.
---
 doc/shepherd.texi         | 18 ++++++++++---
 modules/shepherd.scm      |  2 +-
 modules/shepherd/comm.scm | 66 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 81 insertions(+), 5 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 01d8050..7946f8b 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -406,13 +406,23 @@ permissions are not as expected.
 @cindex log file
 Log output into @var{file}.
 
-The default behavior is to write to @file{/dev/kmsg} when running as
-superuser.  This special device is GNU/Linux-specific; when it does not
-exist, write to @file{/var/log/shepherd.log} instead.
-
 For unprivileged users, the default log file is
 @file{$XDG_CONFIG_HOME/shepherd/shepherd.log}.
 
+@cindex syslog
+When running as root, the default behavior is to connect to
+@file{/dev/log}, the @dfn{syslog} socket (@pxref{Overview of Syslog,,,
+libc, The GNU C Library Reference Manual}).  A syslog daemon,
+@command{syslogd}, is expected to read messages from there
+(@pxref{syslogd invocation, syslogd,, libc, GNU Inetutils}).
+
+When @file{/dev/log} is unavailable, for instance because
+@command{syslogd} is not running, as is the case during system startup
+and shutdown, @command{shepherd} falls back to the Linux kernel
+@dfn{ring buffer}, @file{/dev/kmsg}.  If @file{/dev/kmsg} is missing, as
+is the case on other operating systems, it falls back to
+@file{/dev/console}.
+
 @item --pid[=@var{file}]
 When @command{shepherd} is ready to accept connections, write its PID to @var{file} or
 to the standard output if @var{file} is omitted.
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 39fbe14..fede338 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -168,7 +168,7 @@
                     (cond (logfile
                            (open-file logfile "al"))
                           ((zero? (getuid))
-                           (open-file "/dev/kmsg" "wl"))
+                           (syslog-output-port))
                           (else
                            (open-file (user-default-log-file) "al"))))
                    (%current-logfile-date-format
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index e686bfa..cbd8686 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -50,6 +50,7 @@
             report-command-error
 
             log-output-port
+            syslog-output-port
             start-logging
             stop-logging
             make-shepherd-output-port
@@ -216,6 +217,71 @@ on service '~a':")
   ;; 'strftime' format strings for entries in the log file.
   (make-parameter default-logfile-date-format))
 
+(define call-with-syslog-port
+  (let ((port #f))                                ;connection to /dev/log
+    (lambda (proc)
+      "Call PROC with an open output port.  The output port corresponds to
+/dev/log (aka. syslog) or, if that is unavailable, a degraded logging
+mechanism."
+      (define (call/syslog)
+        (catch 'system-error
+          (lambda ()
+            (proc port))
+          (lambda args
+            (if (memv (system-error-errno args)
+                      (list ENOTCONN ECONNREFUSED EPIPE))
+                (begin
+                  (set! port #f)
+                  (call-with-syslog-port proc))
+                (apply throw args)))))
+
+      (or (and port (not (port-closed? port)) (call/syslog))
+          (let ((sock (socket AF_UNIX SOCK_DGRAM 0)))
+            (catch 'system-error
+              (lambda ()
+                (connect sock AF_UNIX "/dev/log")
+                (setvbuf sock _IOLBF)
+                (set! port sock)
+                (call/syslog))
+              (lambda args
+                (close-port sock)
+                (if (memv (system-error-errno args)
+                          (list ENOENT ECONNREFUSED))
+                    (catch 'system-error
+                      (lambda ()
+                        (call-with-output-file "/dev/kmsg"
+                          (lambda (port)
+                            (setvbuf port _IOFBF)
+                            (proc port))))
+                      (lambda args
+                        (if (memv (system-error-errno args)
+                                  (list ENOENT EACCES EPERM))
+                            (call-with-output-file "/dev/console"
+                              (lambda (port)
+                                (setvbuf port _IONBF)
+                                (proc port)))
+                            (apply throw args))))
+                    (apply throw args)))))))))
+
+(define (syslog-output-port)
+  "Return the output port to write to syslog or /dev/kmsg, whichever is
+available."
+  (make-soft-port
+   (vector
+    (lambda (char)                                ;write char
+      (call-with-syslog-port
+       (lambda (port)
+         (write-char char port))))
+    (lambda (str)                                 ;write string
+      (call-with-syslog-port
+       (lambda (port)
+         (display str port))))
+    (const #t)                                    ;flush
+    #f                                            ;get char
+    (lambda ()                                    ;close
+      (call-with-syslog-port close-port)))
+   "w"))                                          ;output port
+
 (define %not-newline
   (char-set-complement (char-set #\newline)))
 
-- 
2.16.2

[bug#30498] [PATCH 0/3] Log to syslog whenever possible

[Ludovic Courtès]

Ludovic Courtès <ludo@gnu.org> skribis:

> However!  The downside is that messages upon shutdown written after
> syslogd has been killed are lost: they go to /dev/kmsg, which goes to
> the console at that point, but they’re not written anywhere.

I should point out that this is already the case in shepherd master.

Ludo’.

bug#30498: [PATCH 0/3] Log to syslog whenever possible

[Ludovic Courtès]

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

Ludovic Courtès <ludo@gnu.org> skribis:

>   Turn 'log-output-port' into a parameter.
>   Simplify 'make-shepherd-output-port'.
>   Use syslog for logging when running as root.

Pushed!

For the record, this can be tested on GuixSD by running “make dist” in
the Shepherd and then applying something like the patch below in Guix:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1237 bytes --]

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index ad31bc498..04cb69e1b 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -47,6 +47,7 @@
   #:use-module (guix build-system perl)
   #:use-module (guix build-system python)
   #:use-module (guix build-system trivial)
+  #:use-module (guix gexp)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
   #:use-module (gnu packages check)
@@ -159,16 +160,8 @@ and provides a \"top-like\" mode (monitoring).")
 (define-public shepherd
   (package
     (name "shepherd")
-    (version "0.3.2")
-    (source (origin
-              (method url-fetch)
-              (uri (string-append "ftp://alpha.gnu.org/gnu/dmd/shepherd-"
-                                  version ".tar.gz"))
-              (sha256
-               (base32
-                "174q1qg7yg6w1hfvlfv720hr6hid4h5xzw15y3ycfpspllzldhcb"))
-              (patches (search-patches "shepherd-close-fds.patch"
-                                       "shepherd-herd-status-sorted.patch"))))
+    (version "0.3.3")
+    (source (local-file "/data/src/shepherd/shepherd-0.3.2.tar.gz"))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--localstatedir=/var")))

[-- Attachment #3: Type: text/plain, Size: 12 bytes --]


Ludo’.