I don't think that sb-sys:read-n-bytes returns early when there is not
a full buffer to read. Of course, I could be wrong, so I've included
a self-address, stamped example program.
To exercise the example program, first run the lisp server below, then
go to an emacs scratch buffer, and execute these forms:
(defvar *conn* nil)
(setf *conn* (open-network-stream "borked"
(get-buffer-create "*borked-out*")
"localhost"
6200))
(process-send-string *conn* "ab")
If you send "abcd", then read-n-bytes will return, but if you send
less, it wont. It's late, so it wouldn't surprise me if I'm doing
something simple wrong. Any ideas?
I tried to take out any encoding issues by just sending bytes around.
-russ
Here is the server:
(defpackage :org.cl-user.borked
(:use :common-lisp))
(cl:in-package :org.cl-user.borked)
;; simplest tcp server possible
(defclass tcp-server ()
((fd-handler :initform nil)
(socket :initform nil)
(tcp-clients :initform nil)))
(defgeneric shutdown (component))
(defgeneric accept (tcp-server))
(defgeneric input-ready (tcp-client))
(defmethod shutdown ((tcp-server tcp-server))
(with-slots (socket fd-handler tcp-clients) tcp-server
(when fd-handler
(sb-sys:remove-fd-handler fd-handler)
(setf fd-handler nil))
(when socket
(sb-bsd-sockets:socket-close socket)
(setf socket nil))
(dolist (tcp-client tcp-clients) (shutdown tcp-client))
(setf tcp-clients nil)))
(defmethod accept ((tcp-server tcp-server))
(with-slots (socket tcp-clients) tcp-server
(let ((new-socket (sb-bsd-sockets:socket-accept socket)))
(push (make-instance 'tcp-client :socket new-socket) tcp-clients))))
(defmethod initialize-instance :after ((tcp-server tcp-server) &key port)
(with-slots (socket fd-handler) tcp-server
(unless port (error "no port supplied"))
(setf socket (make-instance 'sb-bsd-sockets:inet-socket
:type :stream
:protocol :tcp)
(sb-bsd-sockets:sockopt-reuse-address socket) t)
(sb-bsd-sockets:socket-bind socket #(0 0 0 0) port)
(sb-bsd-sockets:socket-listen socket 5)
(setf fd-handler
(sb-sys:add-fd-handler (sb-bsd-sockets:socket-file-descriptor socket)
:input
(lambda (fd) fd (accept tcp-server))))))
(defvar *block-size* 4)
(defclass tcp-client ()
((stream :initform nil)
(fd-handler :initform nil)
(buffer :initform (make-array *block-size* :element-type '(unsigned-byte 8)))))
(defmethod shutdown ((tcp-client tcp-client))
(with-slots (stream fd-handler) tcp-client
(when stream (close stream) (setf stream nil))
(when fd-handler
(sb-sys:remove-fd-handler fd-handler)
(setf fd-handler nil))))
(defun read-n-bytes (stream buffer start numbytes)
(format t "read-n-bytes: attempting to read ~D bytes~%" numbytes)
(let ((nread (sb-sys:read-n-bytes stream buffer start numbytes)))
(format t "read-n-bytes: read ~D bytes~%" nread)
nread))
(defmethod input-ready ((tcp-client tcp-client))
(with-slots (buffer stream) tcp-client
(let ((ok nil))
(unwind-protect
(handler-case
(loop for nread = #1=(read-n-bytes stream buffer 0 (length buffer)) then #1#
do (format t "read msg: ~A~%" (sb-ext:octets-to-string buffer :start 0 :end nread))
until (< nread (length buffer))
finally (setf ok t))
(error (c) (format t "error: ~A" c)))
(unless ok (shutdown tcp-client))))))
(defmethod initialize-instance :after ((tcp-client tcp-client) &key socket)
(format t "new client: ~A~%" socket)
(with-slots (stream fd-handler) tcp-client
(setf stream (sb-bsd-sockets:socket-make-stream
socket
:input t :output t :external-format :ascii
:element-type '(unsigned-byte 8))
fd-handler (sb-sys:add-fd-handler
(sb-bsd-sockets:socket-file-descriptor socket)
:input (lambda (fd) fd (input-ready tcp-client))))))
(defvar *server* (make-instance 'tcp-server :port 6200))
|