unofficial mirror of guix-devel@gnu.org

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
 (define-module (gnu services kmscon)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages kmscon)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #:use-module (guix records)
  #:use-module (srfi srfi-26)
  #:export (kmscon-service))

(define-record-type* <kmscon-configuration>
  kmscon-configuration make-kmscon-configuration
  kmscon-configuration?
  (kmscon kmscon-configuration-kmscon)
  (login-program kmscon-configuration-login-program)
  (login-params kmscon-configuration-login-params)
  (hwaccel? kmscon-configuration-hwaccel?))

(define (kmscon-shepherd-service config)
  "Return a <shepherd-service> for kmscon with CONFIG."
  (define kmscon (kmscon-configuration-kmscon config))

  (define kmscon-command
    (append
      (list
        #~(string-append #$kmscon "/bin/kmscon")
        "--login" (kmscon-configuration-login-program config))
      (if (kmscon-configuration-hwaccel? config) '("--hwaccel") '())
      (list
        "--" (kmscon-configuration-login-params config))))

  (list (shepherd-service
    (documentation "kmscon virtual terminal")
    (requirement '(user-processes))
    (provision '(kmscon))
    (start #~(make-forkexec-constructor #$@kmscon-command))
    (stop #~(make-kill-destructor)))))

(define kmscon-service-type
  (service-type (name 'kmscon)
    (extensions
      (list (service-extension shepherd-root-service-type
                               kmscon-shepherd-service)))))

(define* (kmscon-service #:key
  (kmscon kmscon)
  (login-program #~(string-append #$shadow "/bin/login"))
  (login-params "-p")
  (hwaccel? #t))
  "Run the @command{kmscon} daemon from @var{kmscon} to start a virtual terminal."
  (service kmscon-service-type
    (kmscon-configuration
      (kmscon kmscon)
      (login-program login-program)
      (login-params login-params)
      (hwaccel? hwaccel?))))