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