twait-for-input.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
(HTM) git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) Tags
(DIR) LICENSE
---
twait-for-input.lisp (4963B)
---
1 ;;;; See LICENSE for licensing information.
2
3 (in-package :usocket-test)
4
5 (eval-when (:compile-toplevel :load-toplevel :execute)
6 (defparameter *wait-for-input-timeout* 2))
7
8 (deftest wait-for-input.1
9 (with-caught-conditions (nil nil)
10 (let ((sock (usocket:socket-connect *common-lisp-net* 80))
11 (time (get-universal-time)))
12 (unwind-protect
13 (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
14 (- (get-universal-time) time))
15 (usocket:socket-close sock))))
16 #.*wait-for-input-timeout*)
17
18 (deftest wait-for-input.2
19 (with-caught-conditions (nil nil)
20 (let ((sock (usocket:socket-connect *common-lisp-net* 80))
21 (time (get-universal-time)))
22 (unwind-protect
23 (progn (usocket:wait-for-input sock :timeout *wait-for-input-timeout* :ready-only t)
24 (- (get-universal-time) time))
25 (usocket:socket-close sock))))
26 #.*wait-for-input-timeout*)
27
28 (deftest wait-for-input.3
29 (with-caught-conditions (nil nil)
30 (let ((sock (usocket:socket-connect *common-lisp-net* 80)))
31 (unwind-protect
32 (progn
33 (format (usocket:socket-stream sock)
34 "GET / HTTP/1.0~2%")
35 (force-output (usocket:socket-stream sock))
36 (usocket:wait-for-input sock :timeout *wait-for-input-timeout*)
37 (subseq (read-line (usocket:socket-stream sock)) 0 4))
38 (usocket:socket-close sock))))
39 "HTTP")
40
41 ;;; Advanced W-F-I tests by Elliott Slaughter <elliottslaughter@gmail.com>
42
43 (defvar *socket-server-port* 0)
44 (defvar *socket-server-listen* nil)
45 (defvar *socket-server-connection*)
46 (defvar *socket-client-connection*)
47 (defvar *output-p* t)
48
49 (defun stage-1 ()
50 (unless *socket-server-listen*
51 (setf *socket-server-listen*
52 (socket-listen *wildcard-host* 0 :element-type '(unsigned-byte 8)))
53 (setf *socket-server-port* (get-local-port *socket-server-listen*)))
54
55 (setf *socket-server-connection*
56 (when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
57 (socket-accept *socket-server-listen*)))
58
59 (when *output-p* ; should be NIL
60 (format t "First time (before client connects) is ~s.~%"
61 *socket-server-connection*))
62
63 *socket-server-connection*)
64
65 ;; TODO: original test code have addition (:TIMEOUT 0) when doing the SOCKET-CONNECT,
66 ;; it seems cannot work on SBCL/Windows, need to investigate, but here we ignore it.
67
68 (defun stage-2 ()
69 (setf *socket-client-connection*
70 (socket-connect "localhost" *socket-server-port* :protocol :stream
71 :element-type '(unsigned-byte 8)))
72 (setf *socket-server-connection*
73 (when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
74 #+(and win32 (or lispworks ecl sbcl))
75 (when *output-p*
76 (format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server-listen*)))
77 (socket-accept *socket-server-listen*)))
78
79 (when *output-p* ; should be a usocket object
80 (format t "Second time (after client connects) is ~s.~%"
81 *socket-server-connection*))
82
83 *socket-server-connection*)
84
85 (defun stage-3 ()
86 (setf *socket-server-connection*
87 (when (wait-for-input *socket-server-listen* :timeout 0 :ready-only t)
88 #+(and win32 (or lispworks ecl sbcl))
89 (when *output-p*
90 (format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server-listen*)))
91 (socket-accept *socket-server-listen*)))
92
93 (when *output-p* ; should be NIL again
94 (format t "Third time (before second client) is ~s.~%"
95 *socket-server-connection*))
96
97 *socket-server-connection*)
98
99 (deftest elliott-slaughter.1
100 (let ((*output-p* nil))
101 (let* ((s-1 (stage-1)) (s-2 (stage-2)) (s-3 (stage-3)))
102 (prog1 (and (null s-1) (usocket::usocket-p s-2) (null s-3))
103 (socket-close *socket-server-listen*)
104 (setf *socket-server-listen* nil))))
105 t)
106
107 #|
108
109 Issue elliott-slaughter.2 (WAIT-FOR-INPUT/win32 on TCP socket)
110
111 W-F-I correctly found the inputs, but :READY-ONLY didn't work.
112
113 |#
114 (defun receive-each (connections)
115 (let ((ready (usocket:wait-for-input connections :timeout 0 :ready-only t)))
116 (loop for connection in ready
117 collect (read-line (usocket:socket-stream connection)))))
118
119 (defun receive-all (connections)
120 (loop for messages = (receive-each connections)
121 then (receive-each connections)
122 while messages append messages))
123
124 (defun send (connection message)
125 (format (usocket:socket-stream connection) "~a~%" message)
126 (force-output (usocket:socket-stream connection)))
127
128 (defun server ()
129 (let* ((listen (usocket:socket-listen usocket:*wildcard-host* 12345))
130 (connection (usocket:socket-accept listen)))
131 (loop for messages = (receive-all connection) then (receive-all connection)
132 do (format t "Got messages:~%~s~%" messages)
133 do (sleep 1/50))))
134
135 (defun client ()
136 (let ((connection (usocket:socket-connect "localhost" 12345)))
137 (loop for i from 0
138 do (send connection (format nil "This is message ~a." i))
139 do (sleep 1/100))))