Skip to content
This repository
  • 5 commits
  • 2 files changed
  • 0 comments
  • 1 contributor

Showing 2 changed files with 27 additions and 17 deletions. Show diff stats Hide diff stats

  1. +27 15 src/http/parser.lisp
  2. +0 2  src/methods.lisp
42 src/http/parser.lisp
@@ -3,10 +3,13 @@
3 3 ;; HTTP Parser
4 4 ;;; Request line parser
5 5 (deffsm request-fsm ()
6   - ((http-method :initform (string "") :accessor http-method)
7   - (resource :initform (string "") :accessor resource)
8   - (version :initform (string "") :accessor version))
9   - (:default-initargs . (:state :read-http-method)))
  6 + ((http-method :initform (make-string-output-stream) :accessor http-method)
  7 + (resource :initform (make-string-output-stream) :accessor resource)
  8 + (version :initform (make-string-output-stream) :accessor version))
  9 + (:default-initargs . (:state :read-http-method))
  10 + (:documentation "The request line parser FSM.
  11 +When the machine arrives in the `:done' state the `http-method', `resource' and
  12 +`version' slots are converted into strings."))
10 13
11 14 (defun whitespace-p (code)
12 15 "Is the `code' a code-char for a whitespace char?"
@@ -14,7 +17,7 @@
14 17
15 18 (defstate request-fsm :read-http-method (fsm cc)
16 19 (if (not (whitespace-p cc))
17   - (not (setf (http-method fsm) (concatenate 'string (http-method fsm) (list (code-char cc)))))
  20 + (not (write-char (code-char cc) (http-method fsm)))
18 21
19 22 (if (char-equal (code-char cc) #\Space)
20 23 :read-resource
@@ -22,7 +25,7 @@
22 25
23 26 (defstate request-fsm :read-resource (fsm cc)
24 27 (if (not (whitespace-p cc))
25   - (not (setf (resource fsm) (concatenate 'string (resource fsm) (list (code-char cc)))))
  28 + (not (write-char (code-char cc) (resource fsm)))
26 29
27 30 (if (char-equal (code-char cc) #\Space)
28 31 :read-version
@@ -30,7 +33,7 @@
30 33
31 34 (defstate request-fsm :read-version (fsm cc)
32 35 (if (not (whitespace-p cc))
33   - (not (setf (version fsm) (concatenate 'string (version fsm) (list (code-char cc)))))
  36 + (not (write-char (code-char cc) (version fsm)))
34 37
35 38 (if (char-equal (code-char cc) #\Return)
36 39 :seek-newline
@@ -38,20 +41,28 @@
38 41
39 42 (defstate request-fsm :seek-newline (fsm cc)
40 43 (if (char-equal (code-char cc) #\Newline)
41   - :done
  44 + (prog1 :done
  45 + (setf (http-method fsm) (get-output-stream-string (http-method fsm))
  46 + (resource fsm) (get-output-stream-string (resource fsm))
  47 + (version fsm) (get-output-stream-string (version fsm))))
42 48 :error))
43 49
44 50 ;;; Header block parser
45 51 (deffsm header-fsm ()
46 52 ((headers :initform (list) :accessor headers)
47   - (key-buffer :initform (string "") :accessor key-buffer)
48   - (value-buffer :initform (string "") :accessor value-buffer))
  53 + (key-buffer :accessor key-buffer)
  54 + (value-buffer :accessor value-buffer))
49 55 (:default-initargs . (:state :key-or-done)))
50 56
  57 +(defmethod initialize-instance :after ((fsm header-fsm) &key)
  58 + "Reset the key- and value- buffers to fresh string output streams"
  59 + (setf (key-buffer fsm) (make-string-output-stream)
  60 + (value-buffer fsm) (make-string-output-stream)))
  61 +
51 62 (defstate header-fsm :read-key (fsm cc)
52 63 (cond ((not (or (char-equal (code-char cc) #\:)
53 64 (whitespace-p cc)))
54   - (not (setf (key-buffer fsm) (concatenate 'string (key-buffer fsm) (list (code-char cc))))))
  65 + (not (write-char (code-char cc) (key-buffer fsm))))
55 66
56 67 ((char-equal (code-char cc) #\:)
57 68 :read-space)
@@ -66,12 +77,13 @@
66 77
67 78 (defstate header-fsm :read-value (fsm cc)
68 79 (cond ((not (member (code-char cc) '(#\Newline #\Return)))
69   - (not (setf (value-buffer fsm) (concatenate 'string (value-buffer fsm) (list (code-char cc))))))
  80 + (not (write-char (code-char cc) (value-buffer fsm))))
70 81
71 82 ((char-equal (code-char cc) #\Return)
72   - (push (cons (key-buffer fsm) (value-buffer fsm)) (headers fsm))
73   - (setf (key-buffer fsm) (string "")
74   - (value-buffer fsm) (string ""))
  83 + (push (cons (get-output-stream-string (key-buffer fsm))
  84 + (get-output-stream-string (value-buffer fsm)))
  85 + (headers fsm))
  86 + (initialize-instance fsm)
75 87 :read-newline)
76 88
77 89 (:otherwise
2  src/methods.lisp
@@ -8,8 +8,6 @@
8 8 (setf (queues hinge) (make-hash-table))
9 9 (mapc #'(lambda (name-priority)
10 10 (destructuring-bind (name . priority) name-priority
11   - (format t "=> Making queue: ~S => ~S~%" name priority)
12   -
13 11 (setf (gethash name (queues hinge))
14 12 (make-instance 'running-queue :owner hinge :priority priority))))
15 13 q-desc))

No commit comments for this range

Something went wrong with that request. Please try again.