PageRenderTime 45ms CodeModel.GetById 18ms RepoModel.GetById 0ms app.codeStats 0ms

/contrib/sockets/test.lisp

https://gitlab.com/ivargasc/ecl
Lisp | 256 lines | 172 code | 36 blank | 48 comment | 2 complexity | 2d62c2accbcf527591a270744c722888 MD5 | raw file
Possible License(s): LGPL-2.0, CC-BY-SA-3.0, GPL-2.0, LGPL-2.1
  1. ;; -*- Mode: Lisp; Syntax: Common-Lisp -*-
  2. ;; $Id$
  3. ;; This file is based on SBCL's SB-BSD-SOCKET module and has been
  4. ;; heavily modified to work with ECL by Julian Stecklina.
  5. ;; Port to Windows Sockets contributed by M. Goffioul.
  6. ;; You may do whatever you want with this file. (PUBLIC DOMAIN)
  7. ;; Trivial stuff is copied from SBCL's SB-BSD-SOCKETS, which is also
  8. ;; in the public domain.
  9. (in-package :cl-user)
  10. (load "sys:sockets")
  11. (load "../rt/rt")
  12. (use-package :sb-bsd-sockets)
  13. (use-package :sb-rt)
  14. ;;; a real address
  15. (deftest make-inet-address
  16. (equalp (make-inet-address "127.0.0.1") #(127 0 0 1))
  17. t)
  18. ;;; and an address with bit 8 set on some octets
  19. (deftest make-inet-address2
  20. (equalp (make-inet-address "242.1.211.3") #(242 1 211 3))
  21. t)
  22. (deftest make-inet-socket
  23. ;; make a socket
  24. (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
  25. (and (> (socket-file-descriptor s) 1) t))
  26. t)
  27. (deftest make-inet-socket-keyword
  28. ;; make a socket
  29. (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
  30. (and (> (socket-file-descriptor s) 1) t))
  31. t)
  32. (deftest make-inet-socket-wrong
  33. ;; fail to make a socket: check correct error return. There's no nice
  34. ;; way to check the condition stuff on its own, which is a shame
  35. (handler-case
  36. (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp"))
  37. ((or socket-type-not-supported-error protocol-not-supported-error) (c)
  38. (declare (ignorable c)) t)
  39. (:no-error nil))
  40. t)
  41. (deftest make-inet-socket-keyword-wrong
  42. ;; same again with keywords
  43. (handler-case
  44. (make-instance 'inet-socket :type :stream :protocol :udp)
  45. ((or protocol-not-supported-error socket-type-not-supported-error) (c)
  46. (declare (ignorable c)) t)
  47. (:no-error nil))
  48. t)
  49. (deftest non-block-socket
  50. (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
  51. (setf (non-blocking-mode s) t)
  52. (non-blocking-mode s))
  53. t)
  54. (defun do-gc-portably ()
  55. ;; cmucl on linux has generational gc with a keyword argument,
  56. ;; sbcl GC function takes same arguments no matter what collector is in
  57. ;; use
  58. #+(or sbcl gencgc) (SB-EXT:gc :full t)
  59. #+ecl (ext:gc t)
  60. ;; other platforms have full gc or nothing
  61. #-(or sbcl gencgc ecl) (sb-ext:gc))
  62. (deftest inet-socket-bind
  63. (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
  64. ;; Given the functions we've got so far, if you can think of a
  65. ;; better way to make sure the bind succeeded than trying it
  66. ;; twice, let me know
  67. ;; 1974 has no special significance, unless you're the same age as me
  68. (do-gc-portably) ;gc should clear out any old sockets bound to this port
  69. (socket-bind s (make-inet-address "127.0.0.1") 1974)
  70. (handler-case
  71. (let ((s2 (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
  72. (socket-bind s2 (make-inet-address "127.0.0.1") 1974)
  73. nil)
  74. (address-in-use-error () t)))
  75. t)
  76. (deftest simple-sockopt-test
  77. ;; test we can set SO_REUSEADDR on a socket and retrieve it, and in
  78. ;; the process that all the weird macros in sockopt happened right.
  79. (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp"))))
  80. (setf (sockopt-reuse-address s) t)
  81. (sockopt-reuse-address s))
  82. t)
  83. (defun read-buf-nonblock (buffer stream)
  84. "Like READ-SEQUENCE, but returns early if the full quantity of data isn't there to be read. Blocks if no input at all"
  85. (let ((eof (gensym)))
  86. (do ((i 0 (1+ i))
  87. (c (read-char stream nil eof)
  88. (read-char-no-hang stream nil eof)))
  89. ((or (>= i (length buffer)) (not c) (eq c eof)) i)
  90. (setf (elt buffer i) c))))
  91. (deftest name-service-return-type
  92. (vectorp (host-ent-address (get-host-by-address #(127 0 0 1))))
  93. t)
  94. ;;; these require that the echo services are turned on in inetd
  95. (deftest simple-tcp-client
  96. (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp))
  97. (data (make-string 200)))
  98. (socket-connect s #(127 0 0 1) 7)
  99. (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
  100. (format stream "here is some text")
  101. (let ((data (subseq data 0 (read-buf-nonblock data stream))))
  102. (format t "~&Got ~S back from TCP echo server~%" data)
  103. (> (length data) 0))))
  104. t)
  105. (deftest sockaddr-return-type
  106. (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
  107. (unwind-protect
  108. (progn
  109. (socket-connect s #(127 0 0 1) 7)
  110. (multiple-value-bind (host port) (socket-peername s)
  111. (and (vectorp host)
  112. (numberp port))))
  113. (socket-close s)))
  114. t)
  115. (deftest simple-udp-client
  116. (let ((s (make-instance 'inet-socket :type :datagram :protocol (get-protocol-by-name "udp")))
  117. (data (make-string 200)))
  118. (format t "Socket type is ~A~%" (sockopt-type s))
  119. (socket-connect s #(127 0 0 1) 7)
  120. (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
  121. (format stream "here is some text")
  122. (finish-output stream)
  123. (let ((data (subseq data 0 (read-buf-nonblock data stream))))
  124. (format t "~&Got ~S back from UDP echo server~%" data)
  125. (> (length data) 0))))
  126. t)
  127. ;;; A fairly rudimentary test that connects to the syslog socket and
  128. ;;; sends a message. Priority 7 is kern.debug; you'll probably want
  129. ;;; to look at /etc/syslog.conf or local equivalent to find out where
  130. ;;; the message ended up
  131. (deftest simple-local-client
  132. (progn
  133. ;; SunOS (Solaris) and Darwin systems don't have a socket at
  134. ;; /dev/log. We might also be building in a chroot or
  135. ;; something, so don't fail this test just because the file is
  136. ;; unavailable, or if it's a symlink to some weird character
  137. ;; device.
  138. (when (and (probe-file "/dev/log")
  139. #-ecl
  140. (sb-posix:s-issock
  141. (sb-posix::stat-mode (sb-posix:stat "/dev/log"))))
  142. (let ((s (make-instance 'local-socket :type :datagram)))
  143. (format t "Connecting ~A... " s)
  144. (finish-output)
  145. (handler-case
  146. (socket-connect s "/dev/log")
  147. (socket-error ()
  148. (setq s (make-instance 'local-socket :type :stream))
  149. (format t "failed~%Retrying with ~A... " s)
  150. (finish-output)
  151. (socket-connect s "/dev/log")))
  152. (format t "ok.~%")
  153. (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
  154. (format stream
  155. "<7>sb-bsd-sockets: Don't panic. We're testing local-domain client code; this message can safely be ignored"))))
  156. t)
  157. t)
  158. ;;; these require that the internet (or bits of it, at least) is available
  159. (deftest get-host-by-name
  160. (equalp (car (host-ent-addresses (get-host-by-name "a.root-servers.net")))
  161. #(198 41 0 4))
  162. t)
  163. (deftest get-host-by-address
  164. (host-ent-name (get-host-by-address #(198 41 0 4)))
  165. "a.root-servers.net")
  166. (deftest get-host-by-name-wrong
  167. (handler-case
  168. (get-host-by-name "foo.tninkpad.telent.net")
  169. (NAME-SERVICE-ERROR () t)
  170. (:no-error nil))
  171. t)
  172. (defun http-stream (host port request)
  173. (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)))
  174. (socket-connect
  175. s (car (host-ent-addresses (get-host-by-name host))) port)
  176. (let ((stream (socket-make-stream s :input t :output t :buffering :none)))
  177. (format stream "~A HTTP/1.0~%~%" request))
  178. s))
  179. (deftest simple-http-client-1
  180. (handler-case
  181. (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
  182. (let ((data (make-string 200)))
  183. (setf data (subseq data 0
  184. (read-buf-nonblock data
  185. (socket-make-stream s))))
  186. (princ data)
  187. (> (length data) 0)))
  188. (network-unreachable-error () 'network-unreachable))
  189. t)
  190. (deftest sockopt-receive-buffer
  191. ;; on Linux x86, the receive buffer size appears to be doubled in the
  192. ;; kernel: we set a size of x and then getsockopt() returns 2x.
  193. ;; This is why we compare with >= instead of =
  194. (handler-case
  195. (let ((s (http-stream "ww.telent.net" 80 "HEAD /")))
  196. (setf (sockopt-receive-buffer s) 1975)
  197. (let ((data (make-string 200)))
  198. (setf data (subseq data 0
  199. (read-buf-nonblock data
  200. (socket-make-stream s))))
  201. (and (> (length data) 0)
  202. (>= (sockopt-receive-buffer s) 1975))))
  203. (network-unreachable-error () 'network-unreachable))
  204. t)
  205. ;;; we don't have an automatic test for some of this yet. There's no
  206. ;;; simple way to run servers and have something automatically connect
  207. ;;; to them as client, unless we spawn external programs. Then we
  208. ;;; have to start telling people what external programs they should
  209. ;;; have installed. Which, eventually, we will, but not just yet
  210. ;;; to check with this: can display packets from multiple peers
  211. ;;; peer address is shown correctly for each packet
  212. ;;; packet length is correct
  213. ;;; long (>500 byte) packets have the full length shown (doesn't work)
  214. (defun udp-server (port)
  215. (let ((s (make-instance 'inet-socket :type :datagram :protocol :udp)))
  216. (socket-bind s #(0 0 0 0) port)
  217. (loop
  218. (multiple-value-bind (buf len address port) (socket-receive s nil 500)
  219. (format t "Received ~A bytes from ~A:~A - ~A ~%"
  220. len address port (subseq buf 0 (min 10 len)))))))