diff --git a/contrib/sockets/package.lisp b/contrib/sockets/package.lisp index 99ce79a414bd13635b6dbc782589e0aeea9bc8db..e491dddc3334bc2db55eeee21c84ec583f752fcf 100644 --- a/contrib/sockets/package.lisp +++ b/contrib/sockets/package.lisp @@ -17,6 +17,7 @@ "SOCKET-PEERNAME" "SOCKET-NAME" "SOCKET-LISTEN" "SOCKET-RECEIVE" "SOCKET-CLOSE" "SOCKET-MAKE-STREAM" "GET-PROTOCOL-BY-NAME" "MAKE-INET-ADDRESS" "LOCAL-SOCKET" + "UNKNOWN-PROTOCOL" "UNKNOWN-PROTOCOL-NAME" "SOCKET" "INET-SOCKET" "SOCKET-FILE-DESCRIPTOR" #+:win32 "NAMED-PIPE-SOCKET" "SOCKET-FAMILY" "SOCKET-PROTOCOL" "SOCKET-TYPE" "SOCKET-ERROR" "NAME-SERVICE-ERROR" "NON-BLOCKING-MODE" diff --git a/contrib/sockets/sockets.lisp b/contrib/sockets/sockets.lisp index 5461410728c1d9c47981e654ba2f4ce62d2dab4a..7a80b40c6831c8c58d858f126e8f8a5ff21882ed 100755 --- a/contrib/sockets/sockets.lisp +++ b/contrib/sockets/sockets.lisp @@ -571,17 +571,27 @@ safe_buffer_pointer(cl_object x, cl_index size) ;; We could refactor a lot here, if we pass sockaddr_foo structs around in Lisp. But ;; I do not feel comfortable with that. +(define-condition unknown-protocol (error) + ((name :initarg :name + :reader unknown-protocol-name)) + (:report (lambda (condition stream) + (format stream "Protocol not found: ~A" + (prin1-to-string (unknown-protocol-name condition)))))) + (defun get-protocol-by-name (string-or-symbol) "Calls getprotobyname" #-:android - (let ((string (string string-or-symbol))) - (c-inline (string) (:cstring) :int - "{ - struct protoent *pe; - pe = getprotobyname(#0); - @(return 0) = pe ? pe->p_proto : -1; - } - ")) + (let* ((string (string string-or-symbol)) + (proto-num (c-inline (string) (:cstring) :int + "{ + struct protoent *pe; + pe = getprotobyname(#0); + @(return 0) = pe ? pe->p_proto : -1; + } + "))) + (if (= proto-num -1) + (error 'unknown-protocol :name string) + proto-num)) ;; getprotobyname is not yet implemented on bionic #+:android (let ((proto (string-downcase (if (symbolp string-or-symbol) diff --git a/contrib/sockets/test.lisp b/contrib/sockets/test.lisp index a63e250aad9c91a11398eb83e41f50ca7717e2e9..93f063bf91dea2ed634603b3f5fb0f54a4a9f9fe 100644 --- a/contrib/sockets/test.lisp +++ b/contrib/sockets/test.lisp @@ -27,6 +27,13 @@ (equalp (make-inet-address "242.1.211.3") #(242 1 211 3)) t) +(deftest get-protocol-by-name-unknown-protocol + (let ((protocol-name "totally-unknown-protocol")) + (handler-case (get-protocol-by-name protocol-name) + (unknown-protocol (c) (string= protocol-name (unknown-protocol-name c))) + (:no-error (&rest args) (declare (ignore args)) nil))) + t) + (deftest make-inet-socket ;; make a socket (let ((s (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "tcp")))) @@ -46,7 +53,7 @@ (make-instance 'inet-socket :type :stream :protocol (get-protocol-by-name "udp")) ((or socket-type-not-supported-error protocol-not-supported-error) (c) (declare (ignorable c)) t) - (:no-error nil)) + (:no-error (&rest args) (declare (ignore args)) nil)) t) (deftest make-inet-socket-keyword-wrong @@ -55,7 +62,7 @@ (make-instance 'inet-socket :type :stream :protocol :udp) ((or protocol-not-supported-error socket-type-not-supported-error) (c) (declare (ignorable c)) t) - (:no-error nil)) + (:no-error (&rest args) (declare (ignore args)) nil)) t) @@ -194,7 +201,7 @@ (handler-case (get-host-by-name "foo.tninkpad.telent.net") (NAME-SERVICE-ERROR () t) - (:no-error nil)) + (:no-error (&rest args) (declare (ignore args)) nil)) t) (defun http-stream (host port request)