[usocket-cvs] r35 - public_html usocket/trunk usocket/trunk/backend

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Feb  3 18:14:37 2006
New Revision: 35

Modified:
   public_html/index.shtml
   usocket/trunk/README
   usocket/trunk/backend/allegro.lisp
Log:
Implement Allegro backend (and update website).

Modified: public_html/index.shtml
==============================================================================
--- public_html/index.shtml	(original)
+++ public_html/index.shtml	Fri Feb  3 18:14:37 2006
@@ -84,7 +84,7 @@
       <td class="WIP" title="Work in progress">WIP</td>
       <td class="TODO">TODO</td>
       <td class="DONE" title="Implemented">DONE</td>
-      <td class="WIP" title="Work in progress">WIP</td>
+      <td class="DONE" title="Implemented">DONE</td>
       <td class="TODO">TODO</td>
       <td class="TODO">TODO</td>
     </tr>

Modified: usocket/trunk/README
==============================================================================
--- usocket/trunk/README	(original)
+++ usocket/trunk/README	Fri Feb  3 18:14:37 2006
@@ -24,6 +24,8 @@
  - usocket-address-not-available-error
  - usocket-bad-file-descriptor-error
  - usocket-connection-refused-error
+ - usocket-connection-aborted-error * TODO
+ - usocket-connection-reset-error * TODO
  - usocket-invalid-argument-error
  - usocket-no-buffers-error
  - usocket-operation-not-supported-error

Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp	(original)
+++ usocket/trunk/backend/allegro.lisp	Fri Feb  3 18:14:37 2006
@@ -5,30 +5,55 @@
 
 (in-package :usocket)
 
+(defparameter +allegro-identifier-error-map+
+  '((:address-in-use . usocket-address-in-use-error)
+    (:address-not-available . usocket-address-not-available-error)
+    (:network-down . usocket-network-down-error)
+    (:network-reset . usocket-network-reset-error)
+;;    (:connection-aborted . ) FIXME: take these 2 errors in the supported list
+;;    (:connection-reset . )
+    (:no-buffer-space . usocket-no-buffers-error)
+    (:shutdown . usocket-shutdown-error)
+    (:connection-timed-out . usocket-timeout-error)
+    (:connection-refused . usocket-connection-refused-error)
+    (:host-down . usocket-host-down-error)
+    (:host-unreachable . usocket-host-unreachable-error)))
+
 (defun handle-condition (condition &optional (socket nil))
   "Dispatch correct usocket condition."
   (typecase condition
-    (condition (error 'usocket-error
-                      :real-condition condition
-                      :socket socket))))
+    (socket-error (let ((usock-err
+                         (cdr (assoc (stream-error-identifier condition)
+                                     +allegro-identifier-error-map+))))
+                    (if usock-err
+                        (error usock-err :socket socket)
+                      (error 'usocket-unknown-error
+                             :real-condition condition
+                             :socket socket))))))
 
-(defun open (host port &optional (type :stream))
+(defun socket-connect (host port &optional (type :stream))
   (declare (ignore type))
-  (let ((socket (sock:make-socket :remote-host host
-                                  :remote-port port)))
+  (let ((socket))
+    (setf socket
+          (with-mapped-conditions (socket)
+             (sock:make-socket :remote-host (host-to-hostname host)
+                               :remote-port port)))
     (make-socket :socket socket :stream socket)))
 
 (defmethod close ((usocket usocket))
   "Close socket."
-  (sock:close (socket usocket)))
+  (with-mapped-conditions (usocket)
+    (sock:close (socket usocket))))
 
 
 
 (defun get-host-by-address (address)
-  (sock:ipaddr-to-hostname address))
+  (with-mapped-conditions ()
+    (sock:ipaddr-to-hostname address)))
 
 (defun get-hosts-by-name (name)
   ;;###FIXME: ACL has the acldns module which returns all A records
   ;; only problem: it doesn't fall back to tcp (from udp) if the returned
   ;; structure is too long.
-  (list (hbo-to-vector-quad (sock:lookup-hostname name))))
+  (with-mapped-conditions ()
+    (list (hbo-to-vector-quad (sock:lookup-hostname name)))))