aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/desktop.scm
blob: be64c4e7e5f0ed0188a5208fa33994dfcb58cd64 (about) (2015-07-03Merge branch 'nix'....Ludovic Courtès '>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 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 desktop)
  #:use-module (gnu tests)
  #:use-module (gnu services)
  #:use-module (gnu services dbus)
  #:use-module (gnu services desktop)
  #:use-module (gnu system vm)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-1)
  #:export (%test-elogind))


;;;
;;; Elogind.
;;;

(define (run-elogind-test vm)
  (define test
    (with-imported-modules '((gnu build marionette)
                             (guix build syscalls))
      #~(begin
          (use-modules (gnu build marionette)
                       (guix build syscalls)
                       (srfi srfi-64))

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

          (mkdir #$output)
          (chdir #$output)

          (test-begin "elogind")

          ;; Log in as root on tty1, and check what 'loginctl' returns.
          (test-equal "login on tty1"
            '(("c1" "0" "root" "seat0" "/dev/tty1") ;session
              ("seat0")                             ;seat
              ("0" "root"))                         ;user

            (begin
              ;; Wait for tty1.
              (marionette-eval
               '(begin
                  (use-modules (gnu services herd))
                  (start-service 'term-tty1))
               marionette)
              (marionette-control "sendkey ctrl-alt-f1" marionette)

              ;; Now we can type.
              (marionette-type "root\n" marionette)
              (marionette-type "loginctl list-users --no-legend > users\n"
                               marionette)
              (marionette-type "loginctl list-seats --no-legend > seats\n"
                               marionette)
              (marionette-type "loginctl list-sessions --no-legend > sessions\n"
                               marionette)


              ;; Read the three files.
              (marionette-eval '(use-modules (rnrs io ports)) marionette)
              (let ((guest-file (lambda (file)
                                  (string-tokenize
                                   (wait-for-file file marionette
                                                  #:read 'get-string-all)))))
                (list (guest-file "/root/sessions")
                      (guest-file "/root/seats")
                      (guest-file "/root/users")))))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "elogind" test))

(define %test-elogind
  (system-test
   (name "elogind")
   (description
    "Test whether we can log in when elogind is enabled, and whether
'loginctl' reports accurate user, session, and seat information.")
   (value
    (let ((os (marionette-operating-system
               (simple-operating-system
                (service elogind-service-type)
                (service polkit-service-type)
                (service dbus-root-service-type))
               #:imported-modules '((gnu services herd)
                                    (guix combinators)))))
      (run-elogind-test (virtual-machine os))))))
945658b3a3f2b8a2a4c217'>packages: Add 'package-input-rewriting/spec'....Ludovic Courtès 2019-02-20Merge branch 'staging' into core-updatesMarius Bakke 2019-02-16packages: Remove duplicates from package cache....Ludovic Courtès 2019-02-06Merge branch 'master' into core-updatesRicardo Wurmus 2019-01-25packages: Add 'package-closure'....Ludovic Courtès 2019-01-21store: Rename '&nix-error' to '&store-error'....Ludovic Courtès 2019-01-15guix package: '--list-available' can use data from the cache....Ludovic Courtès 2019-01-15edit: Use 'specification->location' to read information from the cache....Ludovic Courtès 2019-01-15channels: Compute a package cache and use it....Ludovic Courtès 2019-01-15guix package: Avoid 'find-newest-available-packages'....Ludovic Courtès 2018-09-23tests: Update package-transitive-supported-systems tests....Jan Nieuwenhuizen 2018-09-04Switch to Guile-Gcrypt....Ludovic Courtès 2018-06-09packages: Add 'package-patched-vulnerabilities'....Ludovic Courtès 2018-03-27tests: Use invoke and return #t from all builders....Mark H Weaver 2018-03-15tests: Do not assume the bootstrap guile tarball is available locally....Ludovic Courtès 2018-02-28build-system/trivial: Add support for #:allowed-references....Ludovic Courtès