(define-module (gnu services networking)
#:use-module (gnu services)
- #:use-module (gnu services dmd)
+ #:use-module (gnu services shepherd)
#:use-module (gnu services dbus)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
#:use-module (gnu packages gnome)
#:use-module (guix gexp)
#: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 (%facebook-host-aliases
dhcp-client-service
%ntp-servers
ntp-service
+ tor-hidden-service
tor-service
bitlbee-service
wicd-service
(net-tools static-networking-net-tools))
(define static-networking-service-type
- (dmd-service-type
+ (shepherd-service-type
'static-networking
(match-lambda
(($ <static-networking> interface ip gateway provision
;; TODO: Eventually replace 'route' with bindings for the appropriate
;; ioctls.
- (dmd-service
+ (shepherd-service
;; Unless we're providing the loopback interface, wait for udev to be up
;; and running so that INTERFACE is actually usable.
(net-tools net-tools))))
(define dhcp-client-service-type
- (dmd-service-type
+ (shepherd-service-type
'dhcp-client
(lambda (dhcp)
(define dhclient
(define pid-file
"/var/run/dhclient.pid")
- (dmd-service
+ (shepherd-service
(documentation "Set up networking via DHCP.")
(requirement '(user-processes udev))
(default ntp))
(servers ntp-configuration-servers))
-(define ntp-dmd-service
+(define ntp-shepherd-service
(match-lambda
(($ <ntp-configuration> ntp servers)
(let ()
(define ntpd.conf
(plain-file "ntpd.conf" config))
- (list (dmd-service
+ (list (shepherd-service
(provision '(ntpd))
(documentation "Run the Network Time Protocol (NTP) daemon.")
(requirement '(user-processes networking))
(define ntp-service-type
(service-type (name 'ntp)
(extensions
- (list (service-extension dmd-root-service-type
- ntp-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ ntp-shepherd-service)
(service-extension account-service-type
(const %ntp-accounts))))))
;;; Tor.
;;;
+(define-record-type* <tor-configuration>
+ tor-configuration make-tor-configuration
+ tor-configuration?
+ (tor tor-configuration-tor
+ (default tor))
+ (config-file tor-configuration-config-file)
+ (hidden-services tor-configuration-hidden-services
+ (default '())))
+
(define %tor-accounts
;; User account and groups for Tor.
(list (user-group (name "tor") (system? #t))
(home-directory "/var/empty")
(shell #~(string-append #$shadow "/sbin/nologin")))))
-(define (tor-dmd-service config)
- "Return a <dmd-service> running TOR."
+(define-record-type <hidden-service>
+ (hidden-service name mapping)
+ hidden-service?
+ (name hidden-service-name) ;string
+ (mapping hidden-service-mapping)) ;list of port/address tuples
+
+(define (tor-configuration->torrc config)
+ "Return a 'torrc' file for CONFIG."
+ (match config
+ (($ <tor-configuration> tor config-file services)
+ (computed-file
+ "torrc"
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (call-with-output-file #$output
+ (lambda (port)
+ (display "\
+# The beginning was automatically added.
+User tor
+DataDirectory /var/lib/tor
+Log notice syslog\n" port)
+
+ (for-each (match-lambda
+ ((service (ports hosts) ...)
+ (format port "\
+HiddenServiceDir /var/lib/tor/hidden-services/~a~%"
+ service)
+ (for-each (lambda (tcp-port host)
+ (format port "\
+HiddenServicePort ~a ~a~%"
+ tcp-port host))
+ ports hosts)))
+ '#$(map (match-lambda
+ (($ <hidden-service> name mapping)
+ (cons name mapping)))
+ services))
+
+ ;; Append the user's config file.
+ (call-with-input-file #$config-file
+ (lambda (input)
+ (dump-port input port)))
+ #t)))
+ #:modules '((guix build utils))))))
+
+(define (tor-shepherd-service config)
+ "Return a <shepherd-service> running TOR."
(match config
- ((tor config-file)
- (let ((torrc (computed-file "torrc"
- #~(begin
- (use-modules (guix build utils))
- (call-with-output-file #$output
- (lambda (port)
- (display "\
-User tor # automatically added\n" port)
- (call-with-input-file #$config-file
- (lambda (input)
- (dump-port input port)))
- #t)))
- #:modules '((guix build utils)))))
- (list (dmd-service
+ (($ <tor-configuration> tor)
+ (let ((torrc (tor-configuration->torrc config)))
+ (list (shepherd-service
(provision '(tor))
;; Tor needs at least one network interface to be up, hence the
;; dependency on 'loopback'.
- (requirement '(user-processes loopback))
+ (requirement '(user-processes loopback syslogd))
(start #~(make-forkexec-constructor
(list (string-append #$tor "/bin/tor") "-f" #$torrc)))
(stop #~(make-kill-destructor))
(documentation "Run the Tor anonymous network overlay.")))))))
+(define (tor-hidden-service-activation config)
+ "Return the activation gexp for SERVICES, a list of hidden services."
+ #~(begin
+ (use-modules (guix build utils))
+
+ (define %user
+ (getpw "tor"))
+
+ (define (initialize service)
+ (let ((directory (string-append "/var/lib/tor/hidden-services/"
+ service)))
+ (mkdir-p directory)
+ (chown directory (passwd:uid %user) (passwd:gid %user))
+
+ ;; The daemon bails out if we give wider permissions.
+ (chmod directory #o700)))
+
+ (mkdir-p "/var/lib/tor")
+ (chown "/var/lib/tor" (passwd:uid %user) (passwd:gid %user))
+ (chmod "/var/lib/tor" #o700)
+
+ (for-each initialize
+ '#$(map hidden-service-name
+ (tor-configuration-hidden-services config)))))
+
(define tor-service-type
(service-type (name 'tor)
(extensions
- (list (service-extension dmd-root-service-type
- tor-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ tor-shepherd-service)
(service-extension account-service-type
- (const %tor-accounts))))))
+ (const %tor-accounts))
+ (service-extension activation-service-type
+ tor-hidden-service-activation)))
+
+ ;; This can be extended with hidden services.
+ (compose concatenate)
+ (extend (lambda (config services)
+ (tor-configuration
+ (inherit config)
+ (hidden-services
+ (append (tor-configuration-hidden-services config)
+ services)))))))
(define* (tor-service #:optional
(config-file (plain-file "empty" ""))
networking daemon.
The daemon runs as the @code{tor} unprivileged user. It is passed
-@var{config-file}, a file-like object, with an additional @code{User tor}
-line. Run @command{man tor} for information about the configuration file."
- (service tor-service-type (list tor config-file)))
+@var{config-file}, a file-like object, with an additional @code{User tor} line
+and lines for hidden services added via @code{tor-hidden-service}. Run
+@command{man tor} for information about the configuration file."
+ (service tor-service-type
+ (tor-configuration (tor tor)
+ (config-file config-file))))
+
+(define tor-hidden-service-type
+ ;; A type that extends Tor with hidden services.
+ (service-type (name 'tor-hidden-service)
+ (extensions
+ (list (service-extension tor-service-type list)))))
+
+(define (tor-hidden-service name mapping)
+ "Define a new Tor @dfn{hidden service} called @var{name} and implementing
+@var{mapping}. @var{mapping} is a list of port/host tuples, such as:
+
+@example
+ '((22 \"127.0.0.1:22\")
+ (80 \"127.0.0.1:8080\"))
+@end example
+
+In this example, port 22 of the hidden service is mapped to local port 22, and
+port 80 is mapped to local port 8080.
+
+This creates a @file{/var/lib/tor/hidden-services/@var{name}} directory, where
+the @file{hostname} file contains the @code{.onion} host name for the hidden
+service.
+
+See @uref{https://www.torproject.org/docs/tor-hidden-service.html.en, the Tor
+project's documentation} for more information."
+ (service tor-hidden-service-type
+ (hidden-service name mapping)))
\f
;;;
(port bitlbee-configuration-port)
(extra-settings bitlbee-configuration-extra-settings))
-(define bitlbee-dmd-service
+(define bitlbee-shepherd-service
(match-lambda
(($ <bitlbee-configuration> bitlbee interface port extra-settings)
(let ((conf (plain-file "bitlbee.conf"
DaemonPort = " (number->string port) "
" extra-settings))))
- (list (dmd-service
+ (list (shepherd-service
(provision '(bitlbee))
(requirement '(user-processes loopback))
(start #~(make-forkexec-constructor
(define bitlbee-service-type
(service-type (name 'bitlbee)
(extensions
- (list (service-extension dmd-root-service-type
- bitlbee-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ bitlbee-shepherd-service)
(service-extension account-service-type
(const %bitlbee-accounts))
(service-extension activation-service-type
(copy-file (string-append #$wicd file-name)
file-name)))))
-(define (wicd-dmd-service wicd)
- "Return a dmd service for WICD."
- (list (dmd-service
+(define (wicd-shepherd-service wicd)
+ "Return a shepherd service for WICD."
+ (list (shepherd-service
(documentation "Run the Wicd network manager.")
(provision '(networking))
(requirement '(user-processes dbus-system loopback))
(define wicd-service-type
(service-type (name 'wicd)
(extensions
- (list (service-extension dmd-root-service-type
- wicd-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ wicd-shepherd-service)
(service-extension dbus-root-service-type
list)
(service-extension activation-service-type
(use-modules (guix build utils))
(mkdir-p "/etc/NetworkManager/system-connections")))
-(define (network-manager-dmd-service network-manager)
- "Return a dmd service for NETWORK-MANAGER."
- (list (dmd-service
+(define (network-manager-shepherd-service network-manager)
+ "Return a shepherd service for NETWORK-MANAGER."
+ (list (shepherd-service
(documentation "Run the NetworkManager.")
(provision '(networking))
(requirement '(user-processes dbus-system loopback))
(define network-manager-service-type
(service-type (name 'network-manager)
(extensions
- (list (service-extension dmd-root-service-type
- network-manager-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ network-manager-shepherd-service)
(service-extension dbus-root-service-type list)
(service-extension activation-service-type
(const %network-manager-activation))
HCoop / jackhill / guix / guix.git / blobdiff