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))))