summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
author宋文武 <iyzsong@gmail.com>2015-10-30 20:50:26 +0800
committer宋文武 <iyzsong@gmail.com>2015-10-30 20:50:26 +0800
commiteed588d9976367cac020d20de9a99d4bce0058b3 (patch)
tree449db39e73ec90151ec279ed1b403b189cabc2a0 /gnu/services
parent9fa8f436696598e783407b16f0e459791fdd9970 (diff)
parentb90e7e5d49e951a24f58d3cd29d37127982ef240 (diff)
Merge branch 'master' into dbus-update
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm22
-rw-r--r--gnu/services/desktop.scm6
-rw-r--r--gnu/services/xorg.scm55
3 files changed, 80 insertions, 3 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 336cc4dec9..604416b985 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -57,6 +57,7 @@
mingetty-configuration
mingetty-configuration?
mingetty-service
+ mingetty-service-type
%nscd-default-caches
%nscd-default-configuration
@@ -74,6 +75,7 @@
guix-configuration
guix-configuration?
guix-service
+ guix-service-type
%base-services))
@@ -142,6 +144,18 @@ FILE-SYSTEM."
(symbol-append 'file-system-
(string->symbol (file-system-mount-point file-system))))
+(define (mapped-device->dmd-service-name md)
+ "Return the symbol that denotes the dmd service of MD, a <mapped-device>."
+ (symbol-append 'device-mapping-
+ (string->symbol (mapped-device-target md))))
+
+(define dependency->dmd-service-name
+ (match-lambda
+ ((? mapped-device? md)
+ (mapped-device->dmd-service-name md))
+ ((? file-system? fs)
+ (file-system->dmd-service-name fs))))
+
(define file-system-service-type
;; TODO(?): Make this an extensible service that takes <file-system> objects
;; and returns a list of <dmd-service>.
@@ -158,7 +172,7 @@ FILE-SYSTEM."
(dmd-service
(provision (list (file-system->dmd-service-name file-system)))
(requirement `(root-file-system
- ,@(map file-system->dmd-service-name dependencies)))
+ ,@(map dependency->dmd-service-name dependencies)))
(documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args
;; FIXME: Use or factorize with 'mount-file-system'.
@@ -751,6 +765,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
(default #t))
(use-substitutes? guix-configuration-use-substitutes? ;Boolean
(default #t))
+ (substitute-urls guix-configuration-substitute-urls ;list of strings
+ (default %default-substitute-urls))
(extra-options guix-configuration-extra-options ;list of strings
(default '()))
(lsof guix-configuration-lsof ;<package>
@@ -765,7 +781,8 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
"Return a <dmd-service> for the Guix daemon service with CONFIG."
(match config
(($ <guix-configuration> guix build-group build-accounts authorize-key?
- use-substitutes? extra-options lsof lsh)
+ use-substitutes? substitute-urls extra-options
+ lsof lsh)
(list (dmd-service
(documentation "Run the Guix daemon.")
(provision '(guix-daemon))
@@ -777,6 +794,7 @@ failed to register hydra.gnu.org public key: ~a~%" status))))))))
#$@(if use-substitutes?
'()
'("--no-substitutes"))
+ "--substitute-urls" #$(string-join substitute-urls)
#$@extra-options)
;; Add 'lsof' (for the GC) and 'lsh' (for offloading) to the
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 87d3eaa1b0..166895663f 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -34,6 +34,8 @@
#:use-module (gnu packages gnome)
#:use-module (gnu packages avahi)
#:use-module (gnu packages polkit)
+ #:use-module (gnu packages xdisorg)
+ #:use-module (gnu packages suckless)
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix store)
@@ -599,6 +601,10 @@ when they log out."
;; List of services typically useful for a "desktop" use case.
(cons* (slim-service)
+ ;; Screen lockers are a pretty useful thing and these are small.
+ (screen-locker-service slock)
+ (screen-locker-service xlockmore "xlock")
+
;; The D-Bus clique.
(avahi-service)
(wicd-service)
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 3a57891a96..639a541777 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -32,16 +32,21 @@
#:use-module (gnu packages bash)
#:use-module (guix gexp)
#:use-module (guix store)
+ #:use-module (guix packages)
#:use-module (guix derivations)
#:use-module (guix records)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-9)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:export (xorg-configuration-file
xorg-start-command
%default-slim-theme
%default-slim-theme-name
- slim-service))
+ slim-service
+
+ screen-locker-service-type
+ screen-locker-service))
;;; Commentary:
;;;
@@ -350,4 +355,52 @@ theme."
(auto-login-session auto-login-session)
(startx startx))))
+
+;;;
+;;; Screen lockers & co.
+;;;
+
+(define-record-type <screen-locker>
+ (screen-locker name program empty?)
+ screen-locker?
+ (name screen-locker-name) ;string
+ (program screen-locker-program) ;gexp
+ (empty? screen-locker-allows-empty-passwords?)) ;Boolean
+
+(define screen-locker-pam-services
+ (match-lambda
+ (($ <screen-locker> name _ empty?)
+ (list (unix-pam-service name
+ #:allow-empty-passwords? empty?)))))
+
+(define screen-locker-setuid-programs
+ (compose list screen-locker-program))
+
+(define screen-locker-service-type
+ (service-type (name 'screen-locker)
+ (extensions
+ (list (service-extension pam-root-service-type
+ screen-locker-pam-services)
+ (service-extension setuid-program-service-type
+ screen-locker-setuid-programs)))))
+
+(define* (screen-locker-service package
+ #:optional
+ (program (package-name package))
+ #:key allow-empty-passwords?)
+ "Add @var{package}, a package for a screen-locker or screen-saver whose
+command is @var{program}, to the set of setuid programs and add a PAM entry
+for it. For example:
+
+@lisp
+(screen-locker-service xlockmore \"xlock\")
+@end lisp
+
+makes the good ol' XlockMore usable."
+ (service screen-locker-service-type
+ (screen-locker program
+ #~(string-append #$package
+ #$(string-append "/bin/" program))
+ allow-empty-passwords?)))
+
;;; xorg.scm ends here