216 lines
6.8 KiB
Scheme
216 lines
6.8 KiB
Scheme
;;; GNU Guix --- Functional package management for GNU
|
||
;;; Copyright © 2022 Simon Streit <simon@netpanic.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 tests samba)
|
||
#:use-module (gnu tests)
|
||
#:use-module (gnu system)
|
||
#:use-module (gnu system vm)
|
||
#:use-module (gnu services)
|
||
#:use-module (gnu services networking)
|
||
#:use-module (gnu services samba)
|
||
#:use-module (gnu packages samba)
|
||
#:use-module (guix gexp)
|
||
#:use-module (guix store)
|
||
#:export (%test-samba
|
||
%test-wsdd))
|
||
|
||
|
||
;;;
|
||
;;; The Samba service.
|
||
;;;
|
||
|
||
(define %samba-os
|
||
(let ((base-os (simple-operating-system
|
||
(simple-service 'create-target-directory activation-service-type
|
||
#~(begin
|
||
(mkdir-p "/srv/samba/guest")
|
||
(chown "/srv/samba/guest"
|
||
(passwd:uid (getpw "nobody"))
|
||
(passwd:gid (getpw "nobody")))))
|
||
(service dhcp-client-service-type)
|
||
(service samba-service-type
|
||
(samba-configuration
|
||
(config-file (plain-file "smb.conf" "
|
||
[global]
|
||
workgroup = WORKGROUP
|
||
server string = Samba Server
|
||
server role = standalone server
|
||
log file = /var/log/samba/log.%m
|
||
logging = file
|
||
|
||
[guest]
|
||
path = /srv/samba/guest
|
||
read only = no
|
||
guest ok = yes
|
||
guest only = yes
|
||
")))))))
|
||
(operating-system
|
||
(inherit base-os)
|
||
(packages (cons samba (operating-system-packages base-os))))))
|
||
|
||
(define* (run-samba-test)
|
||
"Return a test of an OS running Samba service."
|
||
|
||
(define vm
|
||
(virtual-machine
|
||
(operating-system (marionette-operating-system
|
||
%samba-os
|
||
#:imported-modules '((gnu services herd))))
|
||
(port-forwardings '((8135 . 135)
|
||
(8137 . 137)
|
||
(8138 . 138)
|
||
(8445 . 445)))))
|
||
|
||
(define test
|
||
(with-imported-modules '((gnu build marionette))
|
||
#~(begin
|
||
(use-modules (gnu build marionette)
|
||
(srfi srfi-26)
|
||
(srfi srfi-64))
|
||
|
||
(define marionette
|
||
(make-marionette '(#$vm)))
|
||
|
||
(test-runner-current (system-test-runner #$output))
|
||
(test-begin "samba")
|
||
|
||
(test-assert "samba-smbd running"
|
||
(marionette-eval
|
||
'(begin
|
||
(use-modules (gnu services herd))
|
||
(start-service 'samba-smbd))
|
||
marionette))
|
||
|
||
(test-assert "samba-nmbd running"
|
||
(marionette-eval
|
||
'(begin
|
||
(use-modules (gnu services herd))
|
||
(start-service 'samba-nmbd))
|
||
marionette))
|
||
|
||
(test-assert "samba-winbindd running"
|
||
(marionette-eval
|
||
'(begin
|
||
(use-modules (gnu services herd))
|
||
(start-service 'samba-winbindd))
|
||
marionette))
|
||
|
||
(test-assert "smbd service process id"
|
||
(let ((pid
|
||
(number->string (wait-for-file "/var/run/samba/smbd.pid"
|
||
marionette))))
|
||
(marionette-eval `(file-exists? (string-append "/proc/" ,pid))
|
||
marionette)))
|
||
|
||
(test-assert "nmbd service process id"
|
||
(let ((pid
|
||
(number->string (wait-for-file "/var/run/samba/nmbd.pid"
|
||
marionette))))
|
||
(marionette-eval `(file-exists? (string-append "/proc/" ,pid))
|
||
marionette)))
|
||
|
||
(test-assert "winbindd service process id"
|
||
(let ((pid
|
||
(number->string (wait-for-file "/var/run/samba/winbindd.pid"
|
||
marionette))))
|
||
(marionette-eval `(file-exists? (string-append "/proc/" ,pid))
|
||
marionette)))
|
||
|
||
(test-assert "samba-smbd is listening for peers"
|
||
(wait-for-tcp-port 445 marionette))
|
||
|
||
(test-equal "smbclient connect"
|
||
0
|
||
(marionette-eval
|
||
'(system* #$(file-append samba "/bin/smbclient")
|
||
"--list=localhost" "--no-pass")
|
||
marionette))
|
||
|
||
(test-equal "smbclient connect"
|
||
0
|
||
(marionette-eval
|
||
'(system* #$(file-append samba "/bin/smbclient")
|
||
"--list=localhost" "--no-pass")
|
||
marionette))
|
||
|
||
(test-end))))
|
||
|
||
(gexp->derivation "samba-test" test))
|
||
|
||
(define %test-samba
|
||
(system-test
|
||
(name "samba")
|
||
(description "Connect to a running Samba daemon.")
|
||
(value (run-samba-test))))
|
||
|
||
|
||
;;;
|
||
;;; The wsdd service.
|
||
;;;
|
||
|
||
(define %wsdd-os
|
||
(let ((base-os (simple-operating-system
|
||
(service dhcp-client-service-type)
|
||
(service wsdd-service-type))))
|
||
(operating-system
|
||
(inherit base-os)
|
||
(packages (cons wsdd (operating-system-packages base-os))))))
|
||
|
||
(define* (run-wsdd-test)
|
||
"Return a test of an OS running wsdd service."
|
||
|
||
(define vm
|
||
(virtual-machine
|
||
(operating-system (marionette-operating-system
|
||
%wsdd-os
|
||
#:imported-modules '((gnu services herd))))
|
||
(port-forwardings '((3702 . 3702)
|
||
(5357 . 5357)))))
|
||
|
||
(define test
|
||
(with-imported-modules '((gnu build marionette))
|
||
#~(begin
|
||
(use-modules (gnu build marionette)
|
||
(srfi srfi-26)
|
||
(srfi srfi-64))
|
||
|
||
(define marionette
|
||
(make-marionette '(#$vm)))
|
||
|
||
(test-runner-current (system-test-runner #$output))
|
||
(test-begin "wsdd")
|
||
|
||
;; Here shall be more tests to begin with.
|
||
|
||
(test-assert "wsdd running"
|
||
(marionette-eval
|
||
'(begin
|
||
(use-modules (gnu services herd))
|
||
(start-service 'wsdd))
|
||
marionette))
|
||
|
||
(test-end))))
|
||
|
||
(gexp->derivation "wsdd-test" test))
|
||
|
||
(define %test-wsdd
|
||
(system-test
|
||
(name "wsdd")
|
||
(description "Connect to a running wsdd daemon.")
|
||
(value (run-wsdd-test))))
|