mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
services: console-font: Use 'tcsetattr' instead of invoking 'unicode_start'.
This is more robust, faster, and incidentally gets rid of remaining "error in the finalization thread: Bad file descriptor" messages. * gnu/services/base.scm (unicode-start): Rewrite to use 'tcgetattr' and 'tcsetattr'. (console-font-shepherd-services)[start]: Add 'loop' to check whether DEVICE is ready. Tolerate EX_OSERR return from 'setfont'. [modules]: New field.
This commit is contained in:
parent
45c32bd7e5
commit
787e8a80d5
1 changed files with 37 additions and 17 deletions
|
@ -621,21 +621,23 @@ (define (host-name-service name)
|
|||
|
||||
(define (unicode-start tty)
|
||||
"Return a gexp to start Unicode support on @var{tty}."
|
||||
(with-imported-modules '((guix build syscalls))
|
||||
#~(let* ((fd (open-fdes #$tty O_RDWR))
|
||||
(termios (tcgetattr fd)))
|
||||
(define (set-utf8-input termios)
|
||||
(set-field termios (termios-input-flags)
|
||||
(logior (input-flags IUTF8)
|
||||
(termios-input-flags termios))))
|
||||
|
||||
;; We have to run 'unicode_start' in a pipe so that when it invokes the
|
||||
;; 'tty' command, that command returns TTY.
|
||||
#~(begin
|
||||
(let ((pid (primitive-fork)))
|
||||
(case pid
|
||||
((0)
|
||||
(close-fdes 0)
|
||||
(dup2 (open-fdes #$tty O_RDONLY) 0)
|
||||
(close-fdes 1)
|
||||
(dup2 (open-fdes #$tty O_WRONLY) 1)
|
||||
(execl #$(file-append kbd "/bin/unicode_start")
|
||||
"unicode_start"))
|
||||
(else
|
||||
(zero? (cdr (waitpid pid))))))))
|
||||
;; See console_codes(4).
|
||||
(display "\x1b%G" (fdes->outport fd))
|
||||
|
||||
(tcsetattr fd (tcsetattr-action TCSAFLUSH)
|
||||
(set-utf8-input termios))
|
||||
|
||||
;; TODO: ioctl(fd, KDSKBMODE, K_UNICODE);
|
||||
(close-fdes fd)
|
||||
#t)))
|
||||
|
||||
(define console-keymap-service-type
|
||||
(shepherd-service-type
|
||||
|
@ -674,11 +676,29 @@ (define (console-font-shepherd-services tty+font)
|
|||
(requirement (list (symbol-append 'term-
|
||||
(string->symbol tty))))
|
||||
|
||||
(modules '((guix build syscalls) ;for 'tcsetattr'
|
||||
(srfi srfi-9 gnu))) ;for 'set-field'
|
||||
(start #~(lambda _
|
||||
;; It could be that mingetty is not fully ready yet,
|
||||
;; which we check by calling 'ttyname'.
|
||||
(let loop ((i 10))
|
||||
(unless (or (zero? i)
|
||||
(call-with-input-file #$device
|
||||
(lambda (port)
|
||||
(false-if-exception (ttyname port)))))
|
||||
(usleep 500)
|
||||
(loop (- i 1))))
|
||||
|
||||
(and #$(unicode-start device)
|
||||
(zero?
|
||||
(system* #$(file-append kbd "/bin/setfont")
|
||||
"-C" #$device #$font)))))
|
||||
;; 'setfont' returns EX_OSERR (71) when an
|
||||
;; KDFONTOP ioctl fails, for example. Like
|
||||
;; systemd's vconsole support, let's not treat
|
||||
;; this as an error.
|
||||
(case (status:exit-val
|
||||
(system* #$(file-append kbd "/bin/setfont")
|
||||
"-C" #$device #$font))
|
||||
((0 71) #t)
|
||||
(else #f)))))
|
||||
(stop #~(const #t))
|
||||
(respawn? #f)))))
|
||||
tty+font))
|
||||
|
|
Loading…
Reference in a new issue