projects/guix·blob javascript-team · refs

158 lines · 5.7 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017 Christopher Baines <[email protected]>
3;;; Copyright © 2018 Clément Lassieur <[email protected]>
4;;; Copyright © 2021 Ludovic Courtès <[email protected]>
5;;;
6;;; This file is part of GNU Guix.
7;;;
8;;; GNU Guix is free software; you can redistribute it and/or modify it
9;;; under the terms of the GNU General Public License as published by
10;;; the Free Software Foundation; either version 3 of the License, or (at
11;;; your option) any later version.
12;;;
13;;; GNU Guix is distributed in the hope that it will be useful, but
14;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;;; GNU General Public License for more details.
17;;;
18;;; You should have received a copy of the GNU General Public License
19;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20
21(define-module (gnu tests rsync)
22 #:use-module (gnu packages rsync)
23 #:use-module (gnu tests)
24 #:use-module (gnu system)
25 #:use-module (gnu system file-systems)
26 #:use-module (gnu system shadow)
27 #:use-module (gnu system vm)
28 #:use-module (gnu services)
29 #:use-module (gnu services rsync)
30 #:use-module (gnu services networking)
31 #:use-module (guix gexp)
32 #:use-module (guix store)
33 #:export (%test-rsync))
34
35(define* (run-rsync-test rsync-os #:optional (rsync-port 873))
36 "Run tests in %RSYNC-OS, which has rsync running and listening on
37PORT."
38 (define os
39 (marionette-operating-system
40 rsync-os
41 #:imported-modules '((gnu services herd)
42 (guix combinators))))
43
44 (define vm
45 (virtual-machine
46 (operating-system os)
47 (port-forwardings '())))
48
49 (define test
50 (with-imported-modules '((gnu build marionette))
51 #~(begin
52 (use-modules (srfi srfi-11) (srfi srfi-64)
53 (gnu build marionette))
54
55 (define marionette
56 (make-marionette (list #$vm)))
57
58 (test-runner-current (system-test-runner #$output))
59 (test-begin "rsync")
60
61 ;; Wait for rsync to be up and running.
62 (test-assert "service running"
63 (marionette-eval
64 '(begin
65 (use-modules (gnu services herd))
66
67 ;; Make sure the 'rsync' command is found.
68 (setenv "PATH" "/run/current-system/profile/bin")
69
70 (start-service 'rsync))
71 marionette))
72
73 (test-assert "Test file copied to share"
74 (marionette-eval
75 '(begin
76 (call-with-output-file "/tmp/input"
77 (lambda (port)
78 (display "test-file-contents\n" port)))
79 (zero?
80 (system* "rsync" "/tmp/input"
81 (string-append "rsync://localhost:"
82 (number->string #$rsync-port)
83 "/files/input"))))
84 marionette))
85
86 (test-equal "Test file correctly received from share"
87 "test-file-contents"
88 (marionette-eval
89 '(begin
90 (use-modules (ice-9 rdelim))
91 (zero?
92 (system* "rsync"
93 (string-append "rsync://localhost:"
94 (number->string #$rsync-port)
95 "/files/input")
96 "/tmp/output"))
97 (call-with-input-file "/tmp/output"
98 (lambda (port)
99 (read-line port))))
100 marionette))
101
102 (test-equal "Test file not copied to read-only share"
103 1 ;see "EXIT VALUES" in rsync(1)
104 (marionette-eval
105 '(status:exit-val
106 (system* "rsync" "/tmp/input"
107 (string-append "rsync://localhost:"
108 (number->string #$rsync-port)
109 "/read-only/input")))
110 marionette))
111
112 (test-equal "Test file correctly received from read-only share"
113 "\"Hi!\" from the read-only share."
114 (marionette-eval
115 '(begin
116 (use-modules (ice-9 rdelim))
117
118 (call-with-output-file "/srv/read-only/the-file"
119 (lambda (port)
120 (display "\"Hi!\" from the read-only share." port)))
121
122 (zero?
123 (system* "rsync"
124 (string-append "rsync://localhost:"
125 (number->string #$rsync-port)
126 "/read-only/the-file")
127 "/tmp/output"))
128 (call-with-input-file "/tmp/output" read-line))
129 marionette))
130
131 (test-end))))
132
133 (gexp->derivation "rsync-test" test))
134
135(define* %rsync-os
136 ;; Return operating system under test.
137 (let ((base-os
138 (simple-operating-system
139 (service dhcpcd-service-type)
140 (service rsync-service-type
141 (rsync-configuration
142 (modules (list (rsync-module
143 (name "read-only")
144 (file-name "/srv/read-only"))
145 (rsync-module
146 (name "files")
147 (file-name "/srv/read-write")
148 (read-only? #f)))))))))
149 (operating-system
150 (inherit base-os)
151 (packages (cons* rsync
152 (operating-system-packages base-os))))))
153
154(define %test-rsync
155 (system-test
156 (name "rsync")
157 (description "Connect to a running RSYNC server.")
158 (value (run-rsync-test %rsync-os))))