[jackhill/guix/guix.git] / gnu / services / vnc.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services vnc)
  #:use-module (gnu packages vnc)
  #:use-module ((gnu services) #:hide (delete))
  #:use-module (gnu system shadow)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (guix gexp)
  #:use-module (guix records)

  #:export (xvnc-configuration
            xvnc-configuration-xvnc
            xvnc-configuration-display-number
            xvnc-configuration-geometry
            xvnc-configuration-depth
            xvnc-configuration-port
            xvnc-configuration-ipv4?
            xvnc-configuration-ipv6?
            xvnc-configuration-password-file
            xvnc-configuration-xdmcp?
            xvnc-configuration-inetd?
            xvnc-configuration-frame-rate
            xvnc-configuration-security-types
            xvnc-configuration-localhost?
            xvnc-configuration-log-level
            xvnc-configuration-extra-options

            xvnc-service-type))

;;;
;;; Xvnc.
;;;

(define (color-depth? x)
  (member x '(16 24 32)))

(define (port? x)
  (and (number? x)
       (and (>= x 0) (<= x 65535))))

(define-maybe/no-serialization port)

(define-maybe/no-serialization string)

(define %security-types '("None" "VncAuth" "Plain" "TLSNone" "TLSVnc" "TLSPlain"
                          "X509None" "X509Vnc"))

(define (security-type? x)
  (member x %security-types))

(define (security-types? x)
  (and (list? x)
       (and-map security-type? x)))

(define (log-level? x)
  (and (number? x)
       (and (>= x 0) (<= x 100))))

(define (strings? x)
  (and (list? x)
       (and-map string? x)))

(define-configuration/no-serialization xvnc-configuration
  (xvnc
   (file-like tigervnc-server)
   "The package that provides the Xvnc binary.")
  (display-number
   (number 0)
   "The display number used by Xvnc.  You should set this to a number not
already used by a Xorg server.  When remoting a complete desktop session via
XDMCP and using a compatible VNC viewer as provided by the
@code{tigervnc-client} or @code{turbovnc} packages, the geometry is
automatically adjusted.")
  (geometry
   (string "1024x768")
   "The size of the desktop to be created.")
  (depth
   (color-depth 24)
   "The pixel depth in bits of the desktop to be created.  Accepted values are
16, 24 or 32.")
  (port
   maybe-port
   "The port on which to listen for connections from viewers.  When left
unspecified, it defaults to 5900 plus the display number.")
  (ipv4?
   (boolean #t)
   "Use IPv4 for incoming and outgoing connections.")
  (ipv6?
   (boolean #t)
   "Use IPv6 for incoming and outgoing connections.")
  (password-file
   maybe-string
   "The password file to use, if any.  Refer to vncpasswd(1) to learn how to
generate such a file.")
  (xdmcp?
   (boolean #f)
   "Query the XDMCP server for a session.  This enables users to log in a
desktop session from the login manager screen.  For a multiple users scenario,
you'll want to enable the @code{inetd?} option as well, so that each
connection to the VNC server is handled separately rather than shared.")
  (inetd?
   (boolean #f)
   "Use an Inetd-style service, which runs the Xvnc server on demand.")
  (frame-rate
   (number 60)
   "The maximum number of updates per second sent to each client.")
  (security-types
   (security-types (list "None"))
   (format #f "The allowed security schemes to use for incoming connections.
The default is \"None\", which is safe given that Xvnc is configured to
authenticate the user via the display manager, and only for local connections.
Accepted values are any of the following: ~s" %security-types))
  (localhost?
   (boolean #t)
   "Only allow connections from the same machine.  It is set to @code{#true}
by default for security, which means SSH or another secure means should be
used to expose the remote port.")
  (log-level
   (log-level 30)
   "The log level, a number between 0 and 100, 100 meaning most verbose
output.  The log messages are output to syslog.")
  (extra-options
   (strings '())
   "This can be used to provide extra Xvnc options not exposed via this
<xvnc-configuration> record."))

(define (xvnc-configuration->command-line-arguments config)
  "Derive the command line arguments to used to launch the Xvnc daemon from
CONFIG, a <xvnc-configuration> object."
  (match-record config <xvnc-configuration>
    (xvnc display-number geometry depth port ipv4? ipv6? password-file xdmcp?
          inetd? frame-rate security-types localhost? log-level extra-options)
    #~(list #$(file-append xvnc "/bin/Xvnc")
            #$(format #f ":~a" display-number)
            "-geometry" #$geometry
            "-depth" #$(number->string depth)
            #$@(if inetd?
                   (list "-inetd")
                   '())
            #$@(if (not inetd?)
                   (if (maybe-value-set? port)
                       (list "-rfbport" (number->string port))
                       '())
                   '())
            #$@(if (not inetd?)
                   (if ipv4?
                       (list "-UseIPv4")
                       '())
                   '())
            #$@(if (not inetd?)
                   (if ipv6?
                       (list "-UseIPv6")
                       '())
                   '())
            #$@(if (maybe-value-set? password-file)
                   (list "-PasswordFile" password-file)
                   '())
            "-FrameRate" #$(number->string frame-rate)
            "-SecurityTypes" #$(string-join security-types ",")
            #$@(if localhost?
                   (list "-localhost")
                   '())
            "-Log" #$(format #f "*:syslog:~a" log-level)
            #$@(if xdmcp?
                   (list "-query" "localhost" "-once")
                   '())
            #$@extra-options)))

(define %xvnc-accounts
  (list (user-group
         (name "xvnc")
         (system? #t))
        (user-account
         (name "xvnc")
         (group "xvnc")
         (system? #t)
         (comment "User for Xvnc server"))))

(define (xvnc-shepherd-service config)
  "Return a <shepherd-service> for Xvnc with CONFIG."
  (let* ((display-number (xvnc-configuration-display-number config))
         (port (if (maybe-value-set? (xvnc-configuration-port config))
                   (xvnc-configuration-port config)
                   #f))
         (port* (or port (+ 5900 display-number))))
    (shepherd-service
     (provision '(xvnc vncserver))
     (documentation "Run the Xvnc server.")
     (requirement '(networking syslogd))
     (start (if (xvnc-configuration-inetd? config)
                #~(let* ((inaddr (if #$(xvnc-configuration-localhost? config)
                                     INADDR_LOOPBACK
                                     INADDR_ANY))
                         (in6addr (if #$(xvnc-configuration-localhost? config)
                                      IN6ADDR_LOOPBACK
                                      IN6ADDR_ANY))
                         (ipv4-socket (and #$(xvnc-configuration-ipv4? config)
                                           (make-socket-address AF_INET inaddr
                                                                #$port*)))
                         (ipv6-socket (and #$(xvnc-configuration-ipv6? config)
                                           (make-socket-address AF_INET6 in6addr
                                                                #$port*))))
                    (make-inetd-constructor
                     #$(xvnc-configuration->command-line-arguments config)
                     `(,@(if ipv4-socket
                             (list (endpoint ipv4-socket))
                             '())
                       ,@(if ipv6-socket
                             (list (endpoint ipv6-socket))
                             '()))
                     #:user "xvnc"
                     #:group "xvnc"))
                #~(make-forkexec-constructor
                   #$(xvnc-configuration->command-line-arguments config)
                   #:user "xvnc"
                   #:group "xvnc")))
     (stop #~(make-inetd-destructor)))))

(define xvnc-service-type
  (service-type
   (name 'xvnc)
   (default-value (xvnc-configuration))
   (description "Run the Xvnc server, which creates a virtual X11 session and
allow remote clients connecting to it via the remote framebuffer (RFB)
protocol.")
   (extensions (list (service-extension
                      shepherd-root-service-type
                      (compose list xvnc-shepherd-service))
                     (service-extension account-service-type
                                        (const %xvnc-accounts))))))
Commit	Line	Data
00e84305 MC	1	;;; GNU Guix --- Functional package management for GNU
	2	;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (gnu services vnc)
	20	#:use-module (gnu packages vnc)
	21	#:use-module ((gnu services) #:hide (delete))
	22	#:use-module (gnu system shadow)
	23	#:use-module (gnu services configuration)
	24	#:use-module (gnu services shepherd)
	25	#:use-module (guix gexp)
	26	#:use-module (guix records)
	27
	28	#:export (xvnc-configuration
	29	xvnc-configuration-xvnc
	30	xvnc-configuration-display-number
	31	xvnc-configuration-geometry
	32	xvnc-configuration-depth
	33	xvnc-configuration-port
	34	xvnc-configuration-ipv4?
	35	xvnc-configuration-ipv6?
	36	xvnc-configuration-password-file
	37	xvnc-configuration-xdmcp?
	38	xvnc-configuration-inetd?
	39	xvnc-configuration-frame-rate
	40	xvnc-configuration-security-types
	41	xvnc-configuration-localhost?
	42	xvnc-configuration-log-level
	43	xvnc-configuration-extra-options
	44
	45	xvnc-service-type))
	46
	47	;;;
	48	;;; Xvnc.
	49	;;;
	50
	51	(define (color-depth? x)
	52	(member x '(16 24 32)))
	53
	54	(define (port? x)
	55	(and (number? x)
	56	(and (>= x 0) (<= x 65535))))
	57
	58	(define-maybe/no-serialization port)
	59
	60	(define-maybe/no-serialization string)
	61
	62	(define %security-types '("None" "VncAuth" "Plain" "TLSNone" "TLSVnc" "TLSPlain"
	63	"X509None" "X509Vnc"))
	64
65	(define (security-type? x)
66	(member x %security-types))
67
68	(define (security-types? x)
69	(and (list? x)
70	(and-map security-type? x)))
71
72	(define (log-level? x)
73	(and (number? x)
74	(and (>= x 0) (<= x 100))))
75
76	(define (strings? x)
77	(and (list? x)
78	(and-map string? x)))
79
80	(define-configuration/no-serialization xvnc-configuration
81	(xvnc
82	(file-like tigervnc-server)
83	"The package that provides the Xvnc binary.")
84	(display-number
85	(number 0)
86	"The display number used by Xvnc. You should set this to a number not
87	already used by a Xorg server. When remoting a complete desktop session via
88	XDMCP and using a compatible VNC viewer as provided by the
89	@code{tigervnc-client} or @code{turbovnc} packages, the geometry is
90	automatically adjusted.")
91	(geometry
92	(string "1024x768")
93	"The size of the desktop to be created.")
94	(depth
95	(color-depth 24)
96	"The pixel depth in bits of the desktop to be created. Accepted values are
97	16, 24 or 32.")
98	(port
99	maybe-port
100	"The port on which to listen for connections from viewers. When left
101	unspecified, it defaults to 5900 plus the display number.")
102	(ipv4?
103	(boolean #t)
104	"Use IPv4 for incoming and outgoing connections.")
105	(ipv6?
106	(boolean #t)
107	"Use IPv6 for incoming and outgoing connections.")
108	(password-file
109	maybe-string
110	"The password file to use, if any. Refer to vncpasswd(1) to learn how to
111	generate such a file.")
112	(xdmcp?
113	(boolean #f)
114	"Query the XDMCP server for a session. This enables users to log in a
115	desktop session from the login manager screen. For a multiple users scenario,
116	you'll want to enable the @code{inetd?} option as well, so that each
117	connection to the VNC server is handled separately rather than shared.")
118	(inetd?
119	(boolean #f)
120	"Use an Inetd-style service, which runs the Xvnc server on demand.")
121	(frame-rate
122	(number 60)
123	"The maximum number of updates per second sent to each client.")
124	(security-types
125	(security-types (list "None"))
126	(format #f "The allowed security schemes to use for incoming connections.
127	The default is \"None\", which is safe given that Xvnc is configured to
128	authenticate the user via the display manager, and only for local connections.
129	Accepted values are any of the following: ~s" %security-types))
130	(localhost?
131	(boolean #t)
132	"Only allow connections from the same machine. It is set to @code{#true}
133	by default for security, which means SSH or another secure means should be
134	used to expose the remote port.")
135	(log-level
136	(log-level 30)
137	"The log level, a number between 0 and 100, 100 meaning most verbose
138	output. The log messages are output to syslog.")
139	(extra-options
140	(strings '())
141	"This can be used to provide extra Xvnc options not exposed via this
142	<xvnc-configuration> record."))
143
144	(define (xvnc-configuration->command-line-arguments config)
145	"Derive the command line arguments to used to launch the Xvnc daemon from
146	CONFIG, a <xvnc-configuration> object."
147	(match-record config <xvnc-configuration>
148	(xvnc display-number geometry depth port ipv4? ipv6? password-file xdmcp?
149	inetd? frame-rate security-types localhost? log-level extra-options)
150	#~(list #$(file-append xvnc "/bin/Xvnc")
151	#$(format #f ":~a" display-number)
152	"-geometry" #$geometry
153	"-depth" #$(number->string depth)
154	#$@(if inetd?
155	(list "-inetd")
156	'())
157	#$@(if (not inetd?)
158	(if (maybe-value-set? port)
159	(list "-rfbport" (number->string port))
160	'())
161	'())
162	#$@(if (not inetd?)
163	(if ipv4?
164	(list "-UseIPv4")
165	'())
166	'())
167	#$@(if (not inetd?)
168	(if ipv6?
169	(list "-UseIPv6")
170	'())
171	'())
172	#$@(if (maybe-value-set? password-file)
173	(list "-PasswordFile" password-file)
174	'())
175	"-FrameRate" #$(number->string frame-rate)
176	"-SecurityTypes" #$(string-join security-types ",")
177	#$@(if localhost?
178	(list "-localhost")
179	'())
180	"-Log" #$(format #f "*:syslog:~a" log-level)
181	#$@(if xdmcp?
182	(list "-query" "localhost" "-once")
183	'())
184	#$@extra-options)))
185
186	(define %xvnc-accounts
187	(list (user-group
188	(name "xvnc")
189	(system? #t))
190	(user-account
191	(name "xvnc")
192	(group "xvnc")
193	(system? #t)
194	(comment "User for Xvnc server"))))
195
196	(define (xvnc-shepherd-service config)
197	"Return a <shepherd-service> for Xvnc with CONFIG."
198	(let* ((display-number (xvnc-configuration-display-number config))
199	(port (if (maybe-value-set? (xvnc-configuration-port config))
200	(xvnc-configuration-port config)
201	#f))
202	(port* (or port (+ 5900 display-number))))
203	(shepherd-service
204	(provision '(xvnc vncserver))
205	(documentation "Run the Xvnc server.")
206	(requirement '(networking syslogd))
207	(start (if (xvnc-configuration-inetd? config)
208	#~(let* ((inaddr (if #$(xvnc-configuration-localhost? config)
209	INADDR_LOOPBACK
210	INADDR_ANY))
211	(in6addr (if #$(xvnc-configuration-localhost? config)
212	IN6ADDR_LOOPBACK
213	IN6ADDR_ANY))
214	(ipv4-socket (and #$(xvnc-configuration-ipv4? config)
215	(make-socket-address AF_INET inaddr
216	#$port*)))
217	(ipv6-socket (and #$(xvnc-configuration-ipv6? config)
218	(make-socket-address AF_INET6 in6addr
219	#$port*))))
220	(make-inetd-constructor
221	#$(xvnc-configuration->command-line-arguments config)
222	`(,@(if ipv4-socket
223	(list (endpoint ipv4-socket))
224	'())
225	,@(if ipv6-socket
226	(list (endpoint ipv6-socket))
227	'()))
228	#:user "xvnc"
229	#:group "xvnc"))
230	#~(make-forkexec-constructor
231	#$(xvnc-configuration->command-line-arguments config)
232	#:user "xvnc"
233	#:group "xvnc")))
234	(stop #~(make-inetd-destructor)))))
235
236	(define xvnc-service-type
237	(service-type
238	(name 'xvnc)
239	(default-value (xvnc-configuration))
240	(description "Run the Xvnc server, which creates a virtual X11 session and
241	allow remote clients connecting to it via the remote framebuffer (RFB)
242	protocol.")
243	(extensions (list (service-extension
244	shepherd-root-service-type
245	(compose list xvnc-shepherd-service))
246	(service-extension account-service-type
247	(const %xvnc-accounts))))))