aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020 Oleg Pykhalov <go.wigust@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 tests package-management)
  #:use-module (gnu packages base)
  #:use-module (gnu packages package-management)
  #:use-module (gnu services)
  #:use-module (gnu services networking)
  #:use-module (gnu services nix)
  #:use-module (gnu system)
  #:use-module (gnu system vm)
  #:use-module (gnu tests)
  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:export (%test-nix))

;;; Commentary:
;;;
;;; This module provides a test definition for the nix-daemon
;;;
;;; Code:

(define* (run-nix-test name test-os)
  "Run tests in TEST-OS, which has nix-daemon running."
  (define os
    (marionette-operating-system
     test-os
     #:imported-modules '((gnu services herd))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings '((8080 . 80)))
     (memory-size 1024)))

  (define test
    (with-imported-modules '((gnu build marionette))
      #~(begin
          (use-modules (srfi srfi-11)
                       (srfi srfi-64)
                       (gnu build marionette)
                       (web client)
                       (web response))

          (define marionette
            (make-marionette (list #$vm)))

          (test-runner-current (system-test-runner #$output))
          (test-begin #$name)

          ;; XXX: Shepherd reads the config file *before* binding its control
          ;; socket, so /var/run/shepherd/socket might not exist yet when the
          ;; 'marionette' service is started.
          (test-assert "shepherd socket ready"
            (marionette-eval
             `(begin
                (use-modules (gnu services herd))
                (let loop ((i 10))
                  (cond ((file-exists? (%shepherd-socket-file))
                         #t)
                        ((> i 0)
                         (sleep 1)
                         (loop (- i 1)))
                        (else
                         'failure))))
             marionette))

          (test-assert "Nix daemon running"
            (marionette-eval
             '(begin
                ;; Wait for nix-daemon to be up and running.
                (start-service 'nix-daemon)
                (zero? (system* (string-append #$nix "/bin/nix")
                                "--experimental-features" "nix-command"
                                "store" "ping" "--store" "daemon")))
             marionette))

          (test-end))))

  (gexp->derivation (string-append name "-test") test))

(define %nix-os
  ;; Return operating system under test.
  (let ((base-os
         (simple-operating-system
          (service nix-service-type)
          (service dhcp-client-service-type))))
    (operating-system
      (inherit base-os)
      (packages (cons nix (operating-system-packages base-os))))))

(define %test-nix
  (system-test
   (name "nix")
   (description "Connect to a running nix-daemon")
   (value (run-nix-test name %nix-os))))

;;; package-management.scm ends here
id='n113' href='#n113'>113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
;;; 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 admin)
  #: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")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(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))
                             '()))
                     #:requirements '#$requirement
                     #: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))))))