diff options
| author | Jan (janneke) Nieuwenhuizen <janneke@gnu.org> | 2020-05-07 11:14:01 +0200 |
|---|---|---|
| committer | Jan Nieuwenhuizen <janneke@gnu.org> | 2020-06-08 14:26:14 +0200 |
| commit | 7ccd471c71d650055e99cd02381bc8dcd86d5313 (patch) | |
| tree | fff801b211dab87947ea50a42babbbfcf91b27b3 /gnu/services/hurd.scm | |
| parent | f9c04580bf5462bb088f47ad8fc6c3136649cbd6 (diff) | |
services: Add `hurd-getty-service-type'.
* gnu/services/hurd.scm (<hurd-gettty-configuration>): New record.
(hurd-ttys-shepherd-service): New procedure.
(hurd-getty-service-type): New variable.
* doc/guix.texi (Hurd Services): Document it.
Diffstat (limited to 'gnu/services/hurd.scm')
| -rw-r--r-- | gnu/services/hurd.scm | 52 |
1 files changed, 51 insertions, 1 deletions
diff --git a/gnu/services/hurd.scm b/gnu/services/hurd.scm index 36da8e218fb..1ccf164223b 100644 --- a/gnu/services/hurd.scm +++ b/gnu/services/hurd.scm | |||
| @@ -25,7 +25,9 @@ | |||
| 25 | #:use-module (guix gexp) | 25 | #:use-module (guix gexp) |
| 26 | #:use-module (guix records) | 26 | #:use-module (guix records) |
| 27 | #:export (hurd-console-configuration | 27 | #:export (hurd-console-configuration |
| 28 | hurd-console-service-type)) | 28 | hurd-console-service-type |
| 29 | hurd-getty-configuration | ||
| 30 | hurd-getty-service-type)) | ||
| 29 | 31 | ||
| 30 | ;;; Commentary: | 32 | ;;; Commentary: |
| 31 | ;;; | 33 | ;;; |
| @@ -70,4 +72,52 @@ | |||
| 70 | hurd-console-shepherd-service))) | 72 | hurd-console-shepherd-service))) |
| 71 | (default-value (hurd-console-configuration)))) | 73 | (default-value (hurd-console-configuration)))) |
| 72 | 74 | ||
| 75 | |||
| 76 | ;;; | ||
| 77 | ;;; The Hurd getty service. | ||
| 78 | ;;; | ||
| 79 | |||
| 80 | (define-record-type* <hurd-getty-configuration> | ||
| 81 | hurd-getty-configuration make-hurd-getty-configuration | ||
| 82 | hurd-getty-configuration? | ||
| 83 | (hurd hurd-getty-configuration-hurd ;<package> | ||
| 84 | (default hurd)) | ||
| 85 | (tty hurd-getty-configuration-tty) ;string | ||
| 86 | (baud-rate hurd-getty-configuration-baud-rate | ||
| 87 | (default 38400))) ;integer | ||
| 88 | |||
| 89 | (define (hurd-getty-shepherd-service config) | ||
| 90 | "Return a <shepherd-service> for a Hurd getty with CONFIG." | ||
| 91 | |||
| 92 | (let ((hurd (hurd-getty-configuration-hurd config)) | ||
| 93 | (tty (hurd-getty-configuration-tty config)) | ||
| 94 | (baud-rate (hurd-getty-configuration-baud-rate config))) | ||
| 95 | |||
| 96 | (define getty-command | ||
| 97 | #~(list | ||
| 98 | (string-append #$hurd "/libexec/getty") | ||
| 99 | #$(number->string baud-rate) | ||
| 100 | #$tty)) | ||
| 101 | |||
| 102 | (list | ||
| 103 | (shepherd-service | ||
| 104 | (documentation "Run getty on a tty.") | ||
| 105 | (provision (list (string->symbol (string-append "term-" tty)))) | ||
| 106 | (requirement '(user-processes console)) | ||
| 107 | (start #~(make-forkexec-constructor #$getty-command)) | ||
| 108 | (stop #~(make-kill-destructor)))))) | ||
| 109 | |||
| 110 | (define hurd-getty-service-type | ||
| 111 | (service-type | ||
| 112 | (name 'getty) | ||
| 113 | (extensions (list (service-extension shepherd-root-service-type | ||
| 114 | hurd-getty-shepherd-service))) | ||
| 115 | (description | ||
| 116 | "Provide console login using the Hurd @command{getty} program."))) | ||
| 117 | |||
| 118 | (define* (hurd-getty-service config) | ||
| 119 | "Return a service to run the Hurd getty according to @var{config}, which | ||
| 120 | specifies the tty to run, among other things." | ||
| 121 | (service hurd-getty-service-type config)) | ||
| 122 | |||
| 73 | ;;; hurd.scm ends here | 123 | ;;; hurd.scm ends here |
