Commit 7dd1df4a authored by Chun Tian (binghe)'s avatar Chun Tian (binghe)

[ABCL, Allegro] Added :host-or-ip support, fixing compilation warnings

parent a41c0294
......@@ -142,7 +142,7 @@
(defparameter +abcl-nameserver-error-map+
`(("java.net.UnknownHostException" . ns-host-not-found-error)))
(defun handle-condition (condition &optional (socket nil))
(defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
(typecase condition
(java-exception
(let ((java-cause (java-exception-cause condition)))
......@@ -154,7 +154,7 @@
(nameserver-error (cdr (assoc (jclass-of java-cause) +abcl-nameserver-error-map+
:test #'string=))))
(if nameserver-error
(error nameserver-error :host-or-ip nil)
(error nameserver-error :socket socket :host-or-ip host-or-ip)
(when usock-error
(error usock-error :socket socket))))))))
......@@ -178,14 +178,14 @@
(t nil)))))) ; neither a IPv4 nor IPv6 address?!
(defun get-hosts-by-name (name)
(with-mapped-conditions ()
(with-mapped-conditions (nil name)
(map 'list #'get-address (%get-all-by-name name))))
;;; GET-HOST-BY-ADDRESS
(defun get-host-by-address (host)
(let ((inet4 (host-to-inet4 host)))
(with-mapped-conditions ()
(with-mapped-conditions (nil host)
(jcall $@getHostName/0 inet4))))
;;; SOCKET-CONNECT
......
......@@ -34,19 +34,24 @@
(:host-down . host-down-error)
(:host-unreachable . host-unreachable-error)))
(defun handle-condition (condition &optional (socket nil))
;; TODO: what's the error class of Corman Lisp?
(defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
"Dispatch correct usocket condition."
(typecase condition
#+allegro
(excl:socket-error
(let ((usock-err
(let ((usock-error
(cdr (assoc (excl:stream-error-identifier condition)
+allegro-identifier-error-map+))))
(if usock-err
(error usock-err :socket socket)
(error 'unknown-error
:real-error condition
:socket socket))))))
(declare (type symbol usock-error))
(if usock-error
(cond ((subtypep usock-error 'ns-error)
(error usock-error :socket socket :host-or-ip host-or-ip))
(t
(error usock-error :socket socket)))
(error 'unknown-error
:real-error condition
:socket socket))))))
(defun to-format (element-type)
(if (subtypep element-type 'character)
......@@ -183,14 +188,14 @@
(socket:receive-from s length :buffer buffer :extract t))))
(defun get-host-by-address (address)
(with-mapped-conditions ()
(with-mapped-conditions (nil address)
(socket:ipaddr-to-hostname (host-to-hbo 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.
(with-mapped-conditions ()
(with-mapped-conditions (nil name)
(list (hbo-to-vector-quad (socket:lookup-hostname
(host-to-hostname name))))))
......
......@@ -183,6 +183,7 @@
#-(or ecl clasp)
(sb-bsd-sockets:host-not-found-error . ns-host-not-found-error)))
;; this function servers as a general template for other backends
(defun handle-condition (condition &optional (socket nil) (host-or-ip nil))
"Dispatch correct usocket condition."
(typecase condition
......@@ -192,17 +193,27 @@
(funcall usock-error condition)
usock-error)))
(declare (type symbol usock-error))
(cond ((subtypep usock-error 'ns-condition)
(error usock-error :socket socket :host-or-ip host-or-ip))
(t
(error usock-error :socket socket)))))
(condition (let* ((usock-cond (cdr (assoc (type-of condition)
+sbcl-condition-map+)))
(usock-cond (if (functionp usock-cond)
(funcall usock-cond condition)
usock-cond)))
(if usock-cond
(signal usock-cond :socket socket))))))
(if usock-error
(cond ((subtypep usock-error 'ns-error)
(error usock-error :socket socket :host-or-ip host-or-ip))
(t
(error usock-error :socket socket)))
(error 'unknown-error
:real-error condition
:socket socket))))
(condition
(let* ((usock-cond (cdr (assoc (type-of condition) +sbcl-condition-map+)))
(usock-cond (if (functionp usock-cond)
(funcall usock-cond condition)
usock-cond)))
(if usock-cond
(cond ((subtypep usock-cond 'ns-condition)
(signal usock-cond :socket socket :host-or-ip host-or-ip))
(t
(signal usock-cond :socket socket)))
(signal 'unknown-condition
:real-condition condition
:socket socket))))))
;;; "The socket stream ends up with a bogus name as it is created before
;;; the socket is connected, making things harder to debug than they need
......
......@@ -67,7 +67,8 @@ been implemented yet."))
(defun define-usocket-condition-class (class &rest parents)
`(progn
(define-condition ,class ,parents ())
(export ',class))))
(eval-when (:load-toplevel :execute)
(export ',class)))))
(defmacro define-usocket-condition-classes (class-list parents)
`(progn ,@(mapcar #'(lambda (x)
......
......@@ -246,7 +246,8 @@
(defmethod (setf socket-option) (new-value (usocket datagram-usocket)
(option (eql :broadcast)) &key)
(declare (type boolean new-value) (ignorable new-value option))
(declare (type boolean new-value)
(ignorable new-value option))
(let ((socket (socket usocket)))
(declare (ignorable socket))
#+abcl
......@@ -277,7 +278,7 @@
(defmethod socket-option ((usocket stream-usocket)
(option (eql :tcp-no-delay)) &key)
(declare (ignore option))
(declare (ignorable option))
(socket-option usocket :tcp-nodelay))
(defmethod socket-option ((usocket stream-usocket)
......@@ -310,12 +311,13 @@
(defmethod (setf socket-option) (new-value (usocket stream-usocket)
(option (eql :tcp-no-delay)) &key)
(declare (ignore option))
(declare (ignorable option))
(setf (socket-option usocket :tcp-nodelay) new-value))
(defmethod (setf socket-option) (new-value (usocket stream-usocket)
(option (eql :tcp-nodelay)) &key)
(declare (type boolean new-value) (ignorable new-value option))
(declare (type boolean new-value)
(ignorable new-value option))
(let ((socket (socket usocket)))
(declare (ignorable socket))
#+abcl
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment