ttest-datagram.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
---
ttest-datagram.lisp (4727B)
---
1 ;;;; See LICENSE for licensing information.
2
3 (in-package :usocket-test)
4
5 (defvar *echo-server*)
6 (defvar *echo-server-port*)
7
8 (defun start-server ()
9 (multiple-value-bind (thread socket)
10 (socket-server "127.0.0.1" 0 #'identity nil
11 :in-new-thread t
12 :protocol :datagram)
13 (setq *echo-server* thread
14 *echo-server-port* (get-local-port socket))))
15
16 (defparameter *max-buffer-size* 32)
17
18 (defvar *send-buffer*
19 (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initial-element 0))
20
21 (defvar *receive-buffer*
22 (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initial-element 0))
23
24 (defun clean-buffers ()
25 (fill *send-buffer* 0)
26 (fill *receive-buffer* 0))
27
28 ;;; UDP Send Test #1: connected socket
29 (deftest udp-send.1
30 (progn
31 (unless (and *echo-server* *echo-server-port*)
32 (start-server))
33 (let ((s (socket-connect "127.0.0.1" *echo-server-port* :protocol :datagram)))
34 (clean-buffers)
35 (replace *send-buffer* #(1 2 3 4 5))
36 (socket-send s *send-buffer* 5)
37 (wait-for-input s :timeout 3)
38 (multiple-value-bind (buffer size host port)
39 (socket-receive s *receive-buffer* *max-buffer-size*)
40 (declare (ignore buffer size host port))
41 (reduce #'+ *receive-buffer* :start 0 :end 5))))
42 15)
43
44 ;;; UDP Send Test #2: unconnected socket
45 (deftest udp-send.2
46 (progn
47 (unless (and *echo-server* *echo-server-port*)
48 (start-server))
49 (let ((s (socket-connect nil nil :protocol :datagram)))
50 (clean-buffers)
51 (replace *send-buffer* #(1 2 3 4 5))
52 (socket-send s *send-buffer* 5 :host "127.0.0.1" :port *echo-server-port*)
53 (wait-for-input s :timeout 3)
54 (multiple-value-bind (buffer size host port)
55 (socket-receive s *receive-buffer* *max-buffer-size*)
56 (declare (ignore buffer size host port))
57 (reduce #'+ *receive-buffer* :start 0 :end 5))))
58 15)
59
60 (deftest mark-h-david ; Mark H. David's remarkable UDP test code
61 (let* ((host "localhost")
62 (port 1111)
63 (server-sock
64 (socket-connect nil nil :protocol ':datagram :local-host host :local-port port))
65 (client-sock
66 (socket-connect host port :protocol ':datagram))
67 (octet-vector
68 (make-array 2 :element-type '(unsigned-byte 8) :initial-contents `(,(char-code #\O) ,(char-code #\K))))
69 (recv-octet-vector
70 (make-array 2 :element-type '(unsigned-byte 8))))
71 (socket-send client-sock octet-vector 2)
72 (socket-receive server-sock recv-octet-vector 2)
73 (prog1 (and (equalp octet-vector recv-octet-vector)
74 recv-octet-vector)
75 (socket-close server-sock)
76 (socket-close client-sock)))
77 #(79 75))
78
79 (deftest frank-james ; Frank James' test code for LispWorks/UDP
80 (with-caught-conditions (#+win32 CONNECTION-RESET-ERROR
81 #-win32 CONNECTION-REFUSED-ERROR
82 nil)
83 (let ((sock (socket-connect "localhost" 1234
84 :protocol ':datagram :element-type '(unsigned-byte 8))))
85 (unwind-protect
86 (progn
87 (socket-send sock (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0) 16)
88 (let ((buffer (make-array 16 :element-type '(unsigned-byte 8) :initial-element 0)))
89 (socket-receive sock buffer 16)))
90 (socket-close sock))))
91 nil)
92
93 (defun frank-wfi-test ()
94 (let ((s (socket-connect nil nil :protocol :datagram
95 :element-type '(unsigned-byte 8)
96 :local-port 8001)))
97 (unwind-protect
98 (do ((i 0 (1+ i))
99 (buffer (make-array 1024 :element-type '(unsigned-byte 8)
100 :initial-element 0))
101 (now (get-universal-time))
102 (done nil))
103 ((or done (= i 4))
104 nil)
105 (format t "~Ds ~D Waiting state ~S~%" (- (get-universal-time) now) i (usocket::state s))
106 (when (wait-for-input s :ready-only t :timeout 5)
107 (format t "~D state ~S~%" i (usocket::state s))
108 (handler-bind
109 ((error (lambda (c)
110 (format t "socket-receive error: ~A~%" c)
111 (break)
112 nil)))
113 (multiple-value-bind (buffer count remote-host remote-port)
114 (socket-receive s buffer 1024)
115 (handler-bind
116 ((error (lambda (c)
117 (format t "socket-send error: ~A~%" c)
118 (break))))
119 (when buffer
120 (socket-send s (subseq buffer 0 count) count
121 :host remote-host
122 :port remote-port)))))))
123 (socket-close s))))