services: Add samba-service.

* siguix/services/samba.scm (samba-service): New variable.

1 files changed, 361 insertions, 0 deletions

diff --git a/siguix/services/samba.scm b/siguix/services/samba.scm
new file mode 100644
index 0000000..b973942
--- /dev/null
+++ b/siguix/services/samba.scm
@@ -0,0 +1,361 @@
+;;; 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 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 (gnu packages admin)
+  #:use-module (gnu packages samba)
+
+  #: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)
+  #:export (samba-service
+            samba-service-type
+            samba-configuration
+            samba-configuration?
+            samba-configuration-package
+            samba-configuration-config-file
+            samba-configuration-enable-samba?
+            samba-configuration-enable-smbd?
+            samba-configuration-enable-nmbd?
+            samba-configuration-enable-winbindd?
+            samba-configuration-global-extra-config
+            samba-configuration-workgroup
+            samba-configuration-server-string
+            samba-configuration-server-role
+            samba-configuration-bind-interfaces-only?
+            samba-configuration-interfaces
+            samba-configuration-hosts-allow
+            samba-configuration-guest-account
+            samba-configuration-log-file
+            samba-configuration-loggin
+            samba-configuration-realm
+            samba-configuration-passdb-backend
+            samba-configuration-include-config
+            samba-configuration-logon-path
+            samba-configuration-wins-support?
+            samba-configuration-wins-server
+            samba-configuration-wins-proxy?
+            samba-configuration-dns-proxy?
+
+            ;; temp!
+            samba-configuration-default-config-file
+            ))
+
+;;; Commentary:
+;;;
+;;; Windows network services.
+;;;
+;;; Code:
+
+(define-record-type* <samba-configuration>
+  samba-configuration
+  make-samba-configuration
+  samba-configuration?
+
+  (package              samba-configuration-package
+                        (default samba))
+  (config-file          samba-configuration-config-file
+                        (default #f))
+  (enable-samba?        samba-configuration-enable-samba?
+                        (default #f))
+  (enable-smbd?         samba-configuration-enable-smbd?
+                        (default #t))
+  (enable-nmbd?         samba-configuration-enable-nmbd?
+                        (default #t))
+  (enable-winbindd?     samba-configuration-enable-winbindd?
+                        (default #f))
+
+  ;; From here on anything goes to smb.conf
+
+  ;; This line will be put at the end of [global].
+  (global-extra-config   samba-configuration-global-extra-config
+                         (default #f))
+  (workgroup             samba-configuration-workgroup
+                         (default "WORKGROUP"))
+  (server-string         samba-configuration-server-string
+                         (default "Samba Server"))
+  (server-role           samba-configuration-server-role
+                         (default "standalone server"))
+  (bind-interfaces-only? samba-configuration-bind-interfaces-only?
+                         (default #f))
+  (interfaces            samba-configuration-interfaces
+                         (default '()))
+  (hosts-allow           samba-configuration-hosts-allow
+                         (default '()))
+  (guest-account         samba-configuration-guest-account
+                         (default #f))
+  (log-file              samba-configuration-log-file
+                         (default "/var/log/samba/log.%m"))
+  (logging               samba-configuration-loggin
+                         (default "file"))
+  (realm                 samba-configuration-realm
+                         (default #f))
+  (passdb-backend        samba-configuration-passdb-backend
+                         (default #f))
+  (include-config        samba-configuration-include-config
+                         (default #f))
+  (logon-path            samba-configuration-logon-path
+                         (default #f))
+  (wins-support?         samba-configuration-wins-support?
+                         (default #f))
+  (wins-server           samba-configuration-wins-server
+                         (default #f))
+  (wins-proxy?           samba-configuration-wins-proxy?
+                         (default #f))
+  (dns-proxy?            samba-configuration-dns-proxy?
+                         (default #f))
+  ;; (  samba-configuration-
+  ;;                       (default ))
+  )
+
+(define (samba-configuration-config-file global-extra-config
+                                         workgroup
+                                         server-string
+                                         server-role
+                                         bind-interfaces-only?
+                                         interfaces
+                                         hosts-allow
+                                         guest-account
+                                         log-file
+                                         logging
+                                         realm
+                                         passdb-backend
+                                         include-config
+                                         logon-path
+                                         wins-support?
+                                         wins-server
+                                         wins-proxy?
+                                         dns-proxy?)
+  (mixed-text-file
+   "smb.conf"
+   "# Generated by samba-service.
+[global]
+" (if workgroup
+      (string-append "    workgroup = " workgroup "\n") "")
+(if server-string
+    (string-append "    server string = " server-string "\n") "")
+(if server-role
+    (string-append "    server role = " server-role "\n") "")
+(if bind-interfaces-only? "    bind interfaces only = Yes\n" "")
+(if (not (null? interfaces))
+    (string-append "    interfaces = " (string-join interfaces) "\n") "")
+(if (not (null? hosts-allow))
+    (string-append "    hosts allow = " (string-join hosts-allow) "\n") "")
+(if guest-account
+    (string-append "    guest account = " guest-account "\n") "")
+(if log-file
+    (string-append "    log file = " log-file "\n") "")
+(if logging
+    (string-append "    logging = " logging "\n") "")
+(if realm
+    (string-append "    realm = " realm "\n") "")
+(if passdb-backend
+    (string-append "    passdb backend = " passdb-backend "\n") "")
+(if include-config
+    (string-append "    include config = " include-config "\n") "")
+(if logon-path
+    (string-append "    logon path = " logon-path "\n") "")
+(if wins-support? "    wins support = Yes" "")
+(if wins-server
+    (string-append "    wins server = " wins-server "\n") "")
+(if wins-proxy? "    wins proxy = Yes\n" "")
+(if dns-proxy? "    dns proxy = Yes\n" "")
+(if global-extra-config
+    (string-append
+     "\n#Extra options provided by ‘global-extra-config’:\n"
+     global-extra-config "\n") "")))
+
+(define samba-activation
+  (match-lambda
+    (($ <samba-configuration> package
+                              config-file
+                              ;; enable-samba? enable-smbd? enable-nmbd? enable-winbindd?
+                              _ _ _ _
+                              global-extra-config
+                              workgroup
+                              server-string
+                              server-role
+                              bind-interfaces-only?
+                              interfaces
+                              hosts-allow
+                              guest-account
+                              log-file
+                              logging
+                              realm
+                              passdb-backend
+                              include-config
+                              logon-path
+                              wins-support?
+                              wins-server
+                              wins-proxy?
+                              dns-proxy?
+                              )
+     (with-imported-modules '((guix build utils))
+       (let ((config-file
+              (or config-file
+                  (samba-configuration-config-file global-extra-config
+                                                   workgroup
+                                                   server-string
+                                                   server-role
+                                                   bind-interfaces-only?
+                                                   interfaces
+                                                   hosts-allow
+                                                   guest-account
+                                                   log-file
+                                                   logging
+                                                   realm
+                                                   passdb-backend
+                                                   include-config
+                                                   logon-path
+                                                   wins-support?
+                                                   wins-server
+                                                   wins-proxy?
+                                                   dns-proxy?)))
+             (lib-directory "/var/lib/samba")
+             (log-directory "/var/log/samba")
+             (run-directory "/var/run/samba")
+             (smb.conf "/etc/samba/smb.conf"))
+         #~(begin
+             (use-modules (guix build utils))
+             (mkdir-p #$log-directory)
+             (mkdir-p #$run-directory)
+             (mkdir-p (string-append #$lib-directory "/private"))
+
+             ;; I'd like to place smb.conf to /etc/samba.  It might
+             ;; make sense, since there will be other daemons wanting
+             ;; to access it.
+
+             (mkdir-p "/etc/samba")
+             (copy-file #$config-file #$smb.conf)
+
+             ;; Test config
+             (system* (string-append #$samba "/bin/testparm")
+                      "--suppress-prompt")
+
+             ;; (display #$(string-append lib-directory "/private\n"))
+             ;; (display (string-append #$(file-append samba "/sbin/smbd")
+             ;;                         (string-append "--configfile="
+             ;;                                        #$config-file)
+             ;;                         "--foreground"
+             ;;                         (string-append "--log-basename="
+             ;;                                        #$log-directory)
+             ;;                         "--no-process-group"))
+             ))))))
+
+(define samba-shepherd-service
+  (match-lambda
+    (($ <samba-configuration> package)
+     (let ((config-file "/etc/samba/smb.conf"))
+       (list (shepherd-service
+              (documentation "Run the Samba")
+              (provision '(samba))
+              (requirement '(networking))
+              (start #~(make-forkexec-constructor
+                        (list #$(file-append samba "/sbin/samba")
+                              (string-append "--configfile="
+                                             #$config-file)
+                              "--foreground"
+                              "--no-process-group")))
+              (stop #~(make-kill-destructor))))))))
+
+(define samba-nmbd-shepherd-service
+  (match-lambda
+    (($ <samba-configuration> package)
+     (let ((config-file "/etc/samba/smb.conf"))
+       (list (shepherd-service
+              (documentation "Run NetBIOS name server.")
+              (provision '(samba-nmbd))
+              (requirement '(networking))
+              (start #~(make-forkexec-constructor
+                        (list #$(file-append samba "/sbin/nmbd")
+                              (string-append "--configfile="
+                                             #$config-file)
+                              "--foreground"
+                              "--no-process-group")))
+              (stop #~(make-kill-destructor))))))))
+
+(define samba-smbd-shepherd-service
+  (match-lambda
+    (($ <samba-configuration> package)
+     (let ((config-file "/etc/samba/smb.conf"))
+       (list (shepherd-service
+              (documentation "Run SMB/CIFS service")
+              (provision '(samba-smbd))
+              (requirement '(networking))
+              (start #~(make-forkexec-constructor
+                        (list #$(file-append samba "/sbin/smbd")
+                              (string-append "--configfile="
+                                             #$config-file)
+                              "--foreground"
+                              "--no-process-group")))
+              (stop #~(make-kill-destructor))))))))
+
+(define samba-winbind-shepherd-service
+  (match-lambda
+    (($ <samba-configuration> package)
+     (let ((config-file "/etc/samba/smb.conf"))
+       (list (shepherd-service
+              (documentation "Run winbindd for Name Service Switch")
+              (provision '(samba-winbindd))
+              (requirement '(networking))
+              (start #~(make-forkexec-constructor
+                        (list #$(file-append samba "/sbin/winbindd")
+                              (string-append "--configfile="
+                                             #$config-file)
+                              "--foreground"
+                              "--no-process-group")))
+              (stop #~(make-kill-destructor))))))))
+
+(define (samba-shepherd-services config)
+  (append ;; (samba-shepherd-service config)
+             (samba-nmbd-shepherd-service config)
+             (samba-smbd-shepherd-service config)
+             (samba-winbind-shepherd-service config)))
+
+(define samba-service-type
+  (service-type
+   (name 'samba)
+   (description "Samba")
+   (extensions
+    (list (service-extension shepherd-root-service-type
+                             samba-shepherd-services)
+          (service-extension activation-service-type
+                             samba-activation)
+          ;; (service-extension account-service-type
+          ;;                    (const %samba-accounts))
+          ))
+   (default-value (samba-configuration))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; (let ((uid (passwd:uid (getpw "samba")))
+;;       (gid (group:gid (getgr "samba"))))
+;;   )