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