test-datagram.lisp - clic - Clic is an command line interactive client for goph… | |
git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65… | |
Log | |
Files | |
Refs | |
Tags | |
README | |
LICENSE | |
--- | |
test-datagram.lisp (4810B) | |
--- | |
1 ;;;; -*- Mode: LISP; Base: 10; Syntax: ANSI-Common-lisp; Package: USOCKE… | |
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) :initia… | |
21 | |
22 (defvar *receive-buffer* | |
23 (make-array *max-buffer-size* :element-type '(unsigned-byte 8) :initia… | |
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 :d… | |
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-serve… | |
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 … | |
66 (client-sock | |
67 (socket-connect host port :protocol ':datagram)) | |
68 (octet-vector | |
69 (make-array 2 :element-type '(unsigned-byte 8) :initial-conten… | |
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-ty… | |
86 (unwind-protect | |
87 (progn | |
88 (socket-send sock (make-array 16 :element-type '(unsigned-by… | |
89 (let ((buffer (make-array 16 :element-type '(unsigned-byte 8… | |
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) … | |
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)))) |