Implement update size limiting.

README.md

@@ -120,6 +120,7 @@ The exceptional situation being during connection establishment. If the server d
 An update is always checked as follows:
 
 1. If the update is not at all recognisable and cannot be parsed, a `malformed-update` update is sent back and the request is dropped.
+1. If the update is too long (contains too many characters), a `update-too-long` update is sent back and the request is dropped.
 1. If the class of the update is not known or not a subclass of `wire-object`, an `invalid-update` update is sent back and the request is dropped.
 1. If the `from`, `channel`, or ` target` fields contain an invalid name, a `bad-name` update is sent back and the request is dropped.
 1. If the `from` field does not match the name known to the server by the user associated to the connection, a `username-mismatch` update is sent back and the request is dropped.

conditions.lisp

@@ -41,6 +41,10 @@
   (:report (lambda (c s) (format s "The symbol ~a::~a was found on the wire, but is not interned locally."
                                  (car (symbol-designator c)) (cdr (symbol-designator c))))))
 
+(define-condition read-limit-hit (error reader-condition)
+  ()
+  (:report "Unable to read update fully, read limit has been hit."))
+
 (define-condition missing-update-argument (wire-condition)
   ((update :initarg :update :reader update))
   (:report (lambda (c s) (format s "The update did not include all necessary arguments:~%  ~s"

reader.lisp

@@ -9,14 +9,34 @@
 (defvar *whitespace* (map 'vector #'code-char '(#x0009 #x000A #x000B #x000C #x000D #x0020)))
 (defvar *errors* NIL)
 (defvar *invalid-symbol* (make-symbol "INVALID-SYMBOL"))
+(defvar *read-limit* NIL)
+(defvar *read-counter*)
+
+(defun lread (stream)
+  (when *read-limit*
+    (when (<= *read-limit* *read-counter*)
+      (error 'read-limit-hit))
+    (incf *read-counter*))
+  (read-char stream))
+
+(defun lpeek (stream)
+  (when *read-limit*
+    (when (<= *read-limit* *read-counter*)
+      (error 'read-limit-hit)))
+  (peek-char NIL stream))
+
+(defun lunread (char stream)
+  (when *read-limit*
+    (decf *read-counter*))
+  (unread-char char stream))
 
 (defun whitespace-p (char)
   (find char *whitespace*))
 
 (defun skip-whitespace (stream)
-  (loop for char = (read-char stream)
+  (loop for char = (lread stream)
         while (find char *whitespace*)
-        finally (unread-char char stream)))
+        finally (lunread char stream)))
 
 (defun safe-find-symbol (name package)
   (let ((package (find-package package)))
@@ -28,16 +48,16 @@
 
 (defun read-sexpr-list (stream)
   (prog1 (loop do (skip-whitespace stream)
-               until (eql #\) (peek-char NIL stream))
+               until (eql #\) (lpeek stream))
                collect (read-sexpr stream))
-    (read-char stream)))
+    (lread stream)))
 
 (defun read-sexpr-string (stream)
   (with-output-to-string (out)
-    (loop for char = (read-char stream)
+    (loop for char = (lread stream)
           do (case char
                (#\Nul (error 'stray-null-found))
-               (#\\ (write-char (read-char stream) out))
+               (#\\ (write-char (lread stream) out))
                (#\" (return))
                (T   (write-char char out))))))
 
@@ -48,14 +68,14 @@
   (let ((out (make-string-output-stream))
         (point NIL))
     (loop for i from 0
-          for char = (read-char stream NIL)
+          for char = (lread stream NIL)
           do (case char
                ((NIL) (return))
-               (#\. (cond (point (unread-char char stream) (return))
+               (#\. (cond (point (lunread char stream) (return))
                           (T (setf point i))))
                ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
                 (write-char char out))
-               (T (unread-char char stream) (return))))
+               (T (lunread char stream) (return))))
     (let* ((number-string (get-output-stream-string out))
            (number (if (string= number-string "") 0 (parse-integer number-string))))
       (if point
@@ -66,27 +86,27 @@
           number))))
 
 (defun read-sexpr-token (stream)
-  (peek-char NIL stream)
+  (lpeek stream)
   (with-output-to-string (out)
-    (loop for char = (read-char stream NIL)
+    (loop for char = (lread stream NIL)
           do (case char
-               (#\\ (write-char (read-char stream) out))
-               ((#\" #\( #\) #\: #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\. #\  #\Nul) (unread-char char stream) (return))
+               (#\\ (write-char (lread stream) out))
+               ((#\" #\( #\) #\: #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\. #\  #\Nul) (lunread char stream) (return))
                ((NIL) (return))
                (T (write-char (char-upcase char) out))))))
 
 (defun read-sexpr-symbol (stream)
   (let ((token (read-sexpr-token stream)))
-    (cond ((eql #\: (peek-char NIL stream NIL))
-           (read-char stream)
+    (cond ((eql #\: (lpeek stream NIL))
+           (lread stream)
            (if (string= token "#")
                (make-symbol (read-sexpr-token stream))
                (safe-find-symbol (read-sexpr-token stream) (find-package token))))
           (T
            (safe-find-symbol token #.*package*)))))
 
 (defun read-sexpr (stream)
-  (let* ((char (read-char stream))
+  (let* ((char (lread stream))
          (*errors* NIL)
          (sexpr (handler-bind
                     ((end-of-file (lambda (err)
@@ -98,10 +118,10 @@
                     (#\) (error 'incomplete-token))
                     (#\" (read-sexpr-string stream))
                     ((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\.)
-                     (unread-char char stream)
+                     (lunread char stream)
                      (read-sexpr-number stream))
                     (#\: (read-sexpr-keyword stream))
-                    (T (unread-char char stream)
+                    (T (lunread char stream)
                      (read-sexpr-symbol stream))))))
     (when *errors*
       (dolist (err *errors*)

wire.lisp

@@ -33,8 +33,10 @@
     (unless clock-found
       (error 'missing-clock :update sexpr))))
 
-(defun from-wire (stream)
-  (let ((sexpr (read-sexpr stream)))
+(defun from-wire (stream &optional limit)
+  (let* ((*read-counter* 0)
+         (*read-limit* limit)
+         (sexpr (read-sexpr stream)))
     (prog1
         (typecase sexpr
           (cons