blob: 477c59463ac128c2514da4753ba72564e7a84ef4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
#!/usr/bin/env bash
# -*- mode: scheme; geiser-scheme-implementation: guile -*-
here=$(dirname $(realpath $0))
. "$(dirname "$here")/env"
exec $GUILE -e main -s "$0" "$@"
!#
(use-modules (calp server webdav)
(calp server socket)
(ice-9 threads)
(ice-9 rdelim)
(srfi srfi-1)
(srfi srfi-88))
;;; Commentary:
;;; Runs the external WebDAV test framework litmus [1], pointing it
;;; to a new instance of our webdav server.
;;;
;;; [1]: http://webdav.org/neon/litmus/
;;;
;;; Code:
(define (start-server out)
(begin-thread
(with-error-to-file "webdav.log"
(lambda ()
(run-at-any-port
webdav-handler
min-port: 8102
msg-port: out)))))
(define (main args)
(define-values (in out) (car+cdr (pipe)))
(define scm (start-server out))
(define uri-base (read-line in))
(define suffix
(if (null? (cdr args))
""
(string-append "/" (cadr args))))
(system* "litmus" (string-append uri-base suffix))
(cancel-thread scm))
|
