Skip to content
Permalink
Browse files

Implement update size limiting.

  • Loading branch information...
Shinmera committed Jul 25, 2017
1 parent adccbc7 commit 362ff807a6d4f99f8d03bf85a852bfe73f317d4e
Showing with 47 additions and 20 deletions.
  1. +1 −0 README.md
  2. +4 −0 conditions.lisp
  3. +38 −18 reader.lisp
  4. +4 −2 wire.lisp
@@ -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.
@@ -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"
@@ -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*)
@@ -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

0 comments on commit 362ff80

Please sign in to comment.
You can’t perform that action at this time.