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

Contents of /trivial-sockets/openmcl.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: 2317 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)) (format nil "~{~A~^.~}" (coerce name 'list)))
7 (t name)))
8
9 (defun open-stream (peer-host peer-port
10 &key (local-host :any) (local-port 0)
11 (external-format :default)
12 (element-type 'character)
13 (protocol :tcp))
14 (declare (ignore element-type))
15 (unless (eql protocol :tcp)
16 (error 'unsupported :feature `(:protocol ,protocol)))
17 (unless (eql external-format :default)
18 (error 'unsupported :feature :external-format))
19 (handler-bind ((ccl::socket-creation-error
20 (lambda (c) (error 'socket-error :nested-error c))))
21 (ccl:make-socket :address-family :internet
22 :connect :active
23 :type :stream
24 :remote-host (resolve-hostname peer-host)
25 :remote-port peer-port
26 :local-host (resolve-hostname local-host)
27 :local-port local-port)))
28
29 (defun open-server (&key (host :any) (port 0)
30 (reuse-address t)
31 (backlog 1)
32 (protocol :tcp))
33 "Returns a SERVER object and the port that was bound, as multiple values"
34 (unless (eql protocol :tcp)
35 (error 'unsupported :feature `(:protocol ,protocol)))
36 (handler-bind ((ccl::socket-creation-error
37 (lambda (c) (error 'socket-error :nested-error c))))
38 (let* ((host (if (eql host :any) nil host))
39 (socket (ccl:make-socket :address-family :internet
40 :type :stream
41 :connect :passive
42 :local-host host
43 :local-port port
44 :reuse-address reuse-address
45 :backlog backlog)))
46 (values socket (ccl:local-port socket)))))
47
48 (defun close-server (server)
49 (close server))
50
51 (defun accept-connection (socket
52 &key
53 (external-format :default)
54 (element-type 'character))
55 (declare (ignore element-type)) ; openmcl streams are bivalent.
56 (unless (eql external-format :default)
57 (error 'unsupported :feature :external-format))
58 (handler-bind ((ccl:socket-error
59 (lambda (c) (error 'socket-error :nested-error c))))
60 (ccl:accept-connection socket :wait t)))

  ViewVC Help
Powered by ViewVC 1.1.5