sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix GET-PROTOCOL-BY-NAME with unknown protocols

Browse source 
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.
This commit is contained in:
Michał "phoe" Herda 2020-11-13 19:43:31 +01:00
parent 1effa6a160
commit bb40da9fa6
3 changed files with 29 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
contrib/sockets/package.lisp
View file

@ -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"

26
contrib/sockets/sockets.lisp
View file

@ -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)

13
contrib/sockets/test.lisp
View file

@ -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)