[shepherd] 04/04: Add REPL service.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 31d21fa083872d500c016b6b3b2587d25510702d
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sun Mar 12 23:10:27 2023 +0100

    Add REPL service.
    
    * modules/shepherd/service/repl.scm, tests/services/repl.sh: New files.
    * Makefile.am (dist_servicesub_DATA, TESTS): Add them.
    * doc/shepherd.texi (REPL Service): New section.
    * po/POTFILES.in: Add 'repl.scm'.
---
 Makefile.am                       |   6 ++-
 doc/shepherd.texi                 |  60 +++++++++++++++++++++
 modules/shepherd/service/repl.scm | 111 ++++++++++++++++++++++++++++++++++++++
 po/POTFILES.in                    |   1 +
 tests/services/repl.sh            |  98 +++++++++++++++++++++++++++++++++
 5 files changed, 274 insertions(+), 2 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index be0069b..3a6d622 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -46,7 +46,8 @@ nodist_shepherdsub_DATA =                     \
   modules/shepherd/config.scm                  \
   modules/shepherd/system.scm
 dist_servicesub_DATA =                         \
-  modules/shepherd/service/monitoring.scm
+  modules/shepherd/service/monitoring.scm      \
+  modules/shepherd/service/repl.scm
 
 shepherdgosubdir = $(guileobjectdir)/shepherd
 servicegosubdir = $(guileobjectdir)/shepherd/service
@@ -260,7 +261,8 @@ TESTS =                                             \
   tests/signals.sh                             \
   tests/system-star.sh                         \
   tests/close-on-exec.sh                       \
-  tests/services/monitoring.sh
+  tests/services/monitoring.sh                 \
+  tests/services/repl.sh
 
 TEST_EXTENSIONS = .sh
 EXTRA_DIST += $(TESTS)
diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 6fdf7c1..aa0dc40 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -1427,6 +1427,7 @@ or otherwise extend its functionality.  This chapter 
documents them.
 
 @menu
 * Monitoring Service::          Monitoring shepherd resource usage.
+* REPL Service::                Interacting with a running shepherd.
 @end menu
 
 @node Monitoring Service
@@ -1480,6 +1481,65 @@ every @var{period} seconds.
 This parameter specifies the default monitoring period, in seconds.
 @end defvr
 
+@node REPL Service
+@section Read-Eval-Print Loop Service
+
+@cindex REPL, read-eval-print loop
+@cindex read-eval-print loop, REPL
+Scheme wouldn't be Scheme without support for @dfn{live hacking}, and
+your favorite service manager had to support it too!  The @dfn{REPL
+service} provides a read-eval-print loop (REPL) that lets you interact
+with it from the comfort of the Guile REPL (@pxref{Running Guile
+Interactively,,, guile, GNU Guile Reference Manual}).
+
+The service listens for connections on a Unix-domain socket---by default
+@file{/var/run/shepherd/repl} when running as root and
+@file{/run/user/@var{uid}/shepherd/repl} otherwise---and spawns a new
+service for each client connection.  Clients can use the REPL as they
+would do with a ``normal'' REPL, except that it lets them inspect and
+modify the state of the @command{shepherd} process itself.
+
+@quotation Caveat
+The live REPL is a powerful tool in support of live hacking and
+debugging, but it's also a dangerous one: depending on the code you
+execute, you could lock the @command{shepherd} process, make it crash,
+or who knows what.
+
+One particular aspect to keep in mind is that @command{shepherd}
+currently uses Fibers in such a way that scheduling among fibers is
+cooperative and non-preemptive.  Beware!
+@end quotation
+
+A configuration file that enables the REPL service looks like this:
+
+@lisp
+(use-modules (shepherd service repl))
+
+(register-services (repl-service))
+@end lisp
+
+With that in place, you can later start the REPL:
+
+@example
+herd start repl
+@end example
+
+From there you can connect to the REPL socket.  If you use Emacs, you
+might fancy doing it with Geiser's @code{geiser-connect-local} function
+(@pxref{Top,,, geiser, Geiser User Manual}).
+
+The @code{(shepherd service repl)} module exports the following
+bindings.
+
+@deffn {procedure} repl-service [@var{socket-file}]
+Return a REPL service that listens to @var{socket-file}.
+@end deffn
+
+@defvr {Scheme Variable} default-repl-socket-file
+This parameter specifies the socket file name @code{repl-service} uses
+by default.
+@end defvr
+
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
 
 @node Misc Facilities
diff --git a/modules/shepherd/service/repl.scm 
b/modules/shepherd/service/repl.scm
new file mode 100644
index 0000000..460b227
--- /dev/null
+++ b/modules/shepherd/service/repl.scm
@@ -0,0 +1,111 @@
+;; repl.scm -- Read-eval-print loop.
+;; Copyright (C) 2023 Ludovic Courtès <ludo@gnu.org>
+;;
+;; This file is part of the GNU Shepherd.
+;;
+;; The GNU Shepherd is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3 of the License, or (at
+;; your option) any later version.
+;;
+;; The GNU Shepherd is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (shepherd service repl)
+  #:use-module (shepherd service)
+  #:use-module (shepherd support)
+  #:use-module ((shepherd comm) #:select (open-server-socket))
+  #:use-module (fibers)
+  #:use-module (fibers channels)
+  #:use-module (fibers io-wakeup)
+  #:autoload   (system repl repl) (start-repl)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:export (default-repl-socket-file
+            repl-service))
+
+(define (spawn-child-service client id)
+  "Register and start a new service that runs a REPL on @var{client}, a
+socket.  Use @var{id} to create the service name."
+  (letrec* ((name    (string->symbol
+                      (string-append "repl-client-"
+                                     (number->string id))))
+            (service (make <service>
+                       #:provides (list name)
+                       #:transient? #t
+                       #:start (lambda ()
+                                 (spawn-fiber
+                                  (lambda ()
+                                    (run-client-repl service client)))
+                                 client)
+                       #:stop (lambda (client)
+                                (close-port client)
+                                #f))))
+    (register-services service)
+    (start service)))
+
+(define* (run-repl-service socket)
+  (let loop ((client-id 1))
+    (match (accept socket (logior SOCK_NONBLOCK SOCK_CLOEXEC))
+      ((client . client-address)
+       ;; TRANSLATORS: "REPL" stands for "read-eval-print loop".
+       (local-output (l10n "Accepting REPL connection.")
+                     client-address)
+       (spawn-child-service client client-id)
+       (loop (+ client-id 1)))
+      (_ #f))))
+
+(define (spawn-repl-service socket)
+  "Spawn a REPL service that accepts connection on @var{socket}."
+  (spawn-fiber
+   (lambda ()
+     (run-repl-service socket)))
+  #t)
+
+(define user-module
+  (let ((module (resolve-module '(shepherd-user) #f #f #:ensure #t)))
+    (beautify-user-module! module)
+    (module-set! module 'sleep (@ (fibers) sleep)) ;avoid that pitfall
+    module))
+
+(define (run-client-repl service client)
+  "Return a REPL on @var{client}, a socket.  When the REPL terminates or
+crashes, stop @var{service}."
+  (catch #t
+    (lambda ()
+      (parameterize ((current-input-port client)
+                     (current-output-port client)
+                     (current-error-port client)
+                     (current-warning-port client))
+        (save-module-excursion
+         (lambda ()
+           (set-current-module user-module)
+           (with-fluids ((*repl-stack* '()))
+             (start-repl))))))
+    (lambda args
+      (local-output (l10n "Uncaught REPL exception: ~s.") args)))
+  (stop service))
+
+(define default-repl-socket-file
+  ;; Default socket file for the REPL.
+  (make-parameter (string-append default-socket-dir "/repl")))
+
+(define* (repl-service #:optional
+                       (socket-file (default-repl-socket-file)))
+  "Return a REPL service that listens to @var{socket-file}."
+  (make <service>
+    #:docstring (l10n "Run a read-eval-print loop (REPL).")
+    #:provides '(repl)
+    #:requires '()
+    #:start (lambda args
+              (let ((socket (open-server-socket socket-file)))
+                (spawn-repl-service socket)
+                socket))
+    #:stop (lambda (socket)
+             (close-port socket)
+             #f)))
diff --git a/po/POTFILES.in b/po/POTFILES.in
index 8af7712..e6e92d1 100644
--- a/po/POTFILES.in
+++ b/po/POTFILES.in
@@ -7,5 +7,6 @@ modules/shepherd/scripts/reboot.scm
 modules/shepherd/support.scm
 modules/shepherd/service.scm
 modules/shepherd/service/monitoring.scm
+modules/shepherd/service/repl.scm
 modules/shepherd/args.scm
 modules/shepherd.scm
diff --git a/tests/services/repl.sh b/tests/services/repl.sh
new file mode 100644
index 0000000..b1bf84f
--- /dev/null
+++ b/tests/services/repl.sh
@@ -0,0 +1,98 @@
+# GNU Shepherd --- Test monitoring service.
+# Copyright © 2023 Ludovic Courtès <ludo@gnu.org>
+#
+# This file is part of the GNU Shepherd.
+#
+# The GNU Shepherd is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or (at
+# your option) any later version.
+#
+# The GNU Shepherd is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with the GNU Shepherd.  If not, see <http://www.gnu.org/licenses/>.
+
+shepherd --version
+herd --version
+
+socket="t-socket-$$"
+conf="t-conf-$$"
+log="t-log-$$"
+pid="t-pid-$$"
+repl_socket="$PWD/repl-socket-$$"
+
+herd="herd -s $socket"
+
+trap "cat $log || true;
+      rm -f $socket $repl_socket $conf $log;
+      test -f $pid && kill \`cat $pid\` || true; rm -f $pid" EXIT
+
+cat > "$conf" <<EOF
+(use-modules (shepherd service repl))
+
+(register-services (repl-service "$repl_socket"))
+EOF
+
+rm -f "$pid" "$log" "$repl_socket"
+shepherd -I -s "$socket" -c "$conf" -l "$log" --pid="$pid" &
+
+# Wait till it's ready.
+while ! test -f "$pid" ; do sleep 0.3 ; done
+
+$herd start repl
+$herd status repl | grep "started"
+
+$herd status
+test $($herd status | grep '^ ' | wc -l) -eq 2
+
+guile -c '(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
+            (connect sock PF_UNIX "'$repl_socket'")
+            (sleep 10))' &
+child_pid=$!
+
+$herd status
+$herd status repl-client-1
+$herd status repl-client-1 | grep "started"
+$herd status repl-client-1 | grep "transient"
+test $($herd status | grep '^ ' | wc -l) = 3
+
+# Make sure 'repl-client-1' gets stopped as soon as the client disappears.
+kill $child_pid
+while test $($herd status | grep '^ ' | wc -l) -ne 2; do $herd status && sleep 
1 ;done
+! $herd status repl-client-1
+
+guile -c '
+(use-modules (ice-9 rdelim))
+
+(setvbuf (current-output-port) (string->symbol "none"))
+(alarm 10)
+(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
+  (connect sock PF_UNIX "'$repl_socket'")
+  (format #t "connected!~%> ")
+
+  (let loop ()
+    (define chr (read-char sock))
+    (unless (eof-object? chr)
+      (display chr)
+      (when (eq? chr #\newline)
+       (display "> ")))
+    (cond ((eof-object? chr)
+           (format #t "done!~%"))
+          ((eq? chr #\>)
+           (display "(+ 2 3)\n,q\n" sock)
+           (loop))
+         (else
+          (loop)))))
+'
+
+while test $($herd status | grep '^ ' | wc -l) -ne 2; do $herd status && sleep 
1; done
+$herd stop repl
+$herd status repl | grep "stopped"
+
+# Now we can't connect anymore.
+! guile -c '(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
+              (connect sock PF_UNIX "'$repl_socket'"))'