From 34f433eb2a61281c2cd274687d33b61f577f4ba4 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Fri, 14 Apr 2006 07:23:04 +0000 Subject: [PATCH] =?utf8?q?0.9.11.34:=20 Add=20support=20for=20sending=20data?= =?utf8?q?=20over=20UDP=20sockets=20to=20SB-BSD-SOCKETS=20=20=20=20=20=20=20?= =?utf8?q?=20=20(finally).=20Thanks=20to=20Far=E9=20for=20the=20patch.?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit --- NEWS | 2 + contrib/sb-bsd-sockets/constants.lisp | 56 ++++++++++++++++---- contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo | 2 + contrib/sb-bsd-sockets/sockets.lisp | 70 +++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 122 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index fe6735c..8100381 100644 --- a/NEWS +++ b/NEWS @@ -14,6 +14,8 @@ changes in sbcl-0.9.12 relative to sbcl-0.9.11: regarding non-existent packages in #+ and #- feature tests. * new feature: command line options --no-sysinit, --no-userinit to inhibit loading the corresponding init files + * new feature: add a generic function SOCKET-SEND to SB-BSD-SOCKETS, + for sending data through UDP sockets (thanks to François-René Rideau) * minor incompatible change: SIGPIPE is ignored and "Broken pipe" error is signalled instead (thanks to François-René Rideau) * bug fix: LISTEN sometimes returned T even in cases where no data was diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp index c5d19a3..19aa609 100644 --- a/contrib/sb-bsd-sockets/constants.lisp +++ b/contrib/sb-bsd-sockets/constants.lisp @@ -94,9 +94,17 @@ (:integer msg-peek "MSG_PEEK") (:integer msg-trunc "MSG_TRUNC") (:integer msg-waitall "MSG_WAITALL") + (:integer msg-eor "MSG_EOR") + (:integer msg-dontroute "MSG_DONTROUTE") + (:integer msg-dontwait "MSG_DONTWAIT") + (:integer msg-nosignal "MSG_NOSIGNAL") +#+linux (:integer msg-confirm "MSG_CONFIRM") +#+linux (:integer msg-more "MSG_MORE") ;; for socket-receive (:type socklen-t "socklen_t") + (:type size-t "size_t") + (:type ssize-t "ssize_t") #| ;;; stat is nothing to do with sockets, but I keep it around for testing @@ -114,6 +122,8 @@ (integer proto "int" "p_proto"))) (:function getprotobyname ("getprotobyname" (* protoent) (name c-string))) + (:function getprotobynumber ("getprotobynumber" (* protoent) + (proto int))) (:integer inaddr-any "INADDR_ANY") (:structure in-addr ("struct in_addr" ((array (unsigned 8)) addr "u_int32_t" "s_addr"))) @@ -134,6 +144,14 @@ (integer type "int" "h_addrtype") (integer length "int" "h_length") ((* (* (unsigned 8))) addresses "char **" "h_addr_list"))) + (:structure msghdr ("struct msghdr" + (c-string-pointer name "void *" "msg_name") + (integer namelen "socklen_t" "msg_namelen") + ((* t) iov "struct iovec" "msg_iov") + (integer iovlen "size_t" "msg_iovlen") + ((* t) control "void *" "msg_control") + (integer controllen "socklen_t" "msg_controllen") + (integer flags "int" "msg_flags"))) (:function socket ("socket" int (domain int) (type int) @@ -141,47 +159,67 @@ (:function bind ("bind" int (sockfd int) (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? - (addrlen int))) + (addrlen socklen-t))) (:function listen ("listen" int (socket int) (backlog int))) (:function accept ("accept" int (socket int) (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? - (addrlen int :in-out))) + (addrlen socklen-t :in-out))) (:function getpeername ("getpeername" int (socket int) (her-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? - (addrlen int :in-out))) + (addrlen socklen-t :in-out))) (:function getsockname ("getsockname" int (socket int) (my-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? - (addrlen int :in-out))) + (addrlen socklen-t :in-out))) (:function connect ("connect" int (socket int) (his-addr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? - (addrlen int ))) - + (addrlen socklen-t))) (:function close ("close" int (fd int))) - (:function recvfrom ("recvfrom" int + (:function recvfrom ("recvfrom" ssize-t (socket int) (buf (* t)) (len integer) (flags int) (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? (socklen (* socklen-t)))) + (:function recvmsg ("recvmsg" ssize-t + (socket int) + (msg (* msghdr)) + (flags int))) + (:function send ("send" ssize-t + (socket int) + (buf (* t)) + (len size-t) + (flags int))) + (:function sendto ("sendto" int + (socket int) + (buf (* t)) + (len size-t) + (flags int) + (sockaddr (* t)) ; KLUDGE: sockaddr-in or sockaddr-un? + (socklen socklen-t))) + (:function sendmsg ("sendmsg" int + (socket int) + (msg (* msghdr)) + (flags int))) (:function gethostbyname ("gethostbyname" (* hostent) (name c-string))) (:function gethostbyaddr ("gethostbyaddr" (* hostent) (addr (* t)) (len int) (af int))) +;;; should be using getaddrinfo instead? (:function setsockopt ("setsockopt" int (socket int) (level int) (optname int) (optval (* t)) - (optlen int))) + (optlen int))) ;;; should be socklen-t! (:function fcntl ("fcntl" int (fd int) (cmd int) @@ -191,5 +229,5 @@ (level int) (optname int) (optval (* t)) - (optlen (* int))))) + (optlen (* int))))) ;;; should be socklen-t! ) diff --git a/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo b/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo index 3276ba2..ad85a60 100644 --- a/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo +++ b/contrib/sb-bsd-sockets/sb-bsd-sockets.texinfo @@ -67,6 +67,8 @@ than "network-endian integers". @include fun-sb-bsd-sockets-socket-receive.texinfo +@include fun-sb-bsd-sockets-socket-send.texinfo + @include fun-sb-bsd-sockets-socket-listen.texinfo @include fun-sb-bsd-sockets-socket-open-p.texinfo diff --git a/contrib/sb-bsd-sockets/sockets.lisp b/contrib/sb-bsd-sockets/sockets.lisp index 9ead7d6..829829a 100644 --- a/contrib/sb-bsd-sockets/sockets.lisp +++ b/contrib/sb-bsd-sockets/sockets.lisp @@ -216,6 +216,76 @@ small")) (bits-of-sockaddr socket sockaddr))))))) (sb-alien:free-alien copy-buffer)))))) +(defmacro with-vector-sap ((name vector) &body body) + `(sb-sys:with-pinned-objects (,vector) + (let ((,name (sb-sys:vector-sap ,vector))) + ,@body))) + +(defgeneric socket-send (socket buffer length + &key + address + external-format + oob eor dontroute dontwait nosignal + #+linux confirm #+linux more) + (:documentation + "Send LENGTH octets from BUFFER into SOCKET, using sendto(2). If BUFFER +is a string, it will converted to octets according to EXTERNAL-FORMAT. If +LENGTH is NIL, the length of the octet buffer is used. The format of ADDRESS +depends on the socket type (for example for INET domain sockets it would +be a list of an IP address and a port). If no socket address is provided, +send(2) will be called instead. Returns the number of octets written.")) + +(defmethod socket-send ((socket socket) buffer length + &key + address + (external-format :default) + oob eor dontroute dontwait nosignal + #+linux confirm #+linux more) + (let* ((flags + (logior (if oob sockint::MSG-OOB 0) + (if eor sockint::MSG-EOR 0) + (if dontroute sockint::MSG-DONTROUTE 0) + (if dontwait sockint::MSG-DONTWAIT 0) + (if nosignal sockint::MSG-NOSIGNAL 0) + #+linux (if confirm sockint::MSG-CONFIRM 0) + #+linux (if more sockint::MSG-MORE 0))) + (buffer (etypecase buffer + (string + (sb-ext:string-to-octets buffer + :external-format external-format + :null-terminate nil)) + ((simple-array (unsigned-byte 8)) + buffer) + ((array (unsigned-byte 8)) + (make-array (length buffer) + :element-type '(unsigned-byte 8) + :initial-contents buffer)))) + (len (with-vector-sap (buffer-sap buffer) + (unless length + (setf length (length buffer))) + (if address + (with-sockaddr-for (socket sockaddr address) + (sb-alien:with-alien ((sa-len sockint::socklen-t + (size-of-sockaddr socket))) + (sockint::sendto (socket-file-descriptor socket) + buffer-sap + length + flags + sockaddr + sa-len))) + (sockint::send (socket-file-descriptor socket) + buffer-sap + length + flags))))) + (cond + ((and (= len -1) + (member (sb-unix::get-errno) + '(sockint::EAGAIN sockint::EINTR))) + nil) + ((= len -1) + (socket-error "sendto")) + (t len)))) + (defgeneric socket-listen (socket backlog) (:documentation "Mark SOCKET as willing to accept incoming connections. BACKLOG defines the maximum length that the queue of pending connections may diff --git a/version.lisp-expr b/version.lisp-expr index a7a17c4..cb58d2c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.11.33" +"0.9.11.34" -- 1.7.10.4