~pepe/chidi

chidi/chidi/server.janet -rw-r--r-- 4.4 KiB
a2aaf645 — Josef Pospíšil Code design 2 months ago
                                                                                
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
(def- ise
  (string/join ["HTTP/1.1 500 Internal Server Error\r\nContent-Length: 21"
                "Content-Type: text/plain\r\n\r\nInternal Server Error"]
               "\r\n"))

(def- etl
  (string/join ["HTTP/1.1 413 Request Entity Too Large\r\nContent-Length: 24"
                "Content-Type: text/plain\r\n\r\nRequest Entity Too Large"]
               "\r\n"))

# Reading part
(def buff-size 16384)

(def- clg
  (peg/compile
    ~{:cl "Content-Length: "
      :crlf "\r\n"
      :main (* (thru :cl)
               (/ '(to :crlf) ,scan-number)
               (thru (repeat 2 :crlf))
               (/ '(to -1) ,(fn content-length [b] (if b (length b) 0))))}))

(defn ensure-length
  ```
  Ensures that request is read whole in the most cases.
  Uses multiple passes according to the type of the request.
  It clears the request if it cannot be read in 16 pasess of
  16384 bytes.
  ```
  [connection req]
  (var reading 16)
  (var last-index 0)
  (while (pos? reading)
    (cond
      (def cls (string/find "Content-Length:" req))
      (do
        (var len-diff (- ;(peg/match clg req cls)))
        (if (pos? len-diff)
          (:chunk connection len-diff req))
        (set reading 0))
      (not (string/find "\r\n\r\n" req))
      (do
        (:read connection buff-size req)
        (if (string/find "\r\n\r\n" req last-index)
          (set reading 1)
          (do
            (set last-index (length req))
            (if (one? reading) (buffer/clear req))
            (-- reading))))
      (set reading 0))))

(defn on-connection
  ```
  It takes `handler` with the user function,
  that will handle connections.
  Returns function for handling incomming connection,
  suitable for a default supervisor handling argument.
  Returned function reads the request and ensure its length.
  If it cannot be read in `ensure-length` it will write
  Entity too large response to the connection and closes it.
  ```
  [handler]
  (fn on-connection [connection]
    (def req (buffer/new buff-size))
    (:read connection buff-size req)
    (when (empty? req)
      (ev/give-supervisor :close connection)
      (break))
    (ensure-length connection req)
    (when (empty? req)
      (:write connection etl)
      (ev/give-supervisor :close connection)
      (break))
    # todo chunked response
    (def res (handler req))
    (if (bytes? res)
      (do
        (ev/write connection res)
        (ev/give-supervisor :conn connection))
      (do
        (res connection)
        (ev/give-supervisor :close connection)))))

# Managing part

(defn default-supervisor
  ```
  It takes `chan` as the supervising channel of the server
  and `handling` as the handling function.
  This supervisor is used by default if you do not
  provide your own to `start`.
  ```
  [chan handling]
  (forever
    (match (ev/take chan)
      [:close connection] (:close connection)
      [:error fiber]
      (let [err (fiber/last-value fiber)]
        (unless (or (= err "Connection reset by peer")
                    (= err "stream is closed"))
          (debug/stacktrace fiber err)
          (def conn ((fiber/getenv fiber) :conn))
          (protect (:write conn ise))
          (:close conn)))
      [:conn connection]
      (ev/go
        (fiber/new
          (fn handling-connection [conn]
            (setdyn :conn conn)
            (handling conn)) :tp) connection chan))))

(defn start
  ```
  This function starts server. Usually in the fiber.
  It takes handler function, which will be called with every new connection.
  It argument will be request dictionary. Function must return
  http-response string.

  It also takes four optional arguments:
  - `host` on which server starts. Default `localhost`
  - `port` on which server starts. Default `8888`
  - `supervisor` function which will supervise the supervisor channel,
    after each connection. Default `default-supervisor`
  - `on-connection-fn` function which will be called for each
    connection. Default `on-connection`.
  ```
  [handler &opt host port supervisor on-connection-fn]

  (default host "localhost")
  (default port "8888")
  (default supervisor default-supervisor)
  (default on-connection-fn on-connection)

  (def server (net/listen host port))
  (def handling (on-connection-fn handler))
  (def chan (ev/chan))
  (ev/go
    (fiber/new
      (fn accept-connection []
        (forever (ev/give-supervisor :conn (net/accept server)))))
    nil chan)
  (supervisor chan handling))