17/22: services: Add hurd-console-service-type.

[guix-commits]

janneke pushed a commit to branch wip-hurd-vm
in repository guix.

commit f7f6fd784b7c4088ab733a8e08d2a8b462941077
Author: Jan (janneke) Nieuwenhuizen <address@hidden>
AuthorDate: Mon Apr 13 10:13:05 2020 +0200

    services: Add hurd-console-service-type.
    
    * gnu/services/hurd.scm (<hurd-console-configuration>): New variable.
    (hurd-console-shepherd-service, hurd-console-service-type): New function.
    (hurd-service->shepherd-service): Add entry.
---
 gnu/services/hurd.scm | 49 ++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 48 insertions(+), 1 deletion(-)

diff --git a/gnu/services/hurd.scm b/gnu/services/hurd.scm
index 38add88..d20802e 100644
--- a/gnu/services/hurd.scm
+++ b/gnu/services/hurd.scm
@@ -17,6 +17,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services hurd)
+  #:use-module (gnu packages hurd)
   #:use-module (gnu packages ssh)
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
@@ -26,7 +27,8 @@
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
-  #:export (hurd-service->shepherd-service
+  #:export (hurd-console-service-type
+            hurd-service->shepherd-service
             hurd-ssh-configuration
             hurd-ssh-service-type))
 
@@ -40,11 +42,56 @@
 (define (hurd-service->shepherd-service service)
   (let ((config (service-value service)))
     (match config
+      (($ <hurd-console-configuration>) (hurd-console-shepherd-service config))
       (($ <openssh-configuration>) (hurd-ssh-shepherd-service config))
       (_ '()))))
 
 
 ;;;
+;;; Simple wrapper for <hurd>/bin/console.
+;;;
+
+(define-record-type* <hurd-console-configuration>
+  hurd-console-configuration make-hurd-console-configuration
+  hurd-console-configuration?
+  (hurd   hurd-console-configuration-hurd ;package
+          (default hurd))
+  (fancy? hurd-console-configuration-fancy?
+          (default #f)))
+
+(define (hurd-console-shepherd-service config)
+  "Return a <shepherd-service> for a Hurd console with CONFIG."
+
+  (define console-command
+    #~(list
+       (string-append #$(hurd-console-configuration-hurd config) 
"/bin/console")
+       "-c" "/dev/vcs"
+       "-d" "vga"
+       "-d" "pc_kbd"
+       "-d" "generic_speaker"))
+
+  (let ((fancy? (hurd-console-configuration-fancy? config)))
+    (list (shepherd-service
+           (documentation "Hurd console.")
+           (provision (if fancy? '(fancy-console) '(console)))
+           (requirement (if fancy? '(ttys) '()))
+           (start #~(lambda _ (fork+exec-command #$console-command) #t))
+           (stop #~(make-kill-destructor))))))
+
+(define hurd-console-service-type
+  (service-type
+   (name 'console)
+   (description
+    "Run a hurd console, @command{console}.")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             hurd-console-shepherd-service)))
+   (compose concatenate)
+   (extend  append)
+   (default-value (hurd-console-configuration))))
+
+
+;;;
 ;;; Simplified OpenSSH.  This removes loopback, syslogd and PAM dependencies.
 ;;; This package will be removed when the Hurd supports those.
 ;;;