[PATCH 1/1] services: Add agetty service.

[Leo Famulari]

* gnu/services/base.scm (<agetty-configuration>): New record type.
(agetty-shepherd-service, agetty-service): New procedures.
(agetty-service-type): New variable.
---
 gnu/services/base.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 71 insertions(+), 1 deletion(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 57601eab8..58a50e38b 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2015, 2016 Alex Kost <address@hidden>
 ;;; Copyright © 2015, 2016 Mark H Weaver <address@hidden>
 ;;; Copyright © 2015 Sou Bunnbu <address@hidden>
-;;; Copyright © 2016 Leo Famulari <address@hidden>
+;;; Copyright © 2016, 2017 Leo Famulari <address@hidden>
 ;;; Copyright © 2016 David Craven <address@hidden>
 ;;; Copyright © 2016 Ricardo Wurmus <address@hidden>
 ;;;
@@ -38,6 +38,7 @@
                 #:select (canonical-package glibc))
   #:use-module (gnu packages bash)
   #:use-module (gnu packages package-management)
+  #:use-module (gnu packages linux)
   #:use-module (gnu packages lsof)
   #:use-module (gnu packages terminals)
   #:use-module ((gnu build file-systems)
@@ -74,6 +75,11 @@
             login-service-type
             login-service
 
+            agetty-configuration
+            agetty-configuration?
+            agetty-service
+            agetty-service-type
+
             mingetty-configuration
             mingetty-configuration?
             mingetty-service
@@ -730,6 +736,70 @@ Return a service that sets up Unicode support in @var{tty} 
and loads
 the message of the day, among other things."
   (service login-service-type config))
 
+(define-record-type* <agetty-configuration>
+  agetty-configuration make-agetty-configuration
+  agetty-configuration?
+  (agetty         agetty-configuration-agetty   ;<package>
+                  (default util-linux))
+  (tty            agetty-configuration-tty)     ;string
+  (term           agetty-term                   ;string
+                  (default #f))
+  (extra          agetty-extra                  ;string
+                  (default #f))
+  (baud-rate      agetty-baud-rate              ;string
+                  (default #f))
+  (auto-login     agetty-auto-login             ;string | #f
+                  (default #f))
+  (login-program  agetty-login-program          ;gexp
+                  (default (file-append shadow "/bin/login")))
+  (login-pause?   agetty-login-pause?           ;Boolean
+                  (default #f)))
+
+(define agetty-shepherd-service
+  (match-lambda
+    (($ <agetty-configuration> agetty tty term extra baud-rate auto-login
+        login-program login-pause?)
+     (list
+       (shepherd-service
+         (documentation "Run agetty on a tty.")
+         (provision (list (symbol-append 'term- (string->symbol tty))))
+
+         ;; Same comment as for mingetty-shepherd-service.
+         (requirement '(user-processes host-name udev))
+
+         (start #~(make-forkexec-constructor
+                    (list #$ (file-append util-linux "/sbin/agetty")
+                          #$@(if extra
+                                 #~(#$extra)
+                                 #~())
+                          "--noclear" #$tty
+                          #$@(if baud-rate
+                                 #~(#$baud-rate)
+                                 #~())
+                          #$@(if auto-login
+                                 #~("--autologin" #$auto-login)
+                                 #~())
+                          #$@(if login-program
+                                 #~("--login-program" #$login-program)
+                                 #~())
+                          #$@(if login-pause?
+                                 #~("--login-pause")
+                                 #~())
+                          #$@(if term
+                                 #~(#$term)
+                                 #~()))))
+         (stop #~(make-kill-destructor)))))))
+
+(define agetty-service-type
+  (service-type (name 'agetty)
+                (extensions (list (service-extension shepherd-root-service-type
+                                                     
agetty-shepherd-service)))))
+
+(define* (agetty-service config)
+  "Return a service to run agetty according to @var{config}, which specifies
+the tty to run, among other things."
+  (service agetty-service-type config))
+
 (define-record-type* <mingetty-configuration>
   mingetty-configuration make-mingetty-configuration
   mingetty-configuration?
-- 
2.11.1