# -*- Autoconf -*- # Process this file with autoconf to produce a configure script. AC_PREREQ([2.69]) AC_INIT([GNU Guix], [m4_esyscmd([build-aux/git-version-gen .tarball-version])], [bug-guix@gnu.org], [guix], [https://www.gnu.org/software/guix/]) AC_CONFIG_AUX_DIR([build-aux]) AM_INIT_AUTOMAKE([1.14 gnu tar-ustar silent-rules subdir-objects \ color-tests parallel-tests -Woverride -Wno-portability]) # Enable silent rules by default. AM_SILENT_RULES([yes]) AC_CONFIG_SRCDIR([guix.scm]) AC_CONFIG_MACRO_DIR([m4]) dnl For the C++ code. This must be used early. AC_USE_SYSTEM_EXTENSIONS AM_GNU_GETTEXT([external]) AM_GNU_GETTEXT_VERSION([0.19.1]) GUIX_SYSTEM_TYPE GUIX_ASSERT_SUPPORTED_SYSTEM GUIX_CHANNEL_METADATA AM_CONDITIONAL([CROSS_COMPILING], [test "x$cross_compiling" = "xyes"]) AC_ARG_WITH(store-dir, AS_HELP_STRING([--with-store-dir=PATH], [file name of the store (defaults to /gnu/store)]), [storedir="$withval"], [storedir="/gnu
aboutsummaryrefslogtreecommitdiff
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020 L  p R n  d n <guix@lprndn.info>
;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
;;; 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 lightdm)
  #:use-module (gnu artwork)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages display-managers)
  #:use-module (gnu packages freedesktop)
  #:use-module (gnu packages gnome)
  #:use-module (gnu packages vnc)
  #:use-module (gnu packages xorg)
  #:use-module (gnu services configuration)
  #:use-module (gnu services dbus)
  #:use-module (gnu services desktop)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services xorg)
  #:use-module (gnu services)
  #:use-module (gnu system pam)
  #:use-module (gnu system shadow)
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix i18n)
  #:use-module (guix records)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (lightdm-seat-configuration
            lightdm-seat-configuration?
            lightdm-seat-configuration-name
            lightdm-seat-configuration-type
            lightdm-seat-configuration-user-session
            lightdm-seat-configuration-autologin-user
            lightdm-seat-configuration-greeter-session
            lightdm-seat-configuration-xserver-command
            lightdm-seat-configuration-session-wrapper
            lightdm-seat-configuration-extra-config

            lightdm-gtk-greeter-configuration
            lightdm-gtk-greeter-configuration?
            lightdm-gtk-greeter-configuration-lightdm-gtk-greeter
            lightdm-gtk-greeter-configuration-assets
            lightdm-gtk-greeter-configuration-theme-name
            lightdm-gtk-greeter-configuration-icon-theme-name
            lightdm-gtk-greeter-configuration-cursor-theme-name
            lightdm-gtk-greeter-configuration-allow-debug
            lightdm-gtk-greeter-configuration-background
            lightdm-gtk-greeter-configuration-a11y-states
            lightdm-gtk-greeter-configuration-reader
            lightdm-gtk-greeter-configuration-extra-config

            lightdm-configuration
            lightdm-configuration?
            lightdm-configuration-lightdm
            lightdm-configuration-allow-empty-passwords?
            lightdm-configuration-xorg-configuration
            lightdm-configuration-greeters
            lightdm-configuration-seats
            lightdm-configuration-xdmcp?
            lightdm-configuration-xdmcp-listen-address
            lightdm-configuration-vnc-server?
            lightdm-configuration-vnc-server-command
            lightdm-configuration-vnc-server-listen-address
            lightdm-configuration-vnc-server-port
            lightdm-configuration-extra-config

            lightdm-service-type))

;;;
;;; Greeters.
;;;

(define list-of-file-likes?
  (list-of file-like?))

(define %a11y-states '(contrast font keyboard reader))

(define (a11y-state? value)
  (memq value %a11y-states))

(define list-of-a11y-states?
  (list-of a11y-state?))

(define-maybe boolean)

(define (serialize-boolean name value)
  (define (strip-trailing-? name)
    ;; field? -> field
    (let ((str (symbol->string name)))
      (if (string-suffix? "?" str)
          (string-drop-right str 1)
          str)))
  (format #f "~a=~:[false~;true~]~%" (strip-trailing-? name) value))

(define-maybe file-like)

(define (serialize-file-like name value)
  #~(format #f "~a=~a~%" '#$name #$value))

(define (serialize-list-of-a11y-states name value)
  (format #f "~a=~a~%" name (string-join (map symbol->string value) ";")))

(define (serialize-string name value)
  (format #f "~a=~a~%" name value))

(define (serialize-number name value)
  (format #f "~a=~a~%" name value))

(define (serialize-list-of-strings _ value)
  (string-join value "\n"))

(define-configuration lightdm-gtk-greeter-configuration
  (lightdm-gtk-greeter
   (file-like lightdm-gtk-greeter)
   "The lightdm-gtk-greeter package to use."
   empty-serializer)
  (assets
   (list-of-file-likes (list adwaita-icon-theme
                             gnome-themes-extra
                             ;; FIXME: hicolor-icon-theme should be in the
                             ;; packages of the desktop templates.
                             hicolor-icon-theme))
   "The list of packages complementing the greeter, such as package providing
icon themes."
   empty-serializer)
  (theme-name
   (string "Adwaita")
   "The name of the theme to use.")
  (icon-theme-name
   (string "Adwaita")
   "The name of the icon theme to use.")
  (cursor-theme-name
   (string "Adwaita")
   "The name of the cursor theme to use.")
  (cursor-theme-size
   (number 16)
   "The size to use for the cursor theme.")
  (allow-debugging?
   maybe-boolean
   "Set to #t to enable debug log level.")
  (background
   (file-like (file-append %artwork-repository
                           "/backgrounds/guix-checkered-16-9.svg"))
   "The background image to use.")
  ;; FIXME: This should be enabled by default, but it currently doesn't work,
  ;; failing to connect to D-Bus, causing the login to fail.
  (at-spi-enabled?
   (boolean #f)
   "Enable accessibility support through the Assistive Technology Service
Provider Interface (AT-SPI).")
  (a11y-states
   (list-of-a11y-states %a11y-states)
   "The accessibility features to enable, given as list of symbols.")
  (reader
   maybe-file-like
   "The command to use to launch a screen reader.")
  (extra-config
   (list-of-strings '())
   "Extra configuration values to append to the LightDM GTK Greeter
configuration file."))

(define (strip-record-type-name-brackets name)
  "Remove the '<' and