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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
;;;; $Id$
;;;; $URL$
;;;; See LICENSE for licensing information.
(in-package :usocket-test)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defparameter *wait-for-input-timeout* 2))
(deftest wait-for-input.1
(with-caught-conditions (nil nil)
(let ((sock (usocket:socket-connect *common-lisp-net* 80))
(time (get-universal-time)))
(unwind-protect
(progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
(- (get-universal-time) time))
(usocket:socket-close sock))))
#.*wait-for-input-timeout*)
(deftest wait-for-input.2
(with-caught-conditions (nil nil)
(let ((sock (usocket:socket-connect *common-lisp-net* 80))
(time (get-universal-time)))
(unwind-protect
(progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t)
(- (get-universal-time) time))
(usocket:socket-close sock))))
#.*wait-for-input-timeout*)
(deftest wait-for-input.3
(with-caught-conditions (nil nil)
(let ((sock (usocket:socket-connect *common-lisp-net* 80)))
(unwind-protect
(progn
(format (usocket:socket-stream sock)
"GET / HTTP/1.0~2%")
(force-output (usocket:socket-stream sock))
(usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
(subseq (read-line (usocket:socket-stream sock)) 0 15))
(usocket:socket-close sock))))
"HTTP/1.1 200 OK")
;;; Advanced W-F-I tests by Elliott Slaughter <elliottslaughter@gmail.com>
(defvar *socket-server-port* 0)
(defvar *socket-server-listen* nil)
(defvar *socket-server-connection*)
(defvar *socket-client-connection*)
(defvar *output-p* t)
(defun stage-1 ()
(unless *socket-server-listen*
(setf *socket-server-listen*
(socket-listen *wildcard-host* 0 :element-type '(unsigned-byte 8)))
(setf *socket-server-port* (get-local-port *socket-server-listen*)))
(setf *socket-server-connection*
(when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
(socket-accept *socket-server-listen*)))
(when *output-p* ; should be NIL
(format t "First time (before client connects) is ~s.~%"
*socket-server-connection*))
*socket-server-connection*)
;; TODO: original test code have addition (:TIMEOUT 0) when doing the SOCKET-CONNECT,
;; it seems cannot work on SBCL/Windows, need to investigate, but here we ignore it.
(defun stage-2 ()
(setf *socket-client-connection*
(socket-connect "localhost" *socket-server-port* :protocol :stream
:element-type '(unsigned-byte 8)))
(setf *socket-server-connection*
(when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
#+(and win32 (or lispworks ecl sbcl))
(when *output-p*
(format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server-listen*)))
(socket-accept *socket-server-listen*)))
(when *output-p* ; should be a usocket object
(format t "Second time (after client connects) is ~s.~%"
*socket-server-connection*))
*socket-server-connection*)
(defun stage-3 ()
(setf *socket-server-connection*
(when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
#+(and win32 (or lispworks ecl sbcl))
(when *output-p*
(format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server-listen*)))
(socket-accept *socket-server-listen*)))
(when *output-p* ; should be NIL again
(format t "Third time (before second client) is ~s.~%"
*socket-server-connection*))
*socket-server-connection*)
(deftest elliott-slaughter.1
(let ((*output-p* nil))
(let* ((s-1 (stage-1)) (s-2 (stage-2)) (s-3 (stage-3)))
(prog1 (and (null s-1) (usocket::usocket-p s-2) (null s-3))
(socket-close *socket-server-listen*)
(setf *socket-server-listen* nil))))
t)
#|
Issue elliott-slaughter.2 (WAIT-FOR-INPUT/win32 on TCP socket)
W-F-I correctly found the inputs, but :READY-ONLY didn't work.
|#
(defun receive-each (connections)
(let ((ready (usocket:wait-for-input connections :timeout 0 :ready-only t)))
(loop for connection in ready
collect (read-line (usocket:socket-stream connection)))))
(defun receive-all (connections)
(loop for messages = (receive-each connections)
then (receive-each connections)
while messages append messages))
(defun send (connection message)
(format (usocket:socket-stream connection) "~a~%" message)
(force-output (usocket:socket-stream connection)))
(defun server ()
(let* ((listen (usocket:socket-listen usocket:*wildcard-host* 12345))
(connection (usocket:socket-accept listen)))
(loop for messages = (receive-all connection) then (receive-all connection)
do (format t "Got messages:~%~s~%" messages)
do (sleep 1/50))))
(defun client ()
(let ((connection (usocket:socket-connect "localhost" 12345)))
(loop for i from 0
do (send connection (format nil "This is message ~a." i))
do (sleep 1/100))))
|
