services: Add 'virtual-terminal'.

Fixes <https://bugs.gnu.org/30505>.
Suggested by Danny Milosavljevic <dannym@scratchpost.org>.

* gnu/services/base.scm (unicode-start): Remove.
(virtual-terminal-service-type): New variable.
(console-font-shepherd-services): Remove 'modules'; remove call to
'unicode-start'.  Add 'virtual-terminal' to 'requirement'.
(mingetty-shepherd-service, kmscon-service-type): Likewise.
(%base-services): Add 'virtual-terminal-service-type'.
* gnu/system/install.scm (%installation-services): Likewise.
This commit is contained in:
Ludovic Courtès 2018-03-15 11:37:18 +01:00
parent 88cd7bbd3d
commit bb3062ad62
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 40 additions and 31 deletions

View File

@ -62,6 +62,7 @@
%default-console-font %default-console-font
console-font-service-type console-font-service-type
console-font-service console-font-service
virtual-terminal-service-type
udev-configuration udev-configuration
udev-configuration? udev-configuration?
@ -665,22 +666,27 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
"Return a service that sets the host name to @var{name}." "Return a service that sets the host name to @var{name}."
(service host-name-service-type name)) (service host-name-service-type name))
(define (unicode-start tty) (define virtual-terminal-service-type
"Return a gexp to start Unicode support on @var{tty}." ;; Ensure that virtual terminals run in UTF-8 mode. This is the case by
(with-imported-modules '((guix build syscalls)) ;; default with recent Linux kernels, but this service allows us to ensure
#~(let* ((fd (open-fdes #$tty O_RDWR)) ;; this. This service must start before any 'term-' service so that newly
(termios (tcgetattr fd))) ;; created terminals inherit this property. See
(define (set-utf8-input termios) ;; <https://bugs.gnu.org/30505> for a discussion.
(set-field termios (termios-input-flags) (shepherd-service-type
(logior (input-flags IUTF8) 'virtual-terminal
(termios-input-flags termios)))) (lambda (utf8?)
(shepherd-service
(tcsetattr fd (tcsetattr-action TCSAFLUSH) (documentation "Set virtual terminals in UTF-8 module.")
(set-utf8-input termios)) (provision '(virtual-terminal))
(requirement '(root-file-system))
;; TODO: ioctl(fd, KDSKBMODE, K_UNICODE); (start #~(lambda _
(close-fdes fd) (call-with-output-file
#t))) "/sys/module/vt/parameters/default_utf8"
(lambda (port)
(display 1 port)))
#t))
(stop #~(const #f))))
#t)) ;default to UTF-8
(define console-keymap-service-type (define console-keymap-service-type
(shepherd-service-type (shepherd-service-type
@ -719,8 +725,6 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(requirement (list (symbol-append 'term- (requirement (list (symbol-append 'term-
(string->symbol tty)))) (string->symbol tty))))
(modules '((guix build syscalls) ;for 'tcsetattr'
(srfi srfi-9 gnu))) ;for 'set-field'
(start #~(lambda _ (start #~(lambda _
;; It could be that mingetty is not fully ready yet, ;; It could be that mingetty is not fully ready yet,
;; which we check by calling 'ttyname'. ;; which we check by calling 'ttyname'.
@ -732,7 +736,9 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(usleep 500) (usleep 500)
(loop (- i 1)))) (loop (- i 1))))
(and #$(unicode-start device) ;; Assume the VT is already in UTF-8 mode, thanks to
;; the 'virtual-terminal' service.
;;
;; 'setfont' returns EX_OSERR (71) when an ;; 'setfont' returns EX_OSERR (71) when an
;; KDFONTOP ioctl fails, for example. Like ;; KDFONTOP ioctl fails, for example. Like
;; systemd's vconsole support, let's not treat ;; systemd's vconsole support, let's not treat
@ -741,7 +747,7 @@ to add @var{device} to the kernel's entropy pool. The service will fail if
(system* #$(file-append kbd "/bin/setfont") (system* #$(file-append kbd "/bin/setfont")
"-C" #$device #$font)) "-C" #$device #$font))
((0 71) #t) ((0 71) #t)
(else #f))))) (else #f))))
(stop #~(const #t)) (stop #~(const #t))
(respawn? #f))))) (respawn? #f)))))
tty+font)) tty+font))
@ -1093,7 +1099,7 @@ the tty to run, among other things."
;; Since the login prompt shows the host name, wait for the 'host-name' ;; Since the login prompt shows the host name, wait for the 'host-name'
;; service to be done. Also wait for udev essentially so that the tty ;; service to be done. Also wait for udev essentially so that the tty
;; text is not lost in the middle of kernel messages (XXX). ;; text is not lost in the middle of kernel messages (XXX).
(requirement '(user-processes host-name udev)) (requirement '(user-processes host-name udev virtual-terminal))
(start #~(make-forkexec-constructor (start #~(make-forkexec-constructor
(list #$(file-append mingetty "/sbin/mingetty") (list #$(file-append mingetty "/sbin/mingetty")
@ -2034,7 +2040,7 @@ This service is not part of @var{%base-services}."
(shepherd-service (shepherd-service
(documentation "kmscon virtual terminal") (documentation "kmscon virtual terminal")
(requirement '(user-processes udev dbus-system)) (requirement '(user-processes udev dbus-system virtual-terminal))
(provision (list (symbol-append 'term- (string->symbol virtual-terminal)))) (provision (list (symbol-append 'term- (string->symbol virtual-terminal))))
(start #~(make-forkexec-constructor #$kmscon-command)) (start #~(make-forkexec-constructor #$kmscon-command))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor)))))))
@ -2044,6 +2050,7 @@ This service is not part of @var{%base-services}."
;; Convenience variable holding the basic services. ;; Convenience variable holding the basic services.
(list (login-service) (list (login-service)
(service virtual-terminal-service-type)
(service console-font-service-type (service console-font-service-type
(map (lambda (tty) (map (lambda (tty)
(cons tty %default-console-font)) (cons tty %default-console-font))

View File

@ -214,7 +214,9 @@ You have been warned. Thanks for being so brave.\x1b[0m
(define bare-bones-os (define bare-bones-os
(load "examples/bare-bones.tmpl")) (load "examples/bare-bones.tmpl"))
(list (mingetty-service (mingetty-configuration (list (service virtual-terminal-service-type)
(mingetty-service (mingetty-configuration
(tty "tty1") (tty "tty1")
(auto-login "root"))) (auto-login "root")))