/[usocket]/trivial-sockets/sbcl.lisp
ViewVC logotype

Contents of /trivial-sockets/sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 364 - (show annotations)
Sun Jul 13 18:16:19 2008 UTC (5 years, 9 months ago) by ehuelsmann
File size: 2248 byte(s)
Trivial sockets imported as gotten from the clbuild project mirror.
1 (in-package :trivial-sockets)
2
3 (defun resolve-hostname (name)
4 (cond
5 ((eql name :any) #(0 0 0 0))
6 ((typep name '(vector * 4)) name)
7 (t (car (sb-bsd-sockets:host-ent-addresses
8 (sb-bsd-sockets:get-host-by-name name))))))
9
10 (defun open-stream (peer-host peer-port
11 &key (local-host :any) (local-port 0)
12 (external-format :default)
13 (element-type 'character)
14 (protocol :tcp))
15 (unless (eql external-format :default)
16 (error 'unsupported :feature :external-format))
17 (handler-bind ((sb-bsd-sockets:socket-error
18 (lambda (c) (error 'socket-error :nested-error c)))
19 (sb-bsd-sockets:name-service-error
20 (lambda (c) (error 'socket-error :nested-error c))))
21 (let ((s (make-instance 'sb-bsd-sockets:inet-socket
22 :type :stream
23 :protocol protocol))
24 (me (resolve-hostname local-host)))
25 (unless (and (equal me #(0 0 0 0)) (eql local-port 0))
26 (sb-bsd-sockets:socket-bind s me local-port))
27 (sb-bsd-sockets:socket-connect
28 s (resolve-hostname peer-host) peer-port)
29 (sb-bsd-sockets:socket-make-stream s :input t :output t
30 :element-type element-type
31 :buffering :full))))
32
33 (defun open-server (&key (host :any) (port 0)
34 (reuse-address t)
35 (backlog 1)
36 (protocol :tcp))
37 "Returns a SERVER object and the port that was bound, as multiple values"
38 (let ((sock (make-instance 'sb-bsd-sockets:inet-socket
39 :type :stream
40 :protocol protocol)))
41 (when reuse-address
42 (setf (sb-bsd-sockets:sockopt-reuse-address sock) t))
43 (sb-bsd-sockets:socket-bind sock (resolve-hostname host) port)
44 (sb-bsd-sockets:socket-listen sock backlog)
45 (multiple-value-bind (h p) (sb-bsd-sockets:socket-name sock)
46 (declare (ignore h))
47 (values sock p))))
48
49 (defun close-server (server)
50 (sb-bsd-sockets:socket-close server))
51
52 (defun accept-connection (socket
53 &key
54 (external-format :default)
55 (element-type 'character))
56 (unless (eql external-format :default)
57 (error 'unsupported :feature :external-format))
58 (let ((s (sb-bsd-sockets:socket-accept socket)))
59 (sb-bsd-sockets:socket-make-stream s
60 :input t :output t
61 :element-type element-type
62 :buffering :full)))
63

  ViewVC Help
Powered by ViewVC 1.1.5