From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mp0.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by ms13.migadu.com with LMTPS id QKnVLJEQameCDAEAqHPOHw:P1 (envelope-from ) for ; Tue, 24 Dec 2024 01:38:25 +0000 Received: from aspmx1.migadu.com ([2001:41d0:303:e224::]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits)) by mp0.migadu.com with LMTPS id QKnVLJEQameCDAEAqHPOHw (envelope-from ) for ; Tue, 24 Dec 2024 02:38:25 +0100 X-Envelope-To: larch@yhetil.org Authentication-Results: aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=rEhA8lBw; dkim=fail ("body hash did not verify") header.d=163.com header.s=s110527 header.b=CX4V+411; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=163.com (policy=none) ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=yhetil.org; s=key1; t=1735004305; h=from:from:sender:sender:reply-to:subject:subject:date:date: message-id:message-id:to:to:cc:mime-version:mime-version: content-type:content-type:resent-cc:resent-from:resent-sender: resent-message-id:in-reply-to:in-reply-to:references:references: list-id:list-help:list-unsubscribe:list-subscribe:list-post: dkim-signature; bh=ylq5cSvp27W+VPXbkvrvtJO1qevmhuTpCtvpTJMgKgs=; b=ndD071v9bwtEVLL708Pun2thkWLaVBBw8w4aQP4wOlTkqKpJZp66/Q2W82VNyu9LJKjZvu IbblGSTU7Jm50TjYK5aYR1ZzM3irkrihrWQDHm+iI96ARuyiWlucl/XY/2dtCeqxpUdVjV x6CwZ9NFaGrrxHLtle7tmu/xI7J1Dg3S3DJG/yBZXKKKpVd/WvsGfSJrAomF6eTfRqy1E3 TFcYo1qGpxnGVb60Gil9vnVLc3cAy6yAq2Vvz1ED8DEulgtFxXDkDwL1VNV9eMwEABzEkG 7lm0Xg6c+q4NCXRRYeg21EqE3iEHsTBlkLgVuNqBrtyPUltnn9sQ9hXCSqNRGg== ARC-Authentication-Results: i=1; aspmx1.migadu.com; dkim=fail ("body hash did not verify") header.d=debbugs.gnu.org header.s=debbugs-gnu-org header.b=rEhA8lBw; dkim=fail ("body hash did not verify") header.d=163.com header.s=s110527 header.b=CX4V+411; spf=pass (aspmx1.migadu.com: domain of "guix-patches-bounces+larch=yhetil.org@gnu.org" designates 209.51.188.17 as permitted sender) smtp.mailfrom="guix-patches-bounces+larch=yhetil.org@gnu.org"; dmarc=fail reason="SPF not aligned (relaxed)" header.from=163.com (policy=none) ARC-Seal: i=1; s=key1; d=yhetil.org; t=1735004305; a=rsa-sha256; cv=none; b=ZZOA+GFrGZAbr8dEZ6MGXnXXhu3C0rMaxXPJ7oZnoW9BAN2nOBSN88vOoaYs4FOHu0/Cjm zVTfdjyM0vDTeaN90X2RKdbW4WmWDGLne2qHSsRhv2bEoigvwOQS1MKwvzUT96fzmHwTCr guwo7gMQmHrtWSnwS7rWb2vWNrgIDOgVOdcomL8v7KSvxTnVGIwHEVfppJDTgWzIjJYAxf bdM5sKzDn7sYRgaILvvOD743MzohbLRZYGGMVcKi/URXrl/+j6zeL+iRy5S2wvy4q8L4sd s4J3dYXC/zfTIE9DHKOYZjepdKvMTMhVj56fvPjGiAclSjbrAbT97clT2ysgmQ== Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by aspmx1.migadu.com (Postfix) with ESMTPS id 6B2C05F71 for ; Tue, 24 Dec 2024 02:38:25 +0100 (CET) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tPtQ1-0006Hd-8L; Mon, 23 Dec 2024 20:09:05 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tPtPy-0006HK-3g for guix-patches@gnu.org; Mon, 23 Dec 2024 20:09:02 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1tPtPx-0008Nu-RB for guix-patches@gnu.org; Mon, 23 Dec 2024 20:09:01 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:From:To:In-Reply-To:References:Subject; bh=06xrFYu5MF/gm9VwN1wAWl8t0lX/ZDkjX03b2GiYUf4=; b=rEhA8lBwcIKqPmz9VR9fwJohOiaUePL0IKjWBAB+G6dLZE3PnQLXEhiwekS6jZKHYcT6GR005zdGX2/8Uf6sMjM81/tg03dgXjWIkiQuFtJeitVb6mjnSPg1QovwbUBPlxKJ2gq58wJdt3T9/rn5jFfPzI7w7prvVM6c1dP6do37edx6UUVL4LpXoIYlyD1uuHHoyt7qg47WNMlw0gTkS4VI9zXlo7Ps6cikLMY1jdf5KmZPNNstmFBdT/O1qPRIy3kSDSMNZz89JOAftMjEq8AVngnyIUiOtnCB2mzrTspQrx1HP31oStNv6dgJcSjx8cyjJSthF99DutRl0wUXmw==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tPtPx-0006Vn-Kg for guix-patches@gnu.org; Mon, 23 Dec 2024 20:09:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#75048] [PATCH v2] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. References: <87pllibkr3.fsf@163.com> In-Reply-To: <87pllibkr3.fsf@163.com> Resent-From: Feng Shu Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 24 Dec 2024 01:09:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 75048 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 75048@debbugs.gnu.org Received: via spool by 75048-submit@debbugs.gnu.org id=B75048.173500253325015 (code B ref 75048); Tue, 24 Dec 2024 01:09:01 +0000 Received: (at 75048) by debbugs.gnu.org; 24 Dec 2024 01:08:53 +0000 Received: from localhost ([127.0.0.1]:58633 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tPtPn-0006VO-Vo for submit@debbugs.gnu.org; Mon, 23 Dec 2024 20:08:53 -0500 Received: from m16.mail.163.com ([220.197.31.3]:54410) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tPtPi-0006V8-0Z for 75048@debbugs.gnu.org; Mon, 23 Dec 2024 20:08:50 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=163.com; s=s110527; h=From:Subject:Date:Message-ID:MIME-Version: Content-Type; bh=06xrFYu5MF/gm9VwN1wAWl8t0lX/ZDkjX03b2GiYUf4=; b=CX4V+411We/ubVJg0XEfa4cBmP4U2PDbEPqJWmNP5njuFYKBreZj9dx8el5jzB H8iUFYx2G93kzmr2NlVdrKeH4EfmbY3o41znGncoMRIxLn9+NwSaC2yKab0A0V2T vNgV16vd72r5gfqqc88jVHF1/bdz1ZOnElctMLFzm+dU4= Received: from Tumashu (unknown []) by gzga-smtp-mtada-g1-3 (Coremail) with SMTP id _____wCHn6mWCWpny_EKBQ--.41238S2; Tue, 24 Dec 2024 09:08:38 +0800 (CST) From: Feng Shu Date: Tue, 24 Dec 2024 09:08:38 +0800 Message-ID: <87h66topk9.fsf@163.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-CM-TRANSID: _____wCHn6mWCWpny_EKBQ--.41238S2 X-Coremail-Antispam: 1Uf129KBjvAXoWfXFy3Zr4DAr15Zry5Gw4UJwb_yoW8tw1Uuo Z3ZFZrGr47Cr17WFnayr1fCr47Jryv9r48Zr18JryUAw1vqF43Ja4YvayUZF42kr4jkrn8 Gr95u39xAayqyF4rn29KB7ZKAUJUUUU8529EdanIXcx71UUUUU7v73VFW2AGmfu7bjvjm3 AaLaJ3UbIYCTnIWIevJa73UjIFyTuYvjxU0BTYDUUUU X-Originating-IP: [218.92.14.78] X-CM-SenderInfo: 5wxpt2lkx6il2tof0z/1tbiRRm-1GdqBK6k7gAAsa X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+larch=yhetil.org@gnu.org Sender: guix-patches-bounces+larch=yhetil.org@gnu.org X-Migadu-Flow: FLOW_IN X-Migadu-Country: US X-Migadu-Scanner: mx12.migadu.com X-Migadu-Spam-Score: 5.99 X-Spam-Score: 5.99 X-Migadu-Queue-Id: 6B2C05F71 X-TUID: wKDvPqIQHOSh >From 4bfdb9f1db0c0c23d57c68691f0fe36d6e3823f4 Mon Sep 17 00:00:00 2001 From: Feng Shu Date: Mon, 23 Dec 2024 19:30:28 +0800 Subject: [PATCH v2] Add lightdm-greeter-general-configuration and do not hard code config type name everywhere. * gnu/services/lightdm.scm (gnu): Use (ice-9 local-eval), export new option variables. (local-eval-environment?): New variable. (string): Move. (lightdm-gtk-greeter-configuration): Add local-eval-environment, greeter-session-name, greeter-package, greeter-config-name fields. (lightdm-greeter-general-configuration): New variable. (strip-record-type-name-brackets): Return string instead symbol. (config->type-name): Rename from config->name. (greeter-configuration-field): New function. (greeter-configuration->greeter-fields): Do not hard code greeter configuation name. (greeter-configuration->packages): Do not hard code greeter configuation name. (greeter-configuration->conf-name): Improve. (greeter-configuration->session-name): New variable. (greeter-configuration->file): Call different function based config type. (greeter-configuration->file/lightdm-gtk-greeter-configuration) (greeter-configuration->file/lightdm-greeter-general-configuration): New functions. (greeter-configuration-valid?): New function. (greeter-session?): Do not hard code greeter configuation name. (greeter-session->greater-configuration-pred) (greeter-configuration->greeter-session): Removed. (greeter-configuration?): Do not hard code greeter configuation name. (lightdm-configuration): Add lightdm-greeter-general-configuration. (validate-lightdm-configuration): Do not use greeter-session->greater-configuration-pred. (generate-doc): Handle lightdm-greeter-general-configuration. * doc/guix.texi (X Window): Improve lightdm-gtk-greeter-configuration options doc, Add lightdm-greeter-general-configuration, Change-Id: Iae22cd641454c86280e88d6986594ad0c8f4c490 --- doc/guix.texi | 94 ++++++++++++++++- gnu/services/lightdm.scm | 221 +++++++++++++++++++++++++++------------ 2 files changed, 246 insertions(+), 69 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 31deb5b003..e1f1fee68b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -23802,8 +23802,7 @@ In its most basic form, it can be used simply as: (service lightdm-service-type) @end lisp -A more elaborate example making use of the VNC capabilities and enabling -more features and verbose logs could look like: +Two more elaborate examples look like below: @lisp (service lightdm-service-type @@ -23819,6 +23818,38 @@ more features and verbose logs could look like: (name "*") (user-session "ratpoison")))))) @end lisp + +@lisp +(service lightdm-service-type + (lightdm-configuration + (greeters + (list (lightdm-greeter-general-configuration + (greeter-package lightdm-mini-greeter) + (greeter-session-name "lightdm-mini-greeter") + (greeter-config-name "lightdm-mini-greeter.conf") + (config (list "[greeter]" + "user = guest"))) + (lightdm-gtk-greeter-configuration + (extra-config + (list "font-name = San 10" + "xft-dpi = 140" + "clock-format = %Y-%m-%d %H:%M" + ;; We need to use "~~" to generate a tilde, for + ;; extra-config sting will be handle as + ;; control-string of format function. + "indicators = ~~host;~~spacer;~~session;~~a11y;~~clock;~~power"))))) + (seats + (list (lightdm-seat-configuration + (name "*") + (greeter-session 'lightdm-mini-greeter)))) + (xorg-configuration + (xorg-configuration + (server-arguments + (append %default-xorg-server-arguments + '("-dpi" "140"))))))) +@end lisp + + @end defvar @c The LightDM service documentation can be auto-generated via the @@ -23903,8 +23934,21 @@ Extra configuration values to append to the LightDM configuration file. Available @code{lightdm-gtk-greeter-configuration} fields are: @table @asis +@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment) +Recode the environment where lightdm-gtk-greeter-configuration is defined. + @item @code{lightdm-gtk-greeter} (default: @code{lightdm-gtk-greeter}) (type: file-like) -The lightdm-gtk-greeter package to use. +The lightdm-gtk-greeter package to use, this option is keeped for +compatibility, use greeter-package instead. + +@item @code{greeter-package} (default: @code{lightdm-gtk-greeter}) (type: file-like) +The greeter package to use. + +@item @code{greeter-session-name} (default: @code{lightdm-gtk-greeter}) (type: string) +The session name used in lightdm.conf. + +@item @code{greeter-config-name} (default: @code{lightdm-gtk-greeter.conf}) (type: string) +The greeter config file name in /etc/lightdm directory. @item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes) The list of packages complementing the greeter, such as package @@ -23948,6 +23992,50 @@ configuration file. @c %end of fragment @c %start of fragment +@deftp {Data Type} lightdm-greeter-general-configuration + +@code{lightdm-greeter-general-configuration} support all text config +greeters which have no build-in configuration type like +@code{lightdm-gtk-greeter-configuration}, such as lightdm-mini-greeter, +for example: + +@lisp +(lightdm-greeter-general-configuration + (greeter-package lightdm-mini-greeter) + (greeter-session-name "lightdm-mini-greeter") + (greeter-config-name "lightdm-mini-greeter.conf") + (config (list "[greeter]" + "user = guest"))) +@end lisp + +Available @code{lightdm-greeter-general-configuration} fields are: + +@table @asis +@item @code{local-eval-environment} (default: @code{(the-environment)}) (type: local-eval-environment) +Recode the environment where lightdm-greeter-general-configuration is defined. + +@item @code{greeter-package} (type: maybe-file-like) +The greeter package to use. + +@item @code{greeter-session-name} (type: maybe-string) +The session name used in lightdm.conf. + +@item @code{greeter-config-name} (type: maybe-string) +The greeter config file name in /etc/lightdm directory. + +@item @code{assets} (default: @code{(adwaita-icon-theme gnome-themes-extra hicolor-icon-theme)}) (type: list-of-file-likes) +The list of packages complementing the greeter, such as package +providing icon themes. + +@item @code{config} (default: @code{'()}) (type: list-of-strings) +Configuration values of the LightDM Greeter configuration file. + +@end table +@end deftp + +@c %end of fragment +@c %start of fragment + @deftp {Data Type} lightdm-seat-configuration Available @code{lightdm-seat-configuration} fields are: diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm index 191cb5635b..035ea41c70 100644 --- a/gnu/services/lightdm.scm +++ b/gnu/services/lightdm.scm @@ -39,6 +39,7 @@ (define-module (gnu services lightdm) #:use-module (guix i18n) #:use-module (guix records) #:use-module (ice-9 format) + #:use-module (ice-9 local-eval) #:use-module (ice-9 match) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) @@ -56,7 +57,10 @@ (define-module (gnu services lightdm) lightdm-gtk-greeter-configuration lightdm-gtk-greeter-configuration? lightdm-gtk-greeter-configuration-lightdm-gtk-greeter + lightdm-gtk-greeter-configuration-greeter-package lightdm-gtk-greeter-configuration-assets + lightdm-gtk-greeter-configuration-greeter-config-name + lightdm-gtk-greeter-configuration-greeter-session-name lightdm-gtk-greeter-configuration-theme-name lightdm-gtk-greeter-configuration-icon-theme-name lightdm-gtk-greeter-configuration-cursor-theme-name @@ -66,6 +70,14 @@ (define-module (gnu services lightdm) lightdm-gtk-greeter-configuration-reader lightdm-gtk-greeter-configuration-extra-config + lightdm-greeter-general-configuration + lightdm-greeter-general-configuration? + lightdm-greeter-general-configuration-greeter-package + lightdm-greeter-general-configuration-assets + lightdm-greeter-general-configuration-greeter-config-name + lightdm-greeter-general-configuration-greeter-session-name + lightdm-greeter-general-configuration-config + lightdm-configuration lightdm-configuration? lightdm-configuration-lightdm @@ -87,6 +99,9 @@ (define-module (gnu services lightdm) ;;; Greeters. ;;; +(define (local-eval-environment? value) + #t) + (define list-of-file-likes? (list-of file-like?)) @@ -117,6 +132,8 @@ (define (serialize-file-like name value) (define (serialize-list-of-a11y-states name value) (format #f "~a=~a~%" name (string-join (map symbol->string value) ";"))) +(define-maybe string) + (define (serialize-string name value) (format #f "~a=~a~%" name value)) @@ -127,9 +144,21 @@ (define (serialize-list-of-strings _ value) (string-join value "\n")) (define-configuration lightdm-gtk-greeter-configuration + (local-eval-environment + (local-eval-environment (the-environment)) + "Recode the environment where lightdm-gtk-greeter-configuration is defined." + empty-serializer) + (greeter-session-name + (string "lightdm-gtk-greeter") + "Session name used in lightdm.conf" + empty-serializer) (lightdm-gtk-greeter + maybe-file-like + "Keep it for compatibility, use greeter-package field instead." + empty-serializer) + (greeter-package (file-like lightdm-gtk-greeter) - "The lightdm-gtk-greeter package to use." + "The greeter package to use." empty-serializer) (assets (list-of-file-likes (list adwaita-icon-theme @@ -140,6 +169,10 @@ (define-configuration lightdm-gtk-greeter-configuration "The list of packages complementing the greeter, such as package providing icon themes." empty-serializer) + (greeter-config-name + (string "lightdm-gtk-greeter.conf") + "Greeter config file name in /etc/lightdm directory." + empty-serializer) (theme-name (string "Adwaita") "The name of the theme to use.") @@ -176,34 +209,77 @@ (define-configuration lightdm-gtk-greeter-configuration "Extra configuration values to append to the LightDM GTK Greeter configuration file.")) +(define-configuration lightdm-greeter-general-configuration + (local-eval-environment + (local-eval-environment (the-environment)) + "Recode the environment where lightdm-greeter-general-configuration is defined." + empty-serializer) + (greeter-package + maybe-file-like + "The 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) + (greeter-config-name + maybe-string + "Greeter config file name in /etc/lightdm directory." + empty-serializer) + (greeter-session-name + maybe-string + "Session name used in lightdm.conf" + empty-serializer) + (config + (list-of-strings '()) + "Configuration values of the LightDM Greeter configuration file.")) + (define (strip-record-type-name-brackets name) "Remove the '<' and '>' brackets from NAME, a symbol." (let ((name (symbol->string name))) (if (and (string-prefix? "<" name) (string-suffix? ">" name)) - (string->symbol (string-drop (string-drop-right name 1) 1)) + (string-drop (string-drop-right name 1) 1) (error "unexpected record type name" name)))) -(define (config->name config) - "Return the constructor name (a symbol) from CONFIG." +(define (config->type-name config) + "Return the type name of CONFIG." (strip-record-type-name-brackets (record-type-name (struct-vtable config)))) +(define (greeter-configuration-field config field) + "Return field value of config." + (let ((rtd (struct-vtable config))) + ((record-accessor rtd field) config))) + +(define (greeter-configuration->session-name config) + "Return the session name of CONFIG, a greeter configuration." + (greeter-configuration-field config 'greeter-session-name)) + (define (greeter-configuration->greeter-fields config) "Return the fields of CONFIG, a greeter configuration." - (match config - ;; Note: register any new greeter configuration here. - ((? lightdm-gtk-greeter-configuration?) - lightdm-gtk-greeter-configuration-fields))) + (let* ((type-name (config->type-name config)) + (variable (string->symbol (string-append type-name "-fields"))) + (eval-env (greeter-configuration-field config 'local-eval-environment))) + (local-eval variable eval-env))) (define (greeter-configuration->packages config) "Return the list of greeter packages, including assets, used by CONFIG, a greeter configuration." - (match config - ;; Note: register any new greeter configuration here. - ((? lightdm-gtk-greeter-configuration?) - (cons (lightdm-gtk-greeter-configuration-lightdm-gtk-greeter config) - (lightdm-gtk-greeter-configuration-assets config))))) + (filter file-like? + (cons + (if (eq? (config->type-name config) 'lightdm-gtk-greeter-configuration) + ;; Handle lightdm-gtk-greeter field for keeping it for compatibility. + (if (file-like? (greeter-configuration-field config 'lightdm-gtk-greeter)) + (greeter-configuration-field config 'lightdm-gtk-greeter) + (greeter-configuration-field config 'greeter-package)) + (greeter-configuration-field config 'greeter-package)) + (greeter-configuration-field config 'assets)))) ;;; TODO: Implement directly in (gnu services configuration), perhaps by ;;; making the FIELDS argument optional. @@ -215,11 +291,19 @@ (define fields (greeter-configuration->greeter-fields config)) (define (greeter-configuration->conf-name config) "Return the file name of CONFIG, a greeter configuration." - (format #f "~a.conf" (greeter-configuration->greeter-session config))) + (greeter-configuration-field config 'greeter-config-name)) (define (greeter-configuration->file config) "Serialize CONFIG into a file under the output directory, so that it can be easily added to XDG_CONF_DIRS." + (let* ((type-name (config->type-name config)) + (func-name (string->symbol + (string-append + "greeter-configuration->file/" type-name))) + (eval-env (greeter-configuration-field config 'local-eval-environment))) + (local-eval `(,func-name ,config) eval-env))) + +(define (greeter-configuration->file/lightdm-gtk-greeter-configuration config) (computed-file (greeter-configuration->conf-name config) #~(begin @@ -229,6 +313,23 @@ (define (greeter-configuration->file config) "[greeter]\n" #$(serialize-configuration* config)))))))) +(define (greeter-configuration->file/lightdm-greeter-general-configuration config) + (computed-file + (greeter-configuration->conf-name config) + #~(begin + (call-with-output-file #$output + (lambda (port) + (format port #$(serialize-configuration* config))))))) + +(define (greeter-configuration-valid? config) + "Check greeter-configuration CONFIG valid or not." + (let ((conf-name (greeter-configuration->conf-name config)) + (session-name (greeter-configuration->session-name config))) + (and (string? conf-name) + (string? session-name) + (> (string-length conf-name) 0) + (> (string-length session-name) 0)))) + ;;; ;;; Seats. @@ -248,15 +349,14 @@ (define (serialize-seat-type name value) (define-maybe seat-type) (define (greeter-session? value) - (memq value '(lightdm-gtk-greeter))) + (and (symbol? value) + (string-contains (symbol->string value) "-greeter" ))) (define (serialize-greeter-session name value) (format #f "~a=~a~%" name value)) (define-maybe greeter-session) -(define-maybe string) - ;;; Note: all the fields except for the seat name should be 'maybe's, since ;;; the real default value is set by the %lightdm-seat-default define later, ;;; and this avoids repeating ourselves in the serialized configuration file. @@ -291,22 +391,6 @@ (define-configuration lightdm-seat-configuration (list-of-strings '()) "Extra configuration values to append to the seat configuration section.")) -(define (greeter-session->greater-configuration-pred identifier) - "Return the predicate to check if a configuration is of the type specifying -a greeter identified by IDENTIFIER." - (match identifier - ;; Note: register any new greeter identifier here. - ('lightdm-gtk-greeter - lightdm-gtk-greeter-configuration?))) - -(define (greeter-configuration->greeter-session config) - "Given CONFIG, a greeter configuration object, return its identifier, -a symbol." - (let ((suffix "-configuration") - (greeter-conf-name (config->name config))) - (string->symbol (string-drop-right (symbol->string greeter-conf-name) - (string-length suffix))))) - (define list-of-seat-configurations? (list-of lightdm-seat-configuration?)) @@ -316,20 +400,17 @@ (define list-of-seat-configurations? ;;; (define (greeter-configuration? config) - (or (lightdm-gtk-greeter-configuration? config) - ;; Note: register any new greeter configuration here. - )) + ((record-predicate (struct-vtable config)) config)) (define (list-of-greeter-configurations? greeter-configs) (and ((list-of greeter-configuration?) greeter-configs) ;; Greeter configurations must also not be provided more than once. - (let* ((types (map (compose record-type-name struct-vtable) - greeter-configs)) - (dupes (filter (lambda (type) - (< 1 (count (cut eq? type <>) types))) - types))) + (let* ((conf-names (map greeter-configuration->conf-name greeter-configs)) + (dupes (filter (lambda (conf-name) + (< 1 (count (cut eq? conf-name <>) conf-names))) + conf-names))) (unless (null? dupes) - (leave (G_ "duplicate greeter configurations: ~a~%") dupes))))) + (leave (G_ "Duplicate greeter configurations: ~a~%") dupes))))) (define-configuration/no-serialization lightdm-configuration (lightdm @@ -347,7 +428,9 @@ (define-configuration/no-serialization lightdm-configuration start script. It can be refined per seat via the @code{xserver-command} of the @code{} record, if desired.") (greeters - (list-of-greeter-configurations (list (lightdm-gtk-greeter-configuration))) + (list-of-greeter-configurations + (list (lightdm-gtk-greeter-configuration) + (lightdm-greeter-general-configuration))) "The LightDM greeter configurations specifying the greeters to use.") (seats (list-of-seat-configurations (list (lightdm-seat-configuration @@ -417,8 +500,11 @@ (define (validate-lightdm-configuration config) (missing-greeters (filter-map (lambda (id) - (define pred (greeter-session->greater-configuration-pred id)) - (if (find pred greeter-configurations) + (if (find (lambda (greeter-config) + (let* ((id (symbol->string id)) + (name (greeter-configuration->session-name greeter-config))) + (equal? id name))) + greeter-configurations) #f ;happy path id)) greeter-sessions))) @@ -428,10 +514,11 @@ (define pred (greeter-session->greater-configuration-pred id)) (define (lightdm-configuration-file config) (match-record config - (xorg-configuration seats - xdmcp? xdmcp-listen-address - vnc-server? vnc-server-command vnc-server-listen-address vnc-server-port - extra-config) + (xorg-configuration + seats xdmcp? xdmcp-listen-address + vnc-server? vnc-server-command + vnc-server-listen-address vnc-server-port + extra-config) (apply mixed-text-file "lightdm.conf" " @@ -470,22 +557,22 @@ (define (lightdm-configuration-file config) # Seat configuration. # " - (map (lambda (seat) - ;; This complication exists to propagate a default value for - ;; the 'xserver-command' field of the seats. Having a - ;; 'xorg-configuration' field at the root of the - ;; lightdm-configuration enables the use of - ;; 'set-xorg-configuration' and can be more convenient. - (let ((seat* (if (maybe-value-set? - (lightdm-seat-configuration-xserver-command seat)) - seat - (lightdm-seat-configuration - (inherit seat) - (xserver-command (xorg-start-command - xorg-configuration)))))) - (serialize-configuration seat* - lightdm-seat-configuration-fields))) - seats)))) + (map (lambda (seat) + ;; This complication exists to propagate a default value for + ;; the 'xserver-command' field of the seats. Having a + ;; 'xorg-configuration' field at the root of the + ;; lightdm-configuration enables the use of + ;; 'set-xorg-configuration' and can be more convenient. + (let ((seat* (if (maybe-value-set? + (lightdm-seat-configuration-xserver-command seat)) + seat + (lightdm-seat-configuration + (inherit seat) + (xserver-command (xorg-start-command + xorg-configuration)))))) + (serialize-configuration seat* + lightdm-seat-configuration-fields))) + seats)))) (define (lightdm-configuration-directory config) "Return a directory containing the serialized lightdm configuration @@ -495,7 +582,8 @@ (define (lightdm-configuration-directory config) (map (lambda (g) `(,(greeter-configuration->conf-name g) ,(greeter-configuration->file g))) - (lightdm-configuration-greeters config))))) + (filter greeter-configuration-valid? + (lightdm-configuration-greeters config)))))) (define %lightdm-accounts (list (user-group (name "lightdm") (system? #t)) @@ -676,4 +764,5 @@ (define lightdm-service-type (define (generate-doc) (configuration->documentation 'lightdm-configuration) (configuration->documentation 'lightdm-gtk-greeter-configuration) + (configuration->documentation 'lightdm-greeter-general-configuration) (configuration->documentation 'lightdm-seat-configuration)) -- 2.45.2 --