On Tue, Feb 14, 2017 at 07:24:17PM -0500, Leo Famulari wrote: > This 'extra' is a time-saving kludge. I'll add fields for all of > agetty's configuration options once I'm satisfied that the service works > on GuixSD.
Here's a patch that exposes (almost all) of agetty's command-line options. Is this the right way? Or would we rather wrap only the most commonly-used options, and leave an "escape hatch" as in the first version of the patch? If so, which options should we expose in Scheme? I'll wait for feedback before writing the documentation.
From 215ad705a933fda1170a5883277cd9a68db693e0 Mon Sep 17 00:00:00 2001
From: Leo Famulari <l...@famulari.name>
Date: Tue, 14 Feb 2017 11:28:04 -0500
Subject: [PATCH] services: Add agetty service.
* 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 | 214 +++++++++++++++++++++++++++++++++++++++++++++++++-
1 file changed, 213 insertions(+), 1 deletion(-)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 57601eab8..a06d44bb2 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -3,7 +3,7 @@
;;; Copyright © 2015, 2016 Alex Kost <alez...@gmail.com>
;;; Copyright © 2015, 2016 Mark H Weaver <m...@netris.org>
;;; Copyright © 2015 Sou Bunnbu <iyzs...@gmail.com>
-;;; Copyright © 2016 Leo Famulari <l...@famulari.name>
+;;; Copyright © 2016, 2017 Leo Famulari <l...@famulari.name>
;;; Copyright © 2016 David Craven <da...@craven.ch>
;;; Copyright © 2016 Ricardo Wurmus <rek...@elephly.net>
;;;
@@ -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,212 @@ 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))
+ (baud-rate agetty-baud-rate ;string
+ (default #f))
+ (auto-login agetty-auto-login ;string
+ (default #f))
+ (login-program agetty-login-program ;gexp
+ (default (file-append shadow "/bin/login")))
+ (login-pause? agetty-login-pause? ;Boolean
+ (default #f))
+ (eight-bits? agetty-eight-bits? ;Boolean
+ (default #f))
+ (no-reset? agetty-no-reset? ;Boolean
+ (default #f))
+ (remote? agetty-remote? ;Boolean
+ (default #f))
+ (flow-control? agetty-flow-control? ;Boolean
+ (default #f))
+ (host agetty-host ;string
+ (default #f))
+ (no-issue? agetty-no-issue? ;Boolean
+ (default #f))
+ (init-string agetty-init-string ;string
+ (default #f))
+ (no-clear? agetty-no-clear? ;Boolean
+ (default #f))
+ (local-line agetty-local-line ;always | never | auto
+ (default #f))
+ (extract-baud? agetty-extract-baud? ;Boolean
+ (default #f))
+ (skip-login? agetty-skip-login? ;Boolean
+ (default #f))
+ (no-newline? agetty-no-newline? ;Boolean
+ (default #f))
+ (login-options agetty-login-options ;string
+ (default #f))
+ (chroot agetty-chroot ;string
+ (default #f))
+ (hangup? agetty-hangup? ;Boolean
+ (default #f))
+ (timeout agetty-timeout ;integer
+ (default #f))
+ (detect-case? agetty-detect-case? ;Boolean
+ (default #f))
+ (wait-cr? agetty-wait-cr? ;Boolean
+ (default #f))
+ (no-hints? agetty-no-hints? ;Boolean
+ (default #f))
+ (no-hostname? agetty-no hostname? ;Boolean
+ (default #f))
+ (long-hostname? agetty-long-hostname? ;Boolean
+ (default #f))
+ (erase-chars agetty-erase-chars ;string
+ (default #f))
+ (kill-chars agetty-kill-chars ;string
+ (default #f))
+ (chdir agetty-chdir ;string
+ (default #f))
+ (delay agetty-delay ;integer
+ (default #f))
+ (nice agetty-nice ;integer
+ (default #f))
+;;; XXX Unimplemented for now!
+;;; (issue-file agetty-issue-file ;plain-file
+;;; (default #f))
+ )
+
+(define agetty-shepherd-service
+ (match-lambda
+ (($ <agetty-configuration> agetty tty term baud-rate auto-login
+ login-program login-pause? eight-bits? no-reset? remote? flow-control?
+ host no-issue? init-string no-clear? local-line extract-baud?
+ skip-login? no-newline? login-options chroot hangup? timeout
+ detect-case? wait-cr? no-hints? no-hostname? long-hostname? erase-chars
+ kill-chars chdir delay nice)
+ (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 eight-bits?
+ #~("--8bits")
+ #~())
+ #$@(if no-reset?
+ #~("--noreset")
+ #~())
+ #$@(if remote?
+ #~("--remote")
+ #~())
+ #$@(if flow-control?
+ #~("--flow-control")
+ #~())
+ #$@(if host
+ #~("--host" #$host)
+ #~())
+ #$@(if no-issue?
+ #~("--noissue")
+ #~())
+ #$@(if init-string
+ #~("--init-string" #$init-string)
+ #~())
+ #$@(if no-clear?
+ #~("--noclear")
+ #~())
+ ;; This doesn't work as expected. According to
+ ;; agetty(8), if this option is not passed, then the
+ ;; default is 'auto'. However, in my tests, when that
+ ;; option is selected, agetty never presents the
login
+ ;; prompt, and the term-ttyS0 service respawns every
+ ;; few seconds.
+ #$@(if local-line
+ #~(#$(match local-line
+ ('auto "--local-line=auto")
+ ('always "--local-line=always")
+ ('never "-local-line=never")))
+ #~())
+ #$@(if extract-baud?
+ #~("--extract-baud")
+ #~())
+ #$@(if skip-login?
+ #~("--skip-login")
+ #~())
+ #$@(if no-newline?
+ #~("--nonewline")
+ #~())
+ #$@(if login-options
+ #~("--login-options" #$login-options)
+ #~())
+ #$@(if chroot
+ #~("--chroot" #$chroot)
+ #~())
+ #$@(if hangup?
+ #~("--hangup")
+ #~())
+ #$@(if timeout
+ #~("--timeout" #$(number->string timeout))
+ #~())
+ #$@(if detect-case?
+ #~("--detect-case")
+ #~())
+ #$@(if wait-cr?
+ #~("--wait-cr")
+ #~())
+ #$@(if no-hints?
+ #~("--nohints?")
+ #~())
+ #$@(if no-hostname?
+ #~("--nohostname")
+ #~())
+ #$@(if long-hostname?
+ #~("--long-hostname")
+ #~())
+ #$@(if erase-chars
+ #~("--erase-chars" #$erase-chars)
+ #~())
+ #$@(if kill-chars
+ #~("--kill-chars" #$kill-chars)
+ #~())
+ #$@(if chdir
+ #~("--chdir" #$chdir)
+ #~())
+ #$@(if delay
+ #~("--delay" #$(number->string delay))
+ #~())
+ #$@(if nice
+ #~("--nice" #$(number->string nice))
+ #~())
+ #$@(if auto-login
+ #~("--autologin" #$auto-login)
+ #~())
+ #$@(if login-program
+ #~("--login-program" #$login-program)
+ #~())
+ #$@(if login-pause?
+ #~("--login-pause")
+ #~())
+ #$tty
+ #$@(if baud-rate
+ #~(#$baud-rate)
+ #~())
+ #$@(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
signature.asc
Description: PGP signature
