blob: 69d130a3cca8e238f05563f1ff602af9d2901d34 (
about) (
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
;; Copyright (C) 2014 Artyom V. Poptsov <poptsov.artyom@gmail.com>
;;
;; This file is a part of libguile-ssh.
;;
;; libguile-ssh 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.
;;
;; libguile-ssh 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 libguile-ssh. If not, see <http://www.gnu.org/licenses/>.
(use-modules (srfi srfi-64)
(ssh server))
(test-begin "server")
(test-assert "%make-server"
(%make-server))
(test-assert "server?"
(let ((server (%make-server))
(x "I'm not a server"))
(and (server? server)
(not (server? x)))))
(test-assert "comparison of servers"
(let ((s1 (%make-server))
(s2 (%make-server)))
(and (equal? s1 s1)
(not (equal? s1 s2)))))
(test-assert "server-set!, valid values"
(let* ((server (%make-server))
(topdir (getenv "abs_top_srcdir"))
(options `((bindaddr "127.0.0.1")
(bindport 22)
(hostkey "ssh-rsa" "ssh-dss")
(rsakey ,(format #f "~a/tests/rsakey" topdir))
(dsakey ,(format #f "~a/tests/dsakey" topdir))
(banner "string")
(log-verbosity nolog rare protocol packet functions)
(blocking-mode #f #t)))
(log (test-runner-aux-value (test-runner-current)))
(res #t))
(for-each
(lambda (opt)
(for-each
(lambda (val)
(catch #t
(lambda ()
(server-set! server (car opt) val))
(lambda (key . args)
(set! res #f)
(format log " opt: ~a, val: ~a, error: ~a~%"
(car opt)
val
args))))
(cdr opt)))
options)
res))
(test-assert "server-set!, invalid values"
(let ((server (%make-server))
(options '((bindaddr "I'm not a IP address" 42)
(bindport "I'm not a port" -42)
(hostkey "invalid value" 1 'invalid-value)
(rsakey "I'm not a RSA key" 42)
(dsakey "I'm not a DSA key" 42)
(banner 12345)
(log-verbosity -1 0 1 2 3 4 5)
(blocking-mode 42 "string")))
(log (test-runner-aux-value (test-runner-current)))
(res #t))
(for-each
(lambda (opt)
(for-each
(lambda (val)
(catch #t
(lambda ()
(server-set! server (car opt) val)
(format log " opt: ~a, val: ~a -- passed mistakenly~%"
(car opt) val)
(set! res #f))
(lambda (key . args)
#t)))
(cdr opt)))
options)
res))
(test-assert "make-server"
(let ((topdir (getenv "abs_top_srcdir")))
(make-server #:bindaddr "127.0.0.1"
#:bindport 123456
#:rsakey (format #f "~a/tests/rsakey" topdir)
#:dsakey (format #f "~a/tests/dsakey" topdir)
#:banner "banner"
#:log-verbosity 'nolog
#:blocking-mode #f)))
(test-assert "server-listen"
(let* ((topdir (getenv "abs_top_srcdir"))
(server (make-server #:bindaddr "127.0.0.1"
#:bindport 123456
#:rsakey (format #f "~a/tests/rsakey" topdir)
#:log-verbosity 'nolog)))
(server-listen server)
#t))
(test-end "server")
(exit (= (test-runner-fail-count (test-runner-current)) 0))
|
