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