services: Move wsdd-service declaration to samba.scm.

2 files changed, 193 insertions, 228 deletions

diff --git a/siguix/services/samba.scm b/siguix/services/samba.scm
index 464f57b..4aed53d 100644
--- a/siguix/services/samba.scm
+++ b/siguix/services/samba.scm
@@ -35,6 +35,9 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 textual-ports)
   #:use-module (srfi srfi-1)
+
+  #:use-module (siguix packages wsdd)   ;eventually move to guix
+
   #:export (samba-service
             samba-service-type
             samba-configuration
@@ -66,6 +69,29 @@
 
             ;; temp!
             samba-configuration-default-config-file
+
+            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-user
+            ;; wsdd-configuration-group
+            wsdd-configuration-uuid-device
+            ;; wsdd-configuration-verbose?
+            wsdd-configuration-domain
+            wsdd-configuration-hostname
+            ;; wsdd-configuration-no-host?
+            wsdd-configuration-preserve-case?
+            ;; wsdd-configuration-no-http?
+            wsdd-configuration-workgroup
+            ;; wsdd-configuration-discovery?
+            ;; wsdd-configuration-listen
             ))
 
 ;;; Commentary:
@@ -359,3 +385,170 @@
 ;; (let ((uid (passwd:uid (getpw "samba")))
 ;;       (gid (group:gid (getgr "samba"))))
 ;;   )
+
+
+;;;
+;;; WSDD
+;;;
+
+(define-record-type* <wsdd-configuration>
+  wsdd-configuration
+  make-wsdd-configuration
+  wsdd-configuration?
+  (package               wsdd-configuration-package
+                         (default wsdd))
+  (ipv4only?             wsdd-configuration-ipv4only? ;bolean
+                         (default #f))
+  (ipv6only?             wsdd-configuration-ipv6only? ;bolean
+                         (default #f))
+  (chroot                wsdd-configuration-chroot ;string
+                         (default #f))
+  (hoplimit              wsdd-configuration-hoplimit ;integer | 1
+                         (default 1))
+  (interface             wsdd-configuration-interface ;list of
+                                                      ;strings, and
+                                                      ;FIXME! This
+                                                      ;list is not
+                                                      ;expanded yet.
+                         (default #f))
+  ;; (user           wsdd-configuration-user
+  ;;                 (default '()))
+  ;; (group          wsdd-configuration-group
+  ;;                 (default '("nouser")))
+  (uuid-device           wsdd-configuration-uuid-device
+                         (default #f))
+  ;; (verbose?              wsdd-configuration-verbose? ;doesn't help in shepherd.
+  ;;                        (default #f))
+  (domain                wsdd-configuration-domain ;string
+                         (default #f))
+  (hostname              wsdd-configuration-hostname ;string
+                         (default #f))
+  ;; (no-host?              wsdd-configuration-no-host? ;bolean
+  ;;                        (default #f))
+  (preserve-case?        wsdd-configuration-preserve-case? ;bolean
+                         (default #f))
+  ;; (no-http?              wsdd-configuration-no-http? ;bolean
+  ;;                        (default #f))
+  (workgroup             wsdd-configuration-workgroup ;string
+                         (default "WORKGROUP"))
+
+  ;;; I don't think it makes sense to run it in discovery mode as a
+  ;;; service.
+
+  ;; (discovery?            wsdd-configuration-discovery? ;bolean
+  ;;                        (default #f))
+  ;; (listen                wsdd-configuration-listen ;string
+  ;;                        (default #f))
+  )
+
+(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
+                             ;; user
+                             ;; group
+                             uuid-device
+                             ;; verbose?
+                             domain
+                             hostname
+                             ;; no-host?
+                             preserve-case?
+                             ;; no-http?
+                             workgroup
+                             ;; discovery?
+                             ;; listen
+                             )
+     (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
+                                   ;; #~(string-append "--hoplimit" #$(number->string hoplimit))
+                                   #~("--hoplimit" #$(number->string hoplimit))
+                                   #~())
+
+                            #$@(if interface ;this one needs a
+                                             ;function so that the
+                                             ;items of list of strings
+                                             ;are prepended with an --interface.
+                                   #~(string-append "--interface" #$interface)
+                                   #~())
+
+                            ;; #$@(if user
+                            ;;        #~(string-append "--user " #$user)
+                            ;;        #~())
+                            ;; #$@(if group
+                            ;;        #~(string-append "--group " #$group)
+                            ;;        #~())
+
+                            #$@(if uuid-device
+                                   #~("--uuid" #$uuid-device)
+                                   #~())
+                            ;; #$@(if verbose?
+                            ;;        #~("--verbose")
+                            ;;        #~())
+                            #$@(if domain
+                                   #~("--domain" #$domain)
+                                   #~())
+                            #$@(if hostname
+                                   #~("--hostname" #$hostname)
+                                   #~())
+                            ;; #$@(if no-host?
+                            ;;        #~("--no-host")
+                            ;;        #~())
+                            #$@(if preserve-case?
+                                   #~("--preserve-case")
+                                   #~())
+                            ;; #$@(if no-http?
+                            ;;        #~("--no-http")
+                            ;;        #~())
+                            #$@(if workgroup
+                                   #~("--workgroup " #$workgroup)
+                                   #~())
+                            ;; #$@(if discovery?
+                            ;;        #~("--discovery")
+                            ;;        #~())
+                            ;; #$@(if listen
+                            ;;        #~("--listen " #$listen)
+                            ;;        #~())
+                            )
+                      #:user "wsdd"
+                      #:group "wsdd"
+                      ))
+            (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))))
diff --git a/siguix/services/wsdd.scm b/siguix/services/wsdd.scm
deleted file mode 100644
index 4b3435f..0000000
--- a/siguix/services/wsdd.scm
+++ /dev/null
@@ -1,228 +0,0 @@
-;;; 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 (siguix services wsdd)
-
-  #:use-module (gnu packages)
-  #:use-module (gnu packages base)
-  #:use-module (gnu packages admin)
-  ;; #:use-module (gnu packages samba)
-
-  #: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)   ;eventually move to guix
-
-  #: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-user
-            ;; wsdd-configuration-group
-            wsdd-configuration-uuid-device
-            ;; wsdd-configuration-verbose?
-            wsdd-configuration-domain
-            wsdd-configuration-hostname
-            ;; wsdd-configuration-no-host?
-            wsdd-configuration-preserve-case?
-            ;; wsdd-configuration-no-http?
-            wsdd-configuration-workgroup
-            ;; wsdd-configuration-discovery?
-            ;; wsdd-configuration-listen
-            ))
-
-(define-record-type* <wsdd-configuration>
-  wsdd-configuration
-  make-wsdd-configuration
-  wsdd-configuration?
-  (package               wsdd-configuration-package
-                         (default wsdd))
-  (ipv4only?             wsdd-configuration-ipv4only? ;bolean
-                         (default #f))
-  (ipv6only?             wsdd-configuration-ipv6only? ;bolean
-                         (default #f))
-  (chroot                wsdd-configuration-chroot ;string
-                         (default #f))
-  (hoplimit              wsdd-configuration-hoplimit ;integer | 1
-                         (default 1))
-  (interface             wsdd-configuration-interface ;list of
-                                                      ;strings, and
-                                                      ;FIXME! This
-                                                      ;list is not
-                                                      ;expanded yet.
-                         (default #f))
-  ;; (user           wsdd-configuration-user
-  ;;                 (default '()))
-  ;; (group          wsdd-configuration-group
-  ;;                 (default '("nouser")))
-  (uuid-device           wsdd-configuration-uuid-device
-                         (default #f))
-  ;; (verbose?              wsdd-configuration-verbose? ;doesn't help in shepherd.
-  ;;                        (default #f))
-  (domain                wsdd-configuration-domain ;string
-                         (default #f))
-  (hostname              wsdd-configuration-hostname ;string
-                         (default #f))
-  ;; (no-host?              wsdd-configuration-no-host? ;bolean
-  ;;                        (default #f))
-  (preserve-case?        wsdd-configuration-preserve-case? ;bolean
-                         (default #f))
-  ;; (no-http?              wsdd-configuration-no-http? ;bolean
-  ;;                        (default #f))
-  (workgroup             wsdd-configuration-workgroup ;string
-                         (default "WORKGROUP"))
-
-  ;;; I don't think it makes sense to run it in discovery mode as a
-  ;;; service.
-
-  ;; (discovery?            wsdd-configuration-discovery? ;bolean
-  ;;                        (default #f))
-  ;; (listen                wsdd-configuration-listen ;string
-  ;;                        (default #f))
-  )
-
-(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
-                             ;; user
-                             ;; group
-                             uuid-device
-                             ;; verbose?
-                             domain
-                             hostname
-                             ;; no-host?
-                             preserve-case?
-                             ;; no-http?
-                             workgroup
-                             ;; discovery?
-                             ;; listen
-                             )
-     (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
-                                   ;; #~(string-append "--hoplimit" #$(number->string hoplimit))
-                                   #~("--hoplimit" #$(number->string hoplimit))
-                                   #~())
-
-                            #$@(if interface ;this one needs a
-                                             ;function so that the
-                                             ;items of list of strings
-                                             ;are prepended with an --interface.
-                                   #~(string-append "--interface" #$interface)
-                                   #~())
-
-                            ;; #$@(if user
-                            ;;        #~(string-append "--user " #$user)
-                            ;;        #~())
-                            ;; #$@(if group
-                            ;;        #~(string-append "--group " #$group)
-                            ;;        #~())
-
-                            #$@(if uuid-device
-                                   #~("--uuid" #$uuid-device)
-                                   #~())
-                            ;; #$@(if verbose?
-                            ;;        #~("--verbose")
-                            ;;        #~())
-                            #$@(if domain
-                                   #~("--domain" #$domain)
-                                   #~())
-                            #$@(if hostname
-                                   #~("--hostname" #$hostname)
-                                   #~())
-                            ;; #$@(if no-host?
-                            ;;        #~("--no-host")
-                            ;;        #~())
-                            #$@(if preserve-case?
-                                   #~("--preserve-case")
-                                   #~())
-                            ;; #$@(if no-http?
-                            ;;        #~("--no-http")
-                            ;;        #~())
-                            #$@(if workgroup
-                                   #~("--workgroup " #$workgroup)
-                                   #~())
-                            ;; #$@(if discovery?
-                            ;;        #~("--discovery")
-                            ;;        #~())
-                            ;; #$@(if listen
-                            ;;        #~("--listen " #$listen)
-                            ;;        #~())
-                            )
-                      #:user "wsdd"
-                      #:group "wsdd"
-                      ))
-            (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))))