Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
;;;;; Main loop for the Philip-Jose Farmer
;;;;; Incremental parser protocol
(in-package :philip-jose)
;;;; The Incremental parser protocol
;;
;; This protocol allows for a single-threaded server to monitor many connections at once,
;; possibly on many ports, with each connection having partial request message that will
;; either be trivially handled, or lead to spawning after the request is complete.
;;
;; An incremental parser function is given a buffer (byte or char array),
;; the size up to which the buffer is filled, and
;; the previous (incomplete) state of the incremental parser, or nil on the first attempt.
;; It returns two values. The first is a boolean that tells if the parse was successful.
;; If the first value is T, then the second value is the result of the parse.
;; If the first value is NIL, then the second value is the state of the incremental parser,
;; from which to resume when the buffer is made more full.
;;
;; In a world with any kind of first-class (partial) continuations, either linear or multi-entry,
;; any direct parser could be made incremental, by having the READ-CHAR primitive return the
;; partial continuation of the parser to the caller.
;; Maybe we can hook Screamer or arnesi's call/cc into here.
;; TODO:
;; * add a buffer management protocol to make the thing work for bigger requests and
;; on-going conversations
;;;; Trivial implementations of simple cases
;;; Line parser -- the request in complete at the end of the first line
(defun line-end-code-p (cc)
(member cc '(10 13)))
(defun line-end-char-p (ch)
(line-end-code-p (char-code ch)))
(defun trivial-incremental-line-parser (buffer size state)
;; Implements the incremental parser protocol for character input, detecting a full line.
(let* ((line-end-pos (position-if #'line-end-char-p buffer :start (or state 0))))
(if line-end-pos
(values t line-end-pos)
(values nil size))))
;;; Wrapper that prevents too many retries
;; Drop (presumably buggy or malevolent) connections with too many packets for the initial request.
;; As in attempts to flood with small packets, connection with a lot of fragmentation,
;; malformed request, overlarge request, buffer overflow tentative.
(define-condition too-many-attempts ()
()
(:report (lambda (condition stream)
(declare (ignore condition))
(format stream "Too many attempts in incremental request parsing"))))
(defun incremental-parser-attempt-limiter (max-attempts incremental-parser)
(labels ((check (x)
(when (>= x max-attempts)
(error 'too-many-attempts)))
(try (buffer size state)
(multiple-value-bind (count inner-state)
(if state (values (car state) (cdr state)) (values 0 nil))
(check count)
(multiple-value-bind (successp x)
(funcall incremental-parser buffer size inner-state)
(if successp
(values t x)
(let ((c (1+ count)))
(check c)
(values nil (cons c x))))))))
(if (typep max-attempts '(unsigned-byte 16))
#'try
incremental-parser)))
;;; Trivial transformation of a parser into a pseudo incremental parser.
;; Restarting from the beginning everytime.
;; It's inefficient and a big DoS target unless combined with the limiter above.
(defun pseudo-incremental-parser-from-reader (reader)
;; Implements the incremental parser protocol for character input, given a reader.
;; Not really incremental, always restart from scratch, so called pseudo.
;; Could do better with call/cc and an open stream protocol.
#'(lambda (buffer size state &aux index)
(declare (ignore state))
(handler-case
(values t (cons (with-input-from-string (s buffer :index index :start 0 :end size)
(funcall reader s t))
index))
(end-of-file () (values nil nil)))))
;;; Use of the Lisp reader as a parser.
;; NOT FOR USE IN THE WILD! See warning in trivial-sexp-server.lisp
(let ((f (pseudo-incremental-parser-from-reader #'safe-read)))
(defun make-incremental-reader (&optional (max-attempts 4))
(incremental-parser-attempt-limiter max-attempts f)))
(defun incrementally-parsed-request-handler (connection buffer size state &optional (handler #'handle-sexp-request))
(with-trivial-logging ()
(destructuring-bind (request . index) state
(with-open-stream (bufin (make-string-input-stream buffer index size))
(with-open-stream (in (make-concatenated-stream bufin connection))
(let ((*standard-input* in)
(*standard-output* connection))
(funcall handler request)))))))
(defun make-incrementally-parsed-request-handler (h)
#'(lambda (connection buffer size state)
(incrementally-parsed-request-handler connection buffer size state h)))