From ea166a9d274d12e8680c3fe176a31b07b0df68d5 Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Thu, 9 Dec 2004 21:56:15 +0000
Subject: [PATCH] Add a new socket-error condition type, a subtype of error,
 and use it in several places to signal socket errors instead of generic
 errors. (For better support for trivial-sockets.)

---
 code/internet.lisp | 72 ++++++++++++++++++++++++++++++++++------------
 1 file changed, 53 insertions(+), 19 deletions(-)

diff --git a/code/internet.lisp b/code/internet.lisp
index 7bab48413..451df8f49 100644
--- a/code/internet.lisp
+++ b/code/internet.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/internet.lisp,v 1.41 2004/07/25 19:32:38 pmai Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/internet.lisp,v 1.42 2004/12/09 21:56:15 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -68,6 +68,13 @@
 #+linux
 (defconstant msg-proxy 16)
 
+;; For errors with socket stuff.
+(define-condition socket-error (simple-error)
+  ((errno :reader socket-errno
+	  :initarg :errno
+	  :initform 0)))
+  
+  
 (defvar *internet-protocols*
   '((:stream    6 #.sock-stream)
     (:datagram 17 #.sock-dgram))
@@ -246,7 +253,10 @@ struct in_addr {
     (declare (ignore proto))
     (let ((socket (unix:unix-socket af-unix type 0)))
       (when (minusp socket)
-	(error "Error creating socket: ~A" (unix:get-unix-error-msg)))
+	(error 'socket-error
+	       :format-control "Error creating socket: ~A"
+	       :format-arguments (list (unix:get-unix-error-msg))
+	       :errno (unix:unix-errno)))
       socket)))
 
 (defun connect-to-unix-socket (path &optional (kind :stream))
@@ -263,8 +273,10 @@ struct in_addr {
 				       (alien-sap sockaddr)
 				       (alien-size unix-sockaddr :bytes)))
 	(unix:unix-close socket)
-	(error "Error connecting socket to [~A]: ~A"
-	       path (unix:get-unix-error-msg)))
+	(error 'socket-error
+	       :format-control "Error connecting socket to [~A]: ~A"
+	       :format-arguments (list path (unix:get-unix-error-msg))
+	       :errno (unix:unix-errno)))
       socket)))
 
 (defun create-unix-listener (path &optional (kind :stream)
@@ -308,10 +320,13 @@ struct in_addr {
 		       (internet-protocol kind)
     (let ((socket (unix:unix-socket af-inet type proto)))
       (when (minusp socket)
-	(error "Error creating socket: ~A" (unix:get-unix-error-msg)))
+	(error 'socket-error
+	       :format-control"Error creating socket: ~A"
+	       :format-arguments (list (unix:get-unix-error-msg))
+	       :errno (unix:unix-errno)))
       socket)))
 
- (defun connect-to-inet-socket (host port &optional (kind :stream))
+(defun connect-to-inet-socket (host port &optional (kind :stream))
   "The host may be an address string or an IP address in host order."
   (let* ((addr (if (stringp host)
 		   (host-entry-addr (or (lookup-host-entry host)
@@ -458,13 +473,18 @@ struct in_addr {
   (let ((socket (create-inet-socket kind))
         (addr (if (stringp host)
 		  (host-entry-addr (or (lookup-host-entry host)
-				       (error "Unknown host: ~S." host)))
+				       (error 'socket-error
+					      :format-control "Unknown host: ~S."
+					      :format-arguments (list host))))
 		  host)))
     (when reuse-address
       (multiple-value-bind (optval errno)
 	  (set-socket-option socket sol-socket so-reuseaddr 1)
-	(or optval (error "Error ~s setting socket option on socket ~d."
-			  (unix:get-unix-error-msg errno) socket))))
+	(or optval (error 'socket-error
+			  :format-control "Error ~S setting socket option on socket ~D."
+			  :format-arguments (list (unix:get-unix-error-msg errno)
+						  socket)
+			  :errno errno))))
     (with-alien ((sockaddr inet-sockaddr))
       (setf (slot sockaddr 'family) af-inet)
       (setf (slot sockaddr 'port) (htons port))
@@ -472,14 +492,21 @@ struct in_addr {
       (when (minusp (unix:unix-bind socket
 				    (alien-sap sockaddr)
 				    (alien-size inet-sockaddr :bytes)))
-	(unix:unix-close socket)
-	(error "Error binding socket to port ~a: ~a"
-	       port
-	       (unix:get-unix-error-msg))))
+	(let ((errno (unix:unix-errno)))
+	  (unix:unix-close socket)
+	  (error 'socket-error
+		 :format-control "Error binding socket to port ~A: ~A"
+		 :format-arguments (list port
+					 (unix:get-unix-error-msg))
+		 :errno errno))))
     (when (eq kind :stream)
       (when (minusp (unix:unix-listen socket backlog))
-	(unix:unix-close socket)
-	(error "Error listening to socket: ~A" (unix:get-unix-error-msg))))
+	(let ((errno (unix:unix-errno)))
+	  (unix:unix-close socket)
+	  (error 'socket-error
+		 :format-control "Error listening to socket: ~A"
+		 :format-arguments (list (unix:get-unix-error-msg))
+		 :errno errno))))
     socket))
 
 (defun accept-tcp-connection (unconnected)
@@ -489,15 +516,22 @@ struct in_addr {
     (let ((connected (unix:unix-accept unconnected
 				       (alien-sap sockaddr)
 				       (alien-size inet-sockaddr :bytes))))
-      (when (minusp connected)
-	(error "Error accepting a connection: ~A" (unix:get-unix-error-msg)))
-      (values connected (ntohl (slot sockaddr 'addr))))))
+      (let ((errno (unix:unix-errno)))
+	(when (minusp connected)
+	  (error 'socket-error
+		 :format-control "Error accepting a connection: ~A"
+		 :format-arguments (list (unix:get-unix-error-msg))
+		 :errno errno))
+	(values connected (ntohl (slot sockaddr 'addr)))))))
 
 (defun close-socket (socket)
   (multiple-value-bind (ok err)
 		       (unix:unix-close socket)
     (unless ok
-      (error "Error closing socket: ~A" (unix:get-unix-error-msg err))))
+      (error 'socket-error
+	     :format-control "Error closing socket: ~A"
+	     :format-arguments (list (unix:get-unix-error-msg err))
+	     :errno (unix:unix-errno))))
   (undefined-value))
 
 (defun get-peer-host-and-port (fd)
-- 
GitLab