source: branches/home/psmith/restructure/src/protocol/yarpc/yarpc-packet-factory.lisp

#|
Copyright (c) 2007
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.
3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|#
(in-package :nio-yarpc)

(declaim (optimize (debug 3) (speed 3) (space 0)))

;;
(defclass yarpc-packet-factory (packet-factory)())


(defun yarpc-packet-factory ()
  (make-instance 'yarpc-packet-factory))     

(defconstant +CALL-METHOD-PACKET-ID+ #x0)
(defconstant +METHOD-RESPONSE-PACKET-ID+ #x1)

(defconstant +PACKET-ID-SIZE+ 1)
(defconstant +PACKET-LENGTH-SIZE+ 4)
(defconstant +PACKET-REQUEST-ID-SIZE+ 4)

(defconstant +yarpc-packet-header-size+
  (+ +PACKET-ID-SIZE+ +PACKET-LENGTH-SIZE+))

(defconstant +yarpc-rpc-packet-header-size+ (+  +yarpc-packet-header-size+ +PACKET-REQUEST-ID-SIZE+))

(defmethod get-packet ((pf yarpc-packet-factory) buf)
  (flip buf)
  (if (>= (remaining buf) +yarpc-packet-header-size+) ;; First byte denotes packet ID ;;bytes 2,3,4,5 denote packet size ;; 6,7,8,9 request-id
      (let ((packet-id (bytebuffer-read-8 buf))
            (packet-length (bytebuffer-read-32 buf)))
        (if (<= (- packet-length +yarpc-packet-header-size+) (remaining buf)) ;is the whole packet available in the buffer?
            (let* ((packet-request-id (bytebuffer-read-32 buf))
                   (ret-packet (ecase packet-id
                                (0 (progn 
#+nio-debug                                  (format-log t "yarpc-packet-factory:get-packet - got CALL-METHOD-PACKET-ID~%") 
                                     (call-method-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id)))
                                (1 (progn 
#+nio-debug                                  (format-log t "yarpc-packet-factory:get-packet - got METHOD-RESPONSE-PACKET-ID~%") 
                                     (method-response-packet (bytebuffer-read-string buf (- packet-length +yarpc-packet-header-size+ +PACKET-REQUEST-ID-SIZE+)) :request-id packet-request-id))))))
              (compact buf)
              #+nio-debug  (format-log t "yarpc-packet-factory:get-packet - after compact ~%~A~%" buf)
              #+nio-debug  (format-log t "yarpc-packet-factory:get-packet - retuirning packet ~A~%" ret-packet)
              ret-packet)
                                        ;Failed to read a whole packet unflip and check size
            (let ((buffer-capacity (buffer-capacity buf)))
              (unflip buf)           
              (if (> packet-length buffer-capacity) (error 'buffer-too-small-error :recommended-size packet-length)))))))



(defclass yarpc-packet(packet)
  ((request-id :initarg :request-id
               :reader request-id)))

(defclass call-method-packet (yarpc-packet)
  ((call-string :initarg :call-string
                :accessor call-string)))

(defun call-method-packet (call-string &key request-id)
  (make-instance 'call-method-packet :call-string call-string :request-id request-id))

(defmethod print-object ((packet call-method-packet) stream)
  (format stream "#<CALL-METHOD-PACKET ~A >" (call-string packet)))

(defmethod write-bytes((packet call-method-packet) buf)
  #+nio-debug  (format-log t "yarpc-packet-factory:write-bytes(call-method-packet) - writing ~%~A to ~%~A~%" packet buf)
  (nio-buffer:mark buf)
  (handler-case
      (progn
        (nio-buffer:bytebuffer-write-8 buf +CALL-METHOD-PACKET-ID+)
        (nio-buffer:bytebuffer-write-32 buf 0) ; come back and write length later
        (nio-buffer:bytebuffer-write-32 buf (request-id packet))
        (nio-buffer:bytebuffer-write-string buf (call-string packet) :utf-8)
        (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1)
  #+nio-debug    (format-log t "yarpc-packet-factory:write-bytes(call-method-packet) - written ~%~A ~%" buf)  
       )
    (buffer-too-small-error (err)
      (nio-buffer:reset buf)
      (error err))))


(defmethod get-packet-size ((packet call-method-packet))
  (+ +yarpc-rpc-packet-header-size+
     (length (sb-ext:string-to-octets (call-string packet) :external-format :utf-8))))

(defclass method-response-packet (yarpc-packet)
  ((response :initarg :response
             :accessor response)))

(defun method-response-packet (response &key request-id)
  (make-instance 'method-response-packet :response response :request-id request-id))

(defmethod print-object ((packet method-response-packet) stream)
  (format stream "#<METHID-RESPONSE-PACKET ~A >" (response packet)))

(defparameter +serialise-packet-fn+ #'(lambda (result)(write-to-string result)))

(defmethod write-bytes((packet method-response-packet) buf)
#+nio-debug    (format-log t "yarpc-packet-factory:write-bytes - writing ~A to ~A~%" packet buf)
  (nio-buffer:mark buf)
  (handler-case
      (progn
        (nio-buffer:bytebuffer-write-8 buf +METHOD-RESPONSE-PACKET-ID+)
        (nio-buffer:bytebuffer-write-32 buf 0) ; come back and write length later
        (nio-buffer:bytebuffer-write-32 buf (request-id packet))
        (nio-buffer:bytebuffer-write-string buf (funcall +serialise-packet-fn+ (response packet)) :utf-8)
        (nio-buffer:bytebuffer-insert-32 buf (buffer-position buf) 1)
#+nio-debug    (format-log t "yarpc-packet-factory:write-bytes - written ~A~%" buf)  
        )
    (buffer-too-small-error (err)
      (nio-buffer:reset buf)
#+nio-debug (format-log t "yarpc-packet-factory:write-bytes - buffer too small caught, reset to ~A~%" buf)
      (error err))))

(defmethod get-packet-size ((packet method-response-packet))
  (+ +yarpc-rpc-packet-header-size+
     (length (sb-ext:string-to-octets (funcall +serialise-packet-fn+ (response packet)) :external-format :utf-8))))