GopherProxy

	twait-for-input.lisp - clic - Clic is an command line interactive client for go…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	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-t…
	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-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-timeou…
	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 <[email protected]…
	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…
	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-o…
	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 SO…
	66 ;; it seems cannot work on SBCL/Windows, need to investigate, but here w…
	67
	68 (defun stage-2 ()
	69 (setf socket-client-connection
	70 (socket-connect "localhost" socket-server-port :protocol :stre…
	71 :element-type '(unsigned-byte 8)))
	72 (setf socket-server-connection
	73 (when (wait-for-input socket-server-listen :timeout 0 :ready-o…
	74 #+(and win32 (or lispworks ecl sbcl))
	75 (when output-p
	76 (format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server…
	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-o…
	88 #+(and win32 (or lispworks ecl sbcl))
	89 (when output-p
	90 (format t "%READY-P: ~D~%" (usocket::%ready-p *socket-server…
	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-onl…
	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 conn…
	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))))