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
48
49
50
51
52
53
54
55
|
(use-modules (ice-9 rdelim)
(tests common)
(ssh auth)
(ssh channel)
(ssh dist)
(ssh key)
(ssh message)
(ssh popen)
(ssh server)
(ssh session)
(ssh tunnel)
(ssh log)
(ssh server)
(ssh version))
(define (main args)
(let ((test-suite-name (list-ref args 1))
(test-name (list-ref args 2)))
(define (log message)
(let ((port (open-file (string-append test-suite-name "/log.txt") "a+")))
(format port
"~s: ~a~%"
(strftime "%Y-%m-%d %H:%M:%S" (localtime (current-time)))
message)
(close port)))
(unless (file-exists? test-suite-name)
(mkdir test-suite-name))
(log args)
(set-log-userdata! test-name)
(setup-test-suite-logging! (format #f
"~a/~a-server"
test-suite-name
(sanitize-string test-name)))
(let* ((port (string->number (list-ref args 3)))
(handler (eval-string (list-ref args 4)))
(s (make-server
#:bindaddr %addr
#:bindport port
#:rsakey %rsakey
#:dsakey (and (dsa-support?) %dsakey)
#:log-verbosity 'functions)))
(server-listen s)
(let ((p (open-output-file (format #f
"~a/~a-server.run"
test-suite-name
(sanitize-string test-name)))))
(format p "~a~%" (getpid))
(close p))
(usleep 100)
(handler s))))
|
