Writing a web server in Common Lisp part two

In the last article we started developing our web server. We continue with the file util.lisp. This package will contain all our support functions for processing requests. First, let's declare the variable * line *, we will need it in the future.

(defvar *new-line* (concatenate 'string (string #\Return) (string #\Newline))) 

We also need a function that will read the bytes from the stream in utf-8 and convert them to a string using the trivial-utf-8 function : utf-8-bytes-to-string .

 (defun read-utf-8-string (stream &optional (end 0)) (let ((byte -1) (buffer (make-array 1 :fill-pointer 0 :adjustable t))) (handler-case (loop do (setq byte (read-byte stream)) (if (/= byte end) (vector-push-extend byte buffer)) while (/= byte end)) (end-of-file ())) (trivial-utf-8:utf-8-bytes-to-string buffer))) 

All we do is just read the bytes before we hit the byte with the value end and convert the resulting byte array to a string. You can write this function in a different way (more efficiently), but I have such an option. If you have good ideas I will be glad to see them in the comments. Declare another function

 (defun response-write (text stream) (trivial-utf-8:write-utf-8-bytes text stream)) 

She will help us write answers to the client in the same format (utf-8)

Our web server will be able to handle only GET requests. If it is interesting to someone, he can write processing POST requests, but for now we still limit ourselves to GET requests. A typical HTTP GET request looks like this.

 GET /path/to/a/resource?param1=paramvalue1¶m1=paramvalu2 HTTP/1.1 \r\n HeaderName: HeaderValue \r\n .... HeaderName: HeaderValue \r\n \r\n 

The first thing we do is find out what type of request we came to the web server.

 (defun parse-request (stream) (let ((header (read-utf-8-string stream 10))) (if (eq (length header) 0) '() (if (equal (subseq header 0 4) "POST") (parse-post-header header stream) (parse-get-header header stream))))) 

For POST requests, we are not going to do anything, so we’ll write a simple function

 (defun parse-post-header (header stream) (cons "POST" nil)) 

For a GET request, we need to get the path of the requested resource and all other headers.

 (defun parse-get-header (header stream) (cons "GET" (cons (parse-path (subseq header (position #\/ header) (position #\Space header :from-end t))) (parse-headers stream)))) 

To do this, we will use the parse-path and parse-headers functions.

Let's start with parse-path

 (defun parse-path (path) (if (position #\? path) (cons (subseq path 0 (position #\? path)) (parse-params (subseq path (1+ (position #\? path))))) (cons path nil))) 

As you can see here we are separating the path from the parameters and parsing the parameters separately with the parse-params function.
')
Before we start parsing the parameters, we need another auxiliary function to convert the characters used in the parameters in hexadecimal form into their immediate values.

 (defun http-char (c1 c2 &optional (default #\Space)) (let ((code (parse-integer (coerce (list c1 c2) 'string) :radix 16 :junk-allowed t))) (if code (code-char code) default))) 

This function can be called http-char-decode

It now remains to turn our parameters into alist.

 (defun parse-params (s) (let ((params (decode-params s))) (remove-duplicates params :test (lambda (x1 x2) (equal (car x1) (car x2))) :from-end nil))) (defun decode-params (s) (let ((p1 (position #\& s))) (if p1 (cons (decode-kv (subseq s 0 p1)) (parse-params (subseq s (1+ p1)))) (list (decode-kv s))))) (defun decode-kv (s) (let ((p1 (position #\= s))) (if p1 (cons (decode-param (subseq s 0 p1)) (decode-param (subseq s (1+ p1)))) (cons (decode-param s) nil)))) (defun decode-param (s) (labels ((f (1st) (when 1st (case (car 1st) (#\% (cons (http-char (cadr 1st) (caddr 1st)) (f (cdddr 1st)))) (#\+ (cons #\Space (f (cdr 1st)))) (otherwise (cons (car 1st) (f (cdr 1st)))))))) (coerce (f (coerce s 'list)) 'string))) 

As you can see, we use decode-params for this, which in turn calls recursively parse-params again by first parsing the name = value parameter using decode-kv . At the end, the decode-param helper function is used to separate the special http characters and convert them using http-char to return the already converted data.

Our parse-params is ready, it remains to write the function parse-headers , everything is much simpler here

 (defun parse-headers (stream) (let ((headers nil) (header nil)) (loop do (setq header (read-utf-8-string stream 10)) (if (> (length header) 2) (setq headers (cons (parse-header header) headers))) while (> (length header) 2)) (reverse headers))) (defun parse-header (header) (let ((pos (position #\: header))) (if pos (cons (string-downcase (subseq header 0 pos)) (string-trim (concatenate 'string (string #\Space) (string #\Return)) (subseq header (1+ pos))))))) 

We first take a string using (read-utf-8-string stream 10), where 10 is the value of \ n in ASCII and if it is more than two characters, parse it with the help of parse-header. As a result, we obtain the alist of all headers.

At this parse-get-header is ready and should return a type structure

 '("GET" ("path/to/file" (("param1" . "value1") ("param2" . "value2"))) (("header1" . "value1") ("header2" . "value2"))) 

For convenience of working with this structure, add two auxiliary functions.

 (defun get-param (name request) (cdr (assoc name (cdadr request) :test #'equal))) (defun get-header (name request) (cdr (assoc (string-downcase name) (cddr request) :test #'equal))) 

Now that we have a request, we can send a response to the client. A typical answer looks like this.

 HTTP/1.1 200 OK HeaderName: HeaderValue \r\n .... HeaderName: HeaderValue \r\n \r\n Data 

Let's write a couple of auxiliary functions that will help us with the answers.

 (defun http-response (code headers stream) (response-write (concatenate 'string "HTTP/1.1 " code *new-line*) stream) (mapcar (lambda (header) (response-write (concatenate 'string (car header) ": " (cdr header) *new-line*) stream)) headers) (response-write *new-line* stream)) (defun http-404-not-found (message stream) (http-response "404 Not Found" nil stream) (response-write message stream)) 

As you can see here, everything is also simple.

It now remains to write a function that will give us files from the web directory.

 (defun file-response (filename type request stream) (handler-case (with-open-file (in (concatenate 'string "web/" filename) :element-type '(unsigned-byte 8)) (if (equal (get-header "if-modified-since" request) (format-timestring nil (universal-to-timestamp (file-write-date in)) :format +asctime-format+)) (http-response "304 Not Modified" nil stream) (progn (http-response "200 OK" (cons (cons "Last-Modified" (format-timestring nil (universal-to-timestamp (file-write-date in)) :format +asctime-format+)) (cons (cons "Content-Type" type) nil)) stream) (let ((buf (make-array 4096 :element-type (stream-element-type in)))) (loop for pos = (read-sequence buf in) while (plusp pos) do (write-sequence buf stream :end pos))) ))) (file-error () (http-404-not-found "404 File Not Found" stream) ))) 

This will allow our web server to return files such as images and html pages. At the same time, we also return the Last-Modified header with the date of the last modification of the file. If we receive a request for the same file a second time with the if-modified-since header, we will time the date with the last file modification date. If the date has not changed, this means that the web browser has the latest version of the file in its cache, so we simply return the code 304 Not Modified

Now we’ll write the second html-template function that will take any text file from the web directory and replace values ​​of the type $ {name} with the values ​​specified in the alist list with the same names. A kind of primitive template engine

 (defun html-template (filename type params request stream) (handler-case (with-open-file (in (concatenate 'string "web/" filename) :element-type '(unsigned-byte 8)) (loop for line = (read-utf-8-string in 10) while (and line (> (length line) 0)) do (progn (mapcar (lambda (i) (let* ((key (concatenate 'string "${" (car i) "}"))) (loop for pos = (search key line) while pos do (setq line (concatenate 'string (subseq line 0 pos) (cdr i) (subseq line (+ pos (length key))))) ) )) params) (response-write line stream) (response-write (string #\Return) stream)) ) ) (file-error () (http-404-not-found "404 File Not Found" stream) ))) 

On this our util.lisp is almost ready, it remains only to write functions for logs. Let's start with the cl-log configuration in the log.lisp file

 (setf (log-manager) (make-instance 'log-manager :message-class 'formatted-message)) (start-messenger 'text-file-messenger :filename "log/web.log") (defmethod format-message ((self formatted-message)) (format nil "~a ~a ~?~&" (local-time:format-timestring nil (local-time:universal-to-timestamp (timestamp-universal-time (message-timestamp self)))) (message-category self) (message-description self) (message-arguments self))) 

Everything is standard here, the only thing that we changed is the format-message where we just print the date in formatted form.

Now we will add to util.lisp a logging function that will log messages in a separate stream, but no more than once per second. That will remove the burden of logging directly

 (defvar *log-queue-lock* (bt:make-lock)) (defvar *log-queue-cond* (bt:make-condition-variable)) (defvar *log-queue-cond-lock* (bt:make-lock)) (defvar *log-queue* nil) (defvar *log-queue-time* (get-universal-time)) (defun log-worker () (bt:with-lock-held (*log-queue-lock*) (progn (mapcar (lambda (i) (if (cdr i) (cl-log:log-message (car i) (cdr i)))) (reverse *log-queue*)) (setq *log-queue* nil) )) (bt:with-lock-held (*log-queue-cond-lock*) (bt:condition-wait *log-queue-cond* *log-queue-cond-lock*) ) (log-worker)) (bt:make-thread #'log-worker :name "log-worker") 

For this we will use the auxiliary logging functions.

 (defun log-info (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :info message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) (defun log-warning (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :warning message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) (defun log-error (message) (bt:with-lock-held (*log-queue-lock*) (progn (push (cons :error message) *log-queue*) (if (> (- (get-universal-time) *log-queue-time*) 0) (bt:condition-notify *log-queue-cond*)) ))) 

It remains to add to the handler.lisp process-request and try our functions.

 (defun process-request (request stream) (let ((path (caadr request))) (cond ((equal path "/logo.jpg") (myweb.util:file-response "logo.jpg" "image/jpeg" request stream)) (t (process-index request stream))))) (defun process-index (request stream) (let ((name (myweb.util:get-param "name" request))) (if (and name (> (length name) 0)) (myweb.util:html-template "index.html" "text/html;encoding=UTF-8" `(("name" . ,name)) request stream) (myweb.util:html-template "name.html" "text/html;encoding=UTF-8" nil request stream) ))) 

Create an index.html file in the web folder.

 <html> <head> <title>myweb</title> </head> <body> <image src="logo.jpg"> <h1>Hello ${name}</h1> </body> </html> 

And the file name.html

 <html> <head> <title>myweb</title> </head> <body> <image src="logo.jpg"> <h2>Hello stranger. What's your name?</h2> <form action="/" method="GET"> Name: <input type="text" name="name"> <input type="submit" value="Submit"> </form> </body> </html> 

And do not forget to put there a beautiful logo.jpg

Start the web server using (myweb: start-http "localhost" 8080) and go to the browser on localhost : 8080

Thanks for attention