unofficial mirror of guix-devel@gnu.org 
 help / color / mirror / code / Atom feed
From: Leo Famulari <leo@famulari.name>
To: guix-devel@gnu.org
Subject: Re: [V2 PATCH 1/1] services: Add agetty service.
Date: Thu, 16 Feb 2017 02:06:50 -0500	[thread overview]
Message-ID: <20170216070650.GA21674@jasmine> (raw)
In-Reply-To: <20170215002417.GA19546@jasmine>


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

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.

[-- Attachment #1.2: 0001-services-Add-agetty-service.patch --]
[-- Type: text/plain, Size: 11943 bytes --]

From 215ad705a933fda1170a5883277cd9a68db693e0 Mon Sep 17 00:00:00 2001
From: Leo Famulari <leo@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 <alezost@gmail.com>
 ;;; Copyright © 2015, 2016 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
-;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
+;;; Copyright © 2016, 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@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


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 833 bytes --]

  parent reply	other threads:[~2017-02-16  7:06 UTC|newest]

Thread overview: 11+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2017-02-15  0:12 [PATCH 1/1] services: Add agetty service Leo Famulari
2017-02-15  0:24 ` Leo Famulari
2017-02-15 15:21   ` myglc2
2017-02-15 19:38   ` Leo Famulari
2017-02-16  7:06   ` Leo Famulari [this message]
2017-02-17  7:48     ` [V2 PATCH " Ricardo Wurmus
2017-02-17 14:24       ` Leo Famulari
2017-02-17 18:35     ` myglc2
2017-02-17 22:59       ` Leo Famulari
2017-02-18  1:23         ` myglc2
2017-03-07 14:43         ` Ludovic Courtès

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=20170216070650.GA21674@jasmine \
    --to=leo@famulari.name \
    --cc=guix-devel@gnu.org \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).