From bb40da9fa688760e6d07c04e5a398b8b8543d333 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C5=82=20=22phoe=22=20Herda?= <phoe@disroot.org>
Date: Fri, 13 Nov 2020 19:43:31 +0100
Subject: [PATCH] Fix GET-PROTOCOL-BY-NAME with unknown protocols

The function SB-BSD-SOCKETS:GET-PROTOCOL-BY-NAME did not signal
an error when it was unable to find a protocol. This is fixed now
and an error of type UNKNOWN-PROTOCOL, with an accessor named
UNKNOWN-PROTOCOL-NAME, is being signaled. These two names are also
exported from the package SB-BSD-SOCKETS.

A test case is added.

Several other test cases are fixed with regard to :NO-ERROR clauses
inside HANDLER-CASEs.
---
 contrib/sockets/package.lisp |  1 +
 contrib/sockets/sockets.lisp | 26 ++++++++++++++++++--------
 contrib/sockets/test.lisp    | 13 ++++++++++---
 3 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/contrib/sockets/package.lisp b/contrib/sockets/package.lisp
index 99ce79a41..e491dddc3 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 546141072..7a80b40c6 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 a63e250aa..93f063bf9 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)
-- 
GitLab