/src/socket.lisp
Lisp | 253 lines | 203 code | 50 blank | 0 comment | 3 complexity | 7d8913128e3b877354e367386acb8551 MD5 | raw file
Possible License(s): 0BSD
- (in-package :llio)
- (defcfun ("socket" %socket) :int
- (family address-family)
- (type socket-type)
- (protocol :int))
- (defcfun ("close" %close) :int
- (fd :int))
- (defcfun ("shutdown" %shutdown) :int
- (socket :int)
- (how shutdown-mode))
- (defcfun ("bind" %bind) :int
- (socket :int)
- (addr :pointer)
- (addrlen socklen-t))
- (defcfun ("listen" %listen) :int
- (socket :int)
- (backlog :int))
- (defcfun ("accept" %accept) :int
- (socket :int)
- (addr :pointer)
- (addrlen (:pointer socklen-t)))
- (defcfun ("connect" %connect) :int
- (socket :int)
- (addr :pointer)
- (addrlen socklen-t))
- (defcfun ("getsockname" %getsockname) :int
- (socket :int)
- (addr :pointer)
- (addrlen (:pointer socklen-t)))
- (defcfun ("getpeername" %getpeername) :int
- (socket :int)
- (addr :pointer)
- (addrlen (:pointer socklen-t)))
- (defcfun ("setsockopt" %setsockopt) :int
- (socket :int)
- (level :int)
- (option :int)
- (value :pointer)
- (valuelen socklen-t))
- (defcfun ("getsockopt" %getsockopt) :int
- (socket :int)
- (level :int)
- (option :int)
- (value :pointer)
- (valuelen (:pointer socklen-t)))
- (defcfun ("fcntl" %fcntl) :int
- (fd :int)
- (cmd fcntl-command)
- &rest)
- (defcfun ("read" %read) ssize-t
- (fd :int)
- (buf :pointer)
- (count size-t))
- (defcfun ("write" %write) ssize-t
- (fd :int)
- (buf :pointer)
- (count size-t))
- (defclass socket ()
- ((fd
- :accessor socket-fd
- :initarg :fd
- :initform -1
- :documentation "The file descriptor of the socket.")))
- (defmethod print-object ((socket socket) stream)
- (print-unreadable-object (socket stream :type t :identity t)
- (princ (socket-fd socket) stream)))
- (defun make-socket (family type &key (protocol 0))
- "Create a new socket."
- (let ((fd (check-return-code (%socket family type protocol))))
- (make-instance 'socket :fd fd)))
- (defun socket-close (socket)
- "Close a socket."
- (check-return-code (%close (socket-fd socket))))
- (defun socket-shutdown (socket mode)
- "Shutdown the connection associated to a socket."
- (check-return-code (%shutdown (socket-fd socket) mode)))
- (defmacro with-socket ((socket family type &rest args) &body body)
- `(let ((,socket (make-socket ,family ,type ,@args)))
- (unwind-protect
- (progn
- ,@body)
- (socket-close ,socket))))
- (defun socket-bind (socket addrinfo)
- "Bind a socket to an address."
- (check-return-code (%bind (socket-fd socket)
- (addrinfo-addr addrinfo)
- (addrinfo-addrlen addrinfo))))
- (defun socket-listen (socket backlog)
- "Listen for socket connections."
- (check-return-code (%listen (socket-fd socket) backlog)))
- (defun socket-accept (socket)
- "Accept a connection on a socket.."
- (let ((fd (check-return-code (%accept (socket-fd socket)
- (null-pointer)
- (null-pointer)))))
- (make-instance 'socket :fd fd)))
- (defun socket-connect (socket addrinfo)
- "Connect a socket to an address."
- (check-return-code (%connect (socket-fd socket)
- (addrinfo-addr addrinfo)
- (addrinfo-addrlen addrinfo))))
- (defun getsockname (socket)
- "Get the host and port of SOCKET."
- (with-foreign-objects ((addr 'sockaddr-storage)
- (addrlen 'socklen-t))
- (check-return-code (%getsockname (socket-fd socket) addr addrlen))
- (multiple-value-bind (host service)
- (getnameinfo addr (mem-ref addrlen 'socklen-t)
- :flags '(:ni-numerichost :ni-numericserv))
- (values host service))))
- (defun getpeername (socket)
- "Get the host and port of the peer SOCKET is connected to."
- (with-foreign-objects ((addr 'sockaddr-storage)
- (addrlen 'socklen-t))
- (check-return-code (%getpeername (socket-fd socket) addr addrlen))
- (multiple-value-bind (host service)
- (getnameinfo addr (mem-ref addrlen 'socklen-t)
- :flags '(:ni-numerichost :ni-numericserv))
- (values host service))))
- (defun socket-set-option (socket option type value)
- (check-return-code (%setsockopt (socket-fd socket) sol-socket
- (foreign-enum-value 'socket-option option)
- value (foreign-type-size type))))
- (defun socket-set-bool-option (socket option enable)
- (with-foreign-object (%value :int)
- (setf (mem-ref %value :int) (if enable 1 0))
- (socket-set-option socket option :int %value)))
- (defun socket-set-int-option (socket option value)
- (with-foreign-object (%value :int)
- (setf (mem-ref %value :int) value)
- (socket-set-option socket option :int %value)))
- (defun set-timeval-socket-option (socket option value)
- (with-foreign-object (%value 'timeval)
- (set-timeval %value value)
- (socket-set-option socket option :int %value)))
- (defun socket-set-option-debug (socket enable)
- (socket-set-bool-option socket :so-debug enable))
- (defun socket-set-option-broadcast (socket enable)
- (socket-set-bool-option socket :so-broadcast enable))
- (defun socket-set-option-reuseaddr (socket enable)
- (socket-set-bool-option socket :so-reuseaddr enable))
- (defun socket-set-option-keepalive (socket enable)
- (socket-set-bool-option socket :so-keepalive enable))
- (defun socket-set-option-linger (socket enable time)
- (with-foreign-object (value 'linger)
- (setf (foreign-slot-value value 'linger 'l-onoff) (if enable 1 0))
- (setf (foreign-slot-value value 'linger 'l-linger) time)
- (socket-set-option socket :so-linger 'linger value)))
- (defun socket-set-option-oobinline (socket enable)
- (socket-set-bool-option socket :so-oobinline enable))
- (defun socket-set-option-sndbuf (socket value)
- (socket-set-int-option socket :so-sndbuf value))
- (defun socket-set-option-rcvbuf (socket value)
- (socket-set-int-option socket :so-rcvbuf value))
- (defun socket-set-option-dontroute (socket enable)
- (socket-set-bool-option socket :so-dontroute enable))
- (defun socket-set-option-rcvlowat (socket value)
- (socket-set-int-option socket :so-rcvlowat value))
- (defun socket-set-option-rcvtimeo (socket value)
- (set-timeval-socket-option socket :so-rcvtimeo value))
- (defun socket-set-option-sndlowat (socket value)
- (socket-set-int-option socket :so-sndlowat value))
- (defun socket-set-option-sndtimeo (socket value)
- (set-timeval-socket-option socket :so-sndtimeo value))
- (defun socket-get-option (socket option type value)
- (with-foreign-object (%size 'socklen-t)
- (setf (mem-ref %size 'socklen-t) (foreign-type-size type))
- (check-return-code (%getsockopt (socket-fd socket) sol-socket
- (foreign-enum-value 'socket-option option)
- value %size))))
- (defun socket-get-int-option (socket option)
- (with-foreign-object (%value :int)
- (socket-get-option socket option :int %value)
- (mem-ref %value :int)))
- (defun socket-get-error (socket)
- (socket-get-int-option socket :so-error))
- (defun socket-set-non-blocking (socket)
- (with-slots (fd) socket
- (let* ((flag (check-return-code (%fcntl fd :f-getfl)))
- (status (foreign-bitfield-symbols 'file-flags flag))
- (value (foreign-bitfield-value 'file-flags
- (cons :o-nonblock status))))
- (check-return-code (%fcntl fd :f-setfl :int value)))))
- (defun socket-read (socket count buffer)
- "Read a up to COUNT bytes from SOCKET, append them to BUFFER, then return
- the number of bytes read."
- (with-foreign-object (%vector :uchar count)
- (let ((nb-read (check-return-code
- (%read (socket-fd socket) %vector count))))
- (when (> nb-read 0)
- (let ((vector (make-array nb-read :element-type '(unsigned-byte 8))))
- (loop for i from 0 below nb-read do
- (setf (aref vector i) (mem-ref %vector :uchar i)))
- (buffer-append buffer vector)))
- nb-read)))
- (defun socket-write (socket count buffer)
- "Write up to COUNT bytes from BUFFER to SOCKET, then return the number of
- bytes written."
- (with-foreign-object (%vector :uchar count)
- (with-slots (data) buffer
- (loop for i from 0 below count do
- (setf (mem-ref %vector :uchar i) (aref data i)))
- (check-return-code (%write (socket-fd socket) %vector count)))))