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

Contents of /trivial-sockets/clisp.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: 2049 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 (unless (and (eql local-host :any) (eql local-port 0))
15 (error 'unsupported :feature :bind))
16 (unless (eql protocol :tcp)
17 (error 'unsupported :feature `(:protocol ,protocol)))
18 ;; FIXME I wish there were a smarter way to detect only the errors
19 ;; we're interested in, but CLISP impnotes don't say what to look for
20 (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
21 (socket:socket-connect peer-port (resolve-hostname peer-host)
22 :element-type element-type
23 :external-format external-format
24 :buffered nil
25 )))
26
27
28 (defun open-server (&key (host :any) (port 0)
29 (reuse-address t)
30 (backlog 1)
31 (protocol :tcp))
32 (unless (eql protocol :tcp)
33 (error 'unsupported :feature `(:protocol ,protocol)))
34 (unless (equal (resolve-hostname host) "0.0.0.0")
35 (error 'unsupported :feature :bind))
36 (unless (= backlog 1)
37 ;; we established that the default backlog is 1 by stracing clisp
38 ;; 2.33.2 (2004-06-02) (built 3304881526)
39 (error 'unsupported :feature :backlog))
40 (unless reuse-address
41 (error 'unsupported :feature :nil-reuse-address))
42 (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
43 (let ((s (socket:socket-server port)))
44 (values s (socket:socket-server-port s)))))
45
46 (defun close-server (server)
47 (socket:socket-server-close server))
48
49 (defun accept-connection (socket
50 &key
51 (external-format :default)
52 (element-type 'character))
53 (handler-bind ((error (lambda (c) (error 'socket-error :nested-error c))))
54 (socket:socket-accept socket :external-format external-format
55 :element-type element-type
56 :buffered nil)))

  ViewVC Help
Powered by ViewVC 1.1.5