diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/dbus.scm | 94 | ||||
| -rw-r--r-- | gnu/services/desktop.scm | 93 | ||||
| -rw-r--r-- | gnu/services/dict.scm | 20 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 71 | ||||
| -rw-r--r-- | gnu/services/version-control.scm | 141 |
5 files changed, 285 insertions, 134 deletions
diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 876f56d45f..26390a4acd 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -21,7 +21,9 @@ #:use-module (gnu services) #:use-module (gnu services shepherd) #:use-module (gnu system shadow) + #:use-module (gnu system pam) #:use-module ((gnu packages glib) #:select (dbus)) + #:use-module (gnu packages polkit) #:use-module (gnu packages admin) #:use-module (guix gexp) #:use-module (guix records) @@ -30,7 +32,10 @@ #:export (dbus-configuration dbus-configuration? dbus-root-service-type - dbus-service)) + dbus-service + + polkit-service-type + polkit-service)) ;;; ;;; D-Bus. @@ -218,4 +223,91 @@ and policy files. For example, to allow avahi-daemon to use the system bus, (dbus-configuration (dbus dbus) (services services)))) + +;;; +;;; Polkit privilege management service. +;;; + +(define-record-type* <polkit-configuration> + polkit-configuration make-polkit-configuration + polkit-configuration? + (polkit polkit-configuration-polkit ;<package> + (default polkit)) + (actions polkit-configuration-actions ;list of <package> + (default '()))) + +(define %polkit-accounts + (list (user-group (name "polkitd") (system? #t)) + (user-account + (name "polkitd") + (group "polkitd") + (system? #t) + (comment "Polkit daemon user") + (home-directory "/var/empty") + (shell "/run/current-system/profile/sbin/nologin")))) + +(define %polkit-pam-services + (list (unix-pam-service "polkit-1"))) + +(define (polkit-directory packages) + "Return a directory containing an @file{actions} and possibly a +@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}." + (with-imported-modules '((guix build union)) + (computed-file "etc-polkit-1" + #~(begin + (use-modules (guix build union) (srfi srfi-26)) + + (union-build #$output + (map (cut string-append <> + "/share/polkit-1") + (list #$@packages))))))) + +(define polkit-etc-files + (match-lambda + (($ <polkit-configuration> polkit packages) + `(("polkit-1" ,(polkit-directory (cons polkit packages))))))) + +(define polkit-setuid-programs + (match-lambda + (($ <polkit-configuration> polkit) + (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1") + (file-append polkit "/bin/pkexec"))))) + +(define polkit-service-type + (service-type (name 'polkit) + (extensions + (list (service-extension account-service-type + (const %polkit-accounts)) + (service-extension pam-root-service-type + (const %polkit-pam-services)) + (service-extension dbus-root-service-type + (compose + list + polkit-configuration-polkit)) + (service-extension etc-service-type + polkit-etc-files) + (service-extension setuid-program-service-type + polkit-setuid-programs))) + + ;; Extensions are lists of packages that provide polkit rules + ;; or actions under share/polkit-1/{actions,rules.d}. + (compose concatenate) + (extend (lambda (config actions) + (polkit-configuration + (inherit config) + (actions + (append (polkit-configuration-actions config) + actions))))))) + +(define* (polkit-service #:key (polkit polkit)) + "Return a service that runs the +@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege +management service}, which allows system administrators to grant access to +privileged operations in a structured way. By querying the Polkit service, a +privileged system component can know when it should grant additional +capabilities to ordinary users. For example, an ordinary user can be granted +the capability to suspend the system if the user is logged in locally." + (service polkit-service-type + (polkit-configuration (polkit polkit)))) + ;;; dbus.scm ends here diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index dfd1ea6e92..7555780ade 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -37,7 +37,6 @@ #:use-module (gnu packages gnome) #:use-module (gnu packages xfce) #:use-module (gnu packages avahi) - #:use-module (gnu packages polkit) #:use-module (gnu packages xdisorg) #:use-module (gnu packages suckless) #:use-module (gnu packages linux) @@ -68,11 +67,6 @@ bluetooth-service - polkit-configuration - polkit-configuration? - polkit-service - polkit-service-type - elogind-configuration elogind-configuration? elogind-service @@ -415,93 +409,6 @@ Users need to be in the @code{lp} group to access the D-Bus service. ;;; -;;; Polkit privilege management service. -;;; - -(define-record-type* <polkit-configuration> - polkit-configuration make-polkit-configuration - polkit-configuration? - (polkit polkit-configuration-polkit ;<package> - (default polkit)) - (actions polkit-configuration-actions ;list of <package> - (default '()))) - -(define %polkit-accounts - (list (user-group (name "polkitd") (system? #t)) - (user-account - (name "polkitd") - (group "polkitd") - (system? #t) - (comment "Polkit daemon user") - (home-directory "/var/empty") - (shell "/run/current-system/profile/sbin/nologin")))) - -(define %polkit-pam-services - (list (unix-pam-service "polkit-1"))) - -(define (polkit-directory packages) - "Return a directory containing an @file{actions} and possibly a -@file{rules.d} sub-directory, for use as @file{/etc/polkit-1}." - (with-imported-modules '((guix build union)) - (computed-file "etc-polkit-1" - #~(begin - (use-modules (guix build union) (srfi srfi-26)) - - (union-build #$output - (map (cut string-append <> - "/share/polkit-1") - (list #$@packages))))))) - -(define polkit-etc-files - (match-lambda - (($ <polkit-configuration> polkit packages) - `(("polkit-1" ,(polkit-directory (cons polkit packages))))))) - -(define polkit-setuid-programs - (match-lambda - (($ <polkit-configuration> polkit) - (list (file-append polkit "/lib/polkit-1/polkit-agent-helper-1") - (file-append polkit "/bin/pkexec"))))) - -(define polkit-service-type - (service-type (name 'polkit) - (extensions - (list (service-extension account-service-type - (const %polkit-accounts)) - (service-extension pam-root-service-type - (const %polkit-pam-services)) - (service-extension dbus-root-service-type - (compose - list - polkit-configuration-polkit)) - (service-extension etc-service-type - polkit-etc-files) - (service-extension setuid-program-service-type - polkit-setuid-programs))) - - ;; Extensions are lists of packages that provide polkit rules - ;; or actions under share/polkit-1/{actions,rules.d}. - (compose concatenate) - (extend (lambda (config actions) - (polkit-configuration - (inherit config) - (actions - (append (polkit-configuration-actions config) - actions))))))) - -(define* (polkit-service #:key (polkit polkit)) - "Return a service that runs the -@uref{http://www.freedesktop.org/wiki/Software/polkit/, Polkit privilege -management service}, which allows system administrators to grant access to -privileged operations in a structured way. By querying the Polkit service, a -privileged system component can know when it should grant additional -capabilities to ordinary users. For example, an ordinary user can be granted -the capability to suspend the system if the user is logged in locally." - (service polkit-service-type - (polkit-configuration (polkit polkit)))) - - -;;; ;;; Colord D-Bus service. ;;; diff --git a/gnu/services/dict.scm b/gnu/services/dict.scm index da5d004701..303067037f 100644 --- a/gnu/services/dict.scm +++ b/gnu/services/dict.scm @@ -105,15 +105,17 @@ database { (chown rundir (passwd:uid user) (passwd:gid user))))) (define (dicod-shepherd-service config) - (list (shepherd-service - (provision '(dicod)) - (documentation "Run the dicod daemon.") - (start #~(make-forkexec-constructor - (list (string-append #$dico "/bin/dicod") "--foreground" - (string-append - "--config=" #$(dicod-configuration-file config))) - #:user "dicod" #:group "dicod")) - (stop #~(make-kill-destructor))))) + (let ((dicod (file-append (dicod-configuration-dico config) + "/bin/dicod")) + (dicod.conf (dicod-configuration-file config))) + (list (shepherd-service + (provision '(dicod)) + (documentation "Run the dicod daemon.") + (start #~(make-forkexec-constructor + (list #$dicod "--foreground" + (string-append "--config=" #$dicod.conf)) + #:user "dicod" #:group "dicod")) + (stop #~(make-kill-destructor)))))) (define dicod-service-type (service-type diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm index 2adde23789..bbb9053008 100644 --- a/gnu/services/networking.scm +++ b/gnu/services/networking.scm @@ -62,6 +62,7 @@ bitlbee-service bitlbee-service-type + wicd-service-type wicd-service network-manager-service connman-service @@ -112,21 +113,19 @@ fe80::1%lo0 apps.facebook.com\n") static-networking? (interface static-networking-interface) (ip static-networking-ip) + (netmask static-networking-netmask + (default #f)) (gateway static-networking-gateway) (provision static-networking-provision) - (name-servers static-networking-name-servers) - (net-tools static-networking-net-tools)) + (name-servers static-networking-name-servers)) (define static-networking-service-type (shepherd-service-type 'static-networking (match-lambda - (($ <static-networking> interface ip gateway provision - name-servers net-tools) + (($ <static-networking> interface ip netmask gateway provision + name-servers) (let ((loopback? (memq 'loopback provision))) - - ;; TODO: Eventually replace 'route' with bindings for the appropriate - ;; ioctls. (shepherd-service ;; Unless we're providing the loopback interface, wait for udev to be up @@ -139,18 +138,28 @@ fe80::1%lo0 apps.facebook.com\n") (start #~(lambda _ ;; Return #t if successfully started. (let* ((addr (inet-pton AF_INET #$ip)) - (sockaddr (make-socket-address AF_INET addr 0))) + (sockaddr (make-socket-address AF_INET addr 0)) + (mask (and #$netmask + (inet-pton AF_INET #$netmask))) + (maskaddr (and mask + (make-socket-address AF_INET + mask 0))) + (gateway (and #$gateway + (inet-pton AF_INET #$gateway))) + (gatewayaddr (and gateway + (make-socket-address AF_INET + gateway 0)))) (configure-network-interface #$interface sockaddr (logior IFF_UP #$(if loopback? #~IFF_LOOPBACK - 0)))) - #$(if gateway - #~(zero? (system* (string-append #$net-tools - "/sbin/route") - "add" "-net" "default" - "gw" #$gateway)) - #t) + 0)) + #:netmask maskaddr) + (when gateway + (let ((sock (socket AF_INET SOCK_DGRAM 0))) + (add-network-route/gateway sock gatewayaddr) + (close-port sock)))) + #$(if (pair? name-servers) #~(call-with-output-file "/etc/resolv.conf" (lambda (port) @@ -160,35 +169,34 @@ fe80::1%lo0 apps.facebook.com\n") (for-each (lambda (server) (format port "nameserver ~a~%" server)) - '#$name-servers))) + '#$name-servers) + #t)) #t))) (stop #~(lambda _ ;; Return #f is successfully stopped. (let ((sock (socket AF_INET SOCK_STREAM 0))) + (when #$gateway + (delete-network-route sock + (make-socket-address + AF_INET INADDR_ANY 0))) (set-network-interface-flags sock #$interface 0) - (close-port sock)) - (not #$(if gateway - #~(system* (string-append #$net-tools - "/sbin/route") - "del" "-net" "default") - #t)))) + (close-port sock) + #f))) (respawn? #f))))))) (define* (static-networking-service interface ip #:key - gateway + netmask gateway (provision '(networking)) - (name-servers '()) - (net-tools net-tools)) + (name-servers '())) "Return a service that starts @var{interface} with address @var{ip}. If -@var{gateway} is true, it must be a string specifying the default network -gateway." +@var{netmask} is true, use it as the network mask. If @var{gateway} is true, +it must be a string specifying the default network gateway." (service static-networking-service-type (static-networking (interface interface) (ip ip) - (gateway gateway) + (netmask netmask) (gateway gateway) (provision provision) - (name-servers name-servers) - (net-tools net-tools)))) + (name-servers name-servers)))) (define dhcp-client-service-type (shepherd-service-type @@ -674,7 +682,7 @@ and @command{wicd-curses} user interfaces." (list (shepherd-service (documentation "Run the NetworkManager.") (provision '(networking)) - (requirement '(user-processes dbus-system loopback)) + (requirement '(user-processes dbus-system wpa-supplicant loopback)) (start #~(make-forkexec-constructor (list (string-append #$network-manager "/sbin/NetworkManager") @@ -687,6 +695,7 @@ and @command{wicd-curses} user interfaces." (list (service-extension shepherd-root-service-type network-manager-shepherd-service) (service-extension dbus-root-service-type list) + (service-extension polkit-service-type list) (service-extension activation-service-type (const %network-manager-activation)) ;; Add network-manager to the system profile. diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm new file mode 100644 index 0000000000..107bc8e77a --- /dev/null +++ b/gnu/services/version-control.scm @@ -0,0 +1,141 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2016 ng0 <ng0@we.make.ritual.n0.is> +;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.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 services version-control) + #:use-module (gnu services) + #:use-module (gnu services base) + #:use-module (gnu services shepherd) + #:use-module (gnu system shadow) + #:use-module (gnu packages version-control) + #:use-module (gnu packages admin) + #:use-module (guix records) + #:use-module (guix gexp) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 match) + #:export (git-daemon-service + git-daemon-service-type + git-daemon-configuration + git-daemon-configuration?)) + +;;; Commentary: +;;; +;;; Version Control related services. +;;; +;;; Code: + + +;;; +;;; Git daemon. +;;; + +(define-record-type* <git-daemon-configuration> + git-daemon-configuration + make-git-daemon-configuration + git-daemon-configuration? + (package git-daemon-configuration-package ;package + (default git)) + (export-all? git-daemon-configuration-export-all ;boolean + (default #f)) + (base-path git-daemon-configuration-base-path ;string | #f + (default "/srv/git")) + (user-path git-daemon-configuration-user-path ;string | #f + (default #f)) + (listen git-daemon-configuration-listen ;list of string + (default '())) + (port git-daemon-configuration-port ;number | #f + (default #f)) + (whitelist git-daemon-configuration-whitelist ;list of string + (default '())) + (extra-options git-daemon-configuration-extra-options ;list of string + (default '()))) + +(define git-daemon-shepherd-service + (match-lambda + (($ <git-daemon-configuration> + package export-all? base-path user-path + listen port whitelist extra-options) + (let* ((git (file-append package "/bin/git")) + (command `(,git + "daemon" "--syslog" "--reuseaddr" + ,@(if export-all? + '("--export-all") + '()) + ,@(if base-path + `(,(string-append "--base-path=" base-path)) + '()) + ,@(if user-path + `(,(string-append "--user-path=" user-path)) + '()) + ,@(map (cut string-append "--listen=" <>) listen) + ,@(if port + `(,(string-append + "--port=" (number->string port))) + '()) + ,@extra-options + ,@whitelist))) + (list (shepherd-service + (documentation "Run the git-daemon.") + (requirement '(networking)) + (provision '(git-daemon)) + (start #~(make-forkexec-constructor '#$command + #:user "git-daemon" + #:group "git-daemon")) + (stop #~(make-kill-destructor)))))))) + +(define %git-daemon-accounts + ;; User account and group for git-daemon. + (list (user-group + (name "git-daemon") + (system? #t)) + (user-account + (name "git-daemon") + (system? #t) + (group "git-daemon") + (comment "Git daemon user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) + +(define (git-daemon-activation config) + "Return the activation gexp for git-daemon using CONFIG." + (let ((base-path (git-daemon-configuration-base-path config))) + #~(begin + (use-modules (guix build utils)) + ;; Create the 'base-path' directory when it's not '#f'. + (and=> #$base-path mkdir-p)))) + +(define git-daemon-service-type + (service-type + (name 'git-daemon) + (extensions + (list (service-extension shepherd-root-service-type + git-daemon-shepherd-service) + (service-extension account-service-type + (const %git-daemon-accounts)) + (service-extension activation-service-type + git-daemon-activation))))) + +(define* (git-daemon-service #:key (config (git-daemon-configuration))) + "Return a service that runs @command{git daemon}, a simple TCP server to +expose repositories over the Git protocol for annoymous access. + +The optional @var{config} argument should be a +@code{<git-daemon-configuration>} object, by default it allows read-only +access to exported repositories under @file{/srv/git}." + (service git-daemon-service-type config)) |