diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/dict.scm | 20 | ||||
| -rw-r--r-- | gnu/services/networking.scm | 68 | ||||
| -rw-r--r-- | gnu/services/version-control.scm | 141 |
3 files changed, 190 insertions, 39 deletions
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..5a83240d77 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 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)) |