[Sbcl-help] problem with sb-sys:read-n-bytes

[Russell M. <rus...@ya...>]

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