Skip to content
Snippets Groups Projects
Commit a3bdf733 authored by rtoy's avatar rtoy
Browse files

Convert more simple-error's to socket-error's so usocket and do

something useful with them.

Patch from Erik Huelsmann, cmucl-imp, 2006-02-05.
parent 906452d6
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/internet.lisp,v 1.46 2005/02/07 00:47:44 rtoy Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/internet.lisp,v 1.47 2006/02/06 20:00:03 rtoy Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -343,13 +343,18 @@ struct in_addr { ...@@ -343,13 +343,18 @@ struct in_addr {
(when (minusp (unix:unix-connect socket (when (minusp (unix:unix-connect socket
(alien-sap sockaddr) (alien-sap sockaddr)
(alien-size inet-sockaddr :bytes))) (alien-size inet-sockaddr :bytes)))
(unix:unix-close socket) ;; unix-close may affect errno; save the current value(s)
(error "Error connecting socket to [~A:~A]: ~A" (let ((errno (unix:unix-errno))
(if (stringp host) (errmsg (unix:get-unix-error-msg)))
host (unix:unix-close socket)
(ip-string addr)) (error 'socket-error
port :format-control "Error connecting socket to [~A:~A]: ~A"
(unix:get-unix-error-msg))) :format-arguments (list (if (stringp host)
host
(ip-string addr))
port
(unix:get-unix-error-msg))
:errno errno)))
socket))) socket)))
;; An attempt to rewrite connect-to-inet-socket in such a way that ;; An attempt to rewrite connect-to-inet-socket in such a way that
...@@ -405,9 +410,11 @@ struct in_addr { ...@@ -405,9 +410,11 @@ struct in_addr {
(ldb (byte 8 8) naddr) (ldb (byte 8 8) naddr)
(ldb (byte 8 16) naddr) (ldb (byte 8 16) naddr)
(ldb (byte 8 24) naddr)))) (ldb (byte 8 24) naddr))))
(connect-error (addr reason) (connect-error (addr reason errno)
(error "Error connecting socket to [~A:~A]: ~A" (error 'socket-error
addr port reason))) :format-control "Error connecting socket to [~A:~A]: ~A"
:format-arguments (list addr port reason)
:errno errno)))
(set-blocking socket) (set-blocking socket)
(with-alien ((sockaddr inet-sockaddr) (with-alien ((sockaddr inet-sockaddr)
(length (alien:array unsigned 1))) (length (alien:array unsigned 1)))
...@@ -419,9 +426,11 @@ struct in_addr { ...@@ -419,9 +426,11 @@ struct in_addr {
(alien-size inet-sockaddr :bytes)))) (alien-size inet-sockaddr :bytes))))
(cond ((< retval -1) (cond ((< retval -1)
;; connect failed ;; connect failed
(let ((reason (unix:get-unix-error-msg))) (let ((reason (unix:get-unix-error-msg))
(errno (unix:unix-errno)))
(unix:unix-close socket) (unix:unix-close socket)
(connect-error (if (stringp host) host (dotted-quad addr)) reason))) (connect-error (if (stringp host) host (dotted-quad addr))
reason errno)))
((= retval -1) ((= retval -1)
;; connect is in progress ;; connect is in progress
(system:wait-until-fd-usable socket :output) (system:wait-until-fd-usable socket :output)
...@@ -434,7 +443,8 @@ struct in_addr { ...@@ -434,7 +443,8 @@ struct in_addr {
;; It didn't, so let's find out why ;; It didn't, so let's find out why
(unix:unix-read socket (alien-sap length) 1) (unix:unix-read socket (alien-sap length) 1)
(connect-error (if (stringp host) host (dotted-quad addr)) (connect-error (if (stringp host) host (dotted-quad addr))
(unix:get-unix-error-msg))) (unix:get-unix-error-msg)
(unix:unix-errno)))
socket) socket)
(t (t
;; connect succeeded ;; connect succeeded
...@@ -478,7 +488,8 @@ struct in_addr { ...@@ -478,7 +488,8 @@ struct in_addr {
(host-entry-addr (or (lookup-host-entry host) (host-entry-addr (or (lookup-host-entry host)
(error 'socket-error (error 'socket-error
:format-control "Unknown host: ~S." :format-control "Unknown host: ~S."
:format-arguments (list host)))) :format-arguments (list host)
:errno (unix:unix-errno))))
host))) host)))
(when reuse-address (when reuse-address
(multiple-value-bind (optval errno) (multiple-value-bind (optval errno)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment