Author: ehuelsmann Date: Sun Jan 21 08:17:08 2007 New Revision: 194
Modified: trivial-usocket/trunk/trivial-usocket.asd (props changed) trivial-usocket/trunk/trivial-usocket.lisp (contents, props changed) Log: Complete trivial-sockets compat (by implementing server sockets).
Modified: trivial-usocket/trunk/trivial-usocket.lisp ============================================================================== --- trivial-usocket/trunk/trivial-usocket.lisp (original) +++ trivial-usocket/trunk/trivial-usocket.lisp Sun Jan 21 08:17:08 2007 @@ -10,7 +10,10 @@ #:usocket) (:export #:open-stream #:usocket - #:unsupported)) + #:unsupported + #:open-server + #:with-server + #:accept-connection))
(in-package :trivial-usocket)
@@ -151,11 +154,15 @@ :usocket usocket rest)))
+;; +;; The actual compat functions + (defun open-stream (peer-host peer-port &key (local-host :any) (local-port 0) (external-format :default) - (element-type 'character) + (element-type #-lispworks 'character + #+lispworks 'base-char) (protocol :tcp)) (unless (eq protocol :tcp) (error 'unsupported :feature `(:protocol ,protocol))) @@ -163,6 +170,48 @@ (error 'unsupported :feature :bind)) (unless (eql external-format :default) (error 'unsupported :feature :external-format)) - (let ((socket (socket-connect peer-host peer-port))) + (let ((socket (socket-connect peer-host peer-port + :element-type element-type))) (wrap-usocket-stream socket)))
+ +(defun open-server (&key (host :any) + (port 0) + (reuse-address t) + (backlog 1) + (protocol :tcp)) + (unless (eq protocol :tcp) + (error 'unsupported :feature `(:protocol ,protocol))) + (socket-listen (if (eq host :any) *wildcard-host* host) + port + :reuseaddress reuse-address + :backlog backlog)) + +(defun close-server (server) + (socket-close server)) + +(defun accept-connection (server &key (external-format :default) + (element-type #-lispworks 'character + #+lispworks 'base-char)) + (unless (eql external-format :default) + (error 'unsupported :feature :external-format)) + (wrap-usocket-stream (socket-accept server :element-type element-type))) + +(defmacro with-server ((server args) &body forms) + (let ((hostsym (gensym)) + (portsym (gensym)) + (newargs (gensym))) + `(let* ((,hostsym (or (getf ,args :host) + *wildcard-host*)) + (,portsym (or (getf ,args :port) + *wildcard-port*)) + (,newargs (copy-list ,args))) + (remf ,newargs :host) + (remf ,newargs :port) + (let ((,server (apply #'socket-listen ,hostsym ,portsym ,newargs))) + (when ,server + (unwind-protect + (progn + ,@forms) + (when ,server + (socket-close ,server))))))))