Extract wsdd out of samba.scm, push modifications of wsdd.

	modified:   siguix/services/samba.scm
	new file:   siguix/services/wsdd.scm

1 files changed, 174 insertions, 0 deletions

diff --git a/siguix/services/wsdd.scm b/siguix/services/wsdd.scm
new file mode 100644
index 0000000..8b95755
--- /dev/null
+++ b/siguix/services/wsdd.scm
@@ -0,0 +1,174 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Simon Streit <simon@netpanic.org>
+;;;
+;;; This file is NOT 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 (services wsdd)
+
+  #:use-module (gnu packages)
+  #:use-module (gnu packages base)
+  #:use-module (gnu packages admin)
+
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services shepherd)
+  #:use-module (gnu services base)
+  #:use-module (gnu system shadow)
+
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (guix modules)
+  #:use-module (guix records)
+
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (srfi srfi-1)
+
+  #:use-module (siguix packages wsdd)   ;temp!
+
+  #:export (wsdd-service
+            wsdd-service-type
+            wsdd-configuration
+            wsdd-configuration?
+            wsdd-configuration-package
+            wsdd-configuration-ipv4only?
+            wsdd-configuration-ipv6only?
+            wsdd-configuration-chroot
+            wsdd-configuration-hoplimit
+            wsdd-configuration-interface
+            wsdd-configuration-uuid-device
+            wsdd-configuration-domain
+            wsdd-configuration-hostname
+            wsdd-configuration-preserve-case?
+            wsdd-configuration-workgroup))
+
+;;;
+;;; WSDD
+;;;
+
+(define-record-type* <wsdd-configuration>
+  wsdd-configuration
+  make-wsdd-configuration
+  wsdd-configuration?
+  (package               wsdd-configuration-package
+                         (default wsdd))
+  (ipv4only?             wsdd-configuration-ipv4only?
+                         (default #f))
+  (ipv6only?             wsdd-configuration-ipv6only?
+                         (default #f))
+  (chroot                wsdd-configuration-chroot
+                         (default #f))
+  (hoplimit              wsdd-configuration-hoplimit
+                         (default 1))
+  (interface             wsdd-configuration-interface
+                         (default #f))
+  (uuid-device           wsdd-configuration-uuid-device
+                         (default #f))
+  (domain                wsdd-configuration-domain
+                         (default #f))
+  (hostname              wsdd-configuration-hostname
+                         (default #f))
+  (preserve-case?        wsdd-configuration-preserve-case?
+                         (default #f))
+  (workgroup             wsdd-configuration-workgroup
+                         (default "WORKGROUP")))
+
+(define wsdd-accounts
+  (list
+   (user-group (name "wsdd"))
+   (user-account (name "wsdd")
+                 (group "wsdd")
+                 (comment "Web Service Discovery user")
+                 (home-directory "/var/empty")
+                 (shell (file-append shadow "/sbin/nologin")))))
+
+(define wsdd-shepherd-service
+  (match-lambda
+    (($ <wsdd-configuration> package
+                             ipv4only?
+                             ipv6only?
+                             chroot
+                             hoplimit
+                             interface
+                             uuid-device
+                             domain
+                             hostname
+                             preserve-case?
+                             workgroup
+                             )
+     (list (shepherd-service
+            (documentation "Run a Web Service Discovery service")
+            (provision '(wsdd))
+            (requirement '(networking))
+            (start #~(make-forkexec-constructor
+                      (list #$(file-append package "/bin/wsdd")
+                            #$@(if ipv4only?
+                                   #~("--ipv4only")
+                                   '())
+                            #$@(if ipv6only?
+                                   #~("--ipv6only")
+                                   '())
+                            #$@(if chroot
+                                   #~("--chroot" #$chroot)
+                                   '())
+                            #$@(if hoplimit
+                                   #~("--hoplimit" #$(number->string hoplimit))
+                                   '())
+
+                            ;; FIXME, this results into wrong type applied.
+                            ;; #$(if interface
+                            ;;       #~(for-each (lambda (arg)
+                            ;;                     (display (string-append "--interface" arg))
+                            ;;                     ;; (format #t "--interface ~a " (list->string arg))
+                            ;;                     )
+                            ;;                   #$(interface))
+                            ;;       '())
+
+                            #$@(if interface ;to be replaced by procedure above
+                                   #~("--interface" #$interface)
+                                   '())
+
+                            #$@(if uuid-device
+                                   #~("--uuid" #$uuid-device)
+                                   '())
+                            #$@(if domain
+                                   #~("--domain" #$domain)
+                                   '())
+                            #$@(if hostname
+                                   #~("--hostname" #$hostname)
+                                   '())
+                            #$@(if preserve-case?
+                                   #~("--preserve-case")
+                                   '())
+                            #$@(if workgroup
+                                   #~("--workgroup" #$workgroup)
+                                   '()))
+                      #:user "wsdd"
+                      #:group "wsdd"
+                      #:log-file "/var/log/wsdd.log"))
+            (stop #~(make-kill-destructor)))))))
+
+(define wsdd-service-type
+  (service-type
+   (name 'wsdd)
+   (description "Web Service Discovery Daemon")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             wsdd-shepherd-service)
+          (service-extension account-service-type
+                             (const wsdd-accounts))))
+   (default-value (wsdd-configuration))))