projects/guix·blob python-team · refs

216 lines · 6.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2022 Simon Streit <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19(define-module (gnu tests samba)
20 #:use-module (gnu tests)
21 #:use-module (gnu system)
22 #:use-module (gnu system vm)
23 #:use-module (gnu services)
24 #:use-module (gnu services networking)
25 #:use-module (gnu services samba)
26 #:use-module (gnu packages samba)
27 #:use-module (guix gexp)
28 #:use-module (guix store)
29 #:export (%test-samba
30 %test-wsdd))
31
32
33;;;
34;;; The Samba service.
35;;;
36
37(define %samba-os
38 (let ((base-os (simple-operating-system
39 (simple-service 'create-target-directory activation-service-type
40 #~(begin
41 (mkdir-p "/srv/samba/guest")
42 (chown "/srv/samba/guest"
43 (passwd:uid (getpw "nobody"))
44 (passwd:gid (getpw "nobody")))))
45 (service dhcpcd-service-type)
46 (service samba-service-type
47 (samba-configuration
48 (config-file (plain-file "smb.conf" "
49[global]
50 workgroup = WORKGROUP
51 server string = Samba Server
52 server role = standalone server
53 log file = /var/log/samba/log.%m
54 logging = file
55
56[guest]
57 path = /srv/samba/guest
58 read only = no
59 guest ok = yes
60 guest only = yes
61")))))))
62 (operating-system
63 (inherit base-os)
64 (packages (cons samba (operating-system-packages base-os))))))
65
66(define* (run-samba-test)
67 "Return a test of an OS running Samba service."
68
69 (define vm
70 (virtual-machine
71 (operating-system (marionette-operating-system
72 %samba-os
73 #:imported-modules '((gnu services herd)
74 (gnu build dbus-service))))
75 (port-forwardings '((8135 . 135)
76 (8137 . 137)
77 (8138 . 138)
78 (8445 . 445)))))
79
80 (define test
81 (with-imported-modules '((gnu build marionette))
82 #~(begin
83 (use-modules (gnu build marionette)
84 (srfi srfi-26)
85 (srfi srfi-64))
86
87 (define marionette
88 (make-marionette '(#$vm)))
89
90 (test-runner-current (system-test-runner #$output))
91 (test-begin "samba")
92
93 (test-assert "samba-smbd running"
94 (marionette-eval
95 '(begin
96 (use-modules (gnu services herd))
97 (start-service 'samba-smbd))
98 marionette))
99
100 (test-assert "samba-nmbd running"
101 (marionette-eval
102 '(begin
103 (use-modules (gnu services herd))
104 (start-service 'samba-nmbd))
105 marionette))
106
107 (test-assert "samba-winbindd running"
108 (marionette-eval
109 '(begin
110 (use-modules (gnu services herd))
111 (start-service 'samba-winbindd))
112 marionette))
113
114 (test-assert "smbd service process id"
115 (let ((pid
116 (number->string (wait-for-file "/var/run/samba/smbd.pid"
117 marionette))))
118 (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
119 marionette)))
120
121 (test-assert "nmbd service process id"
122 (let ((pid
123 (number->string (wait-for-file "/var/run/samba/nmbd.pid"
124 marionette))))
125 (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
126 marionette)))
127
128 (test-assert "winbindd service process id"
129 (let ((pid
130 (number->string (wait-for-file "/var/run/samba/winbindd.pid"
131 marionette))))
132 (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
133 marionette)))
134
135 (test-assert "samba-smbd is listening for peers"
136 (wait-for-tcp-port 445 marionette))
137
138 (test-assert "smbclient connect"
139 (marionette-eval
140 '(begin
141 (use-modules ((gnu build dbus-service)
142 #:select (with-retries)))
143 (with-retries 5 5
144 (zero? (system* #$(file-append samba "/bin/smbclient")
145 "--list=localhost" "--no-pass"))))
146 marionette))
147
148 (test-end))))
149
150 (gexp->derivation "samba-test" test))
151
152(define %test-samba
153 (system-test
154 (name "samba")
155 (description "Connect to a running Samba daemon.")
156 (value (run-samba-test))))
157
158
159;;;
160;;; The wsdd service.
161;;;
162
163(define %wsdd-os
164 (let ((base-os (simple-operating-system
165 (service dhcpcd-service-type)
166 (service wsdd-service-type))))
167 (operating-system
168 (inherit base-os)
169 (packages (cons wsdd (operating-system-packages base-os))))))
170
171(define* (run-wsdd-test)
172 "Return a test of an OS running wsdd service."
173
174 (define vm
175 (virtual-machine
176 (operating-system (marionette-operating-system
177 %wsdd-os
178 #:imported-modules '((gnu services herd))))
179 (port-forwardings '((3702 . 3702)
180 (5357 . 5357)))))
181
182 (define test
183 (with-imported-modules '((gnu build marionette))
184 #~(begin
185 (use-modules (gnu build marionette)
186 (srfi srfi-26)
187 (srfi srfi-64))
188
189 (define marionette
190 (make-marionette '(#$vm)))
191
192 (test-runner-current (system-test-runner #$output))
193 (test-begin "wsdd")
194
195 ;; Here shall be more tests to begin with.
196
197 (test-assert "wsdd running"
198 (marionette-eval
199 '(begin
200 (use-modules (gnu services herd))
201 (start-service 'wsdd))
202 marionette))
203
204 (test-end))))
205
206 (gexp->derivation "wsdd-test" test))
207
208(define %test-wsdd
209 (system-test
210 (name "wsdd")
211 (description "Connect to a running wsdd daemon.")
212 (value (run-wsdd-test))))
213
214;; Local Variables:
215;; eval: (put 'with-retries 'scheme-indent-function 2)
216;; End: