Pull to refresh

Пишем веб-сервер на Common Lisp часть первая

Reading time 8 min
Views 8.2K
Не так давно я взялся за изучение Common Lisp. Как может показаться, изучение нового языка программирования — дело весьма не простое, тем более если он совсем непохож на все те языки, с которыми приходилось сталкиваться ранее. Поэтому я решил начать с книги Land Of Lisp. Книга весьма неплохая, с интересными картинками и очень хорошо подходит для начинающих. В одной из глав было описание создания веб-сервера на Common Lisp. Я решил слегка развить эту тему, и в итоге у меня получилось не совсем то, что было описано в этой главе, а весьма интересный веб-сервер. Исходные коды можно посмотреть тут.

Для его написания нам понадобится Linux с установленными emacs, sbcl, slime и quicklisp. Описывать, как это всё устанавливать, настраивать и как этим пользоваться, я не стану — в интернете есть множество статей об этом. Весь наш веб-сервер будет находиться в одном пакете, называемом myweb. Создайте у себя папку с данным названием, и в ней создайте две папки log и web. Папка log будет содержать лог-файл веб-сервера. В папке web будут лежать html-страницы и изображения, которые веб-сервер будет отдавать клиентам. Весь веб-сервер состоит из семи файлов.

Начнём с файла, обьявляющего пакет, и asd файла описания самого пакета.

Создайте файл package.lisp:
(in-package :cl-user)

(defpackage :myweb
  (:use :cl :usocket :bordeaux-threads)
  (:export :start-http :stop-http :list-workers :list-requests))

(defpackage :myweb.util
  (:use :cl :local-time)
  (:export :parse-request :read-utf-8-string :response-write :get-param :get-header :http-response :file-response :html-template :log-info :log-warning :log-error))

(defpackage :myweb.handler
  (:use :cl)
  (:export :process-request))

Как видите, наш веб-сервер состоит из трех пакетов:
  • myweb — будет содержать функции для запуска и остановки веб-сервера
  • myweb.util — будет содержать функции, помогающие обрабатывать запросы
  • myweb.handler — будет содержать сам код обработки запроса

Функция in-package как правило ставится в начале файла и указывает имя пакета в котором мы объявляем переменные и функции. В данном случае так как мы объявляем пакеты, то мы должны объявить их в основном пакете :cl-user.
Обратите внимание на директивы :use и :export в обьявлении пакетов. :use позволяет нам пользоваться функциями из других пакетов без указания названия пакетов в начале имени функции, тем самым сокращая количество набираемого текста. :export задает имена тех функций, которыми можно пользоватся вне пакета. Как можно увидеть, у нас в пакете :myweb есть функции :start-http и :stop-http. Находясь в пакете :cl-user, мы не сможем вызывать их через myweb:start-http, если предварительно не объявим их с помощью директивы :export.

Обьявление пакетов у нас уже есть, теперь осталось написать сам исходный код этих пакетов. Создайте файлы web.lisp, util.lisp и handler.lisp и в каждом из них добавьте вызов in-package. Для web.lisp — (in-package :myweb), для util.lisp (in-package :myweb.util) и т.д. Нам также понадобится создать файл log.lisp c вызовом (in-package :cl-log). Этот файл нужен для запуска и конфигурации системы логирования cl-log.

Завершающим штрихом создания структуры файлов для веб-сервера будет создание файла myweb.asd, описывающего, какие файлы система asdf должна загрузить, чтоб у нас всё работало.

;; myweb.asd

(asdf:defsystem #:myweb
  :serial t
  :components ((:file "package")
	       (:file "log")
               (:file "util")
	       (:file "web")
	       (:file "handler")))

Ключ :serial t указывает, чтоб asdf загружала файлы в том же порядке, в каком они у нас перечислены.

Теперь нужно написать файл load.lisp, который будет подгружать наш пакет и запускать swank сервер для slime.

(in-package :cl-user)

(quicklisp:quickload "swank")
(quicklisp:quickload "usocket")
(quicklisp:quickload "bordeaux-threads")
(quicklisp:quickload "trivial-utf-8")
(quicklisp:quickload "cl-log")
(quicklisp:quickload "local-time")

(pushnew '*default-pathname-defaults* asdf:*central-registry*)
(asdf:load-system 'myweb)

(swank:create-server)

Чтобы продолжить разработку, нам нужно уже запустить swank и загрузить все нужные библиотеки с помощью quicklisp. Для этого запустите sbcl, находясь в директории myweb, и вызовите функцию (quicklisp:quickload «swank»). После установки swank запустите swank-сервер, вызвав (swank:create-server) из коммандной строки sbcl.
Используя slime-connect из emacs, подсоединитесь к запущенному sbcl и вызовите все остальные функции с quicklisp из load.lisp при помощи slime-mode в emacs и комбинации клавиш ctrl-e. Если вы всё сделали правильно, то quicklisp скачает всё нужные библиотеки и подгрузит их с помощью asdf за вас. Все готово к началу разработки.

Начнём с самого веб-сервера. Для него нам понадобятся сокеты. Работы с сокетами я решил реализовать с помощью широко распространнёной библиотеки usocket. Также нам понадобится потоки (threads), для которых мы будем использовать bordeaux-threads. Но сначала я хотел бы рассказать о той модели обработки http-запросов, которую мы собираемся создать. Каждый запрос будет обрабатываться отдельным потоком. У нас будут потоки-worker'ы, которые будут создаваться в зависимости от количества запросов. Среди них у нас будут отдельные idle-потоки, которые после завершения обработки запроса будут переходить в состояние condition-wait, ожидая новых запросов. Тем самым можно снизить нагрузку от создания новых worker-потоков. Получается своеобразный механизм thread pool для обработки http-запросов.
Начнём с обьявления сокетов и переменных для mutex-ов в файле web.lisp:

(defvar *listen-socket* nil)
(defvar *listen-thread* nil)

(defvar *request-mutex* (make-lock "request-mutex"))
(defvar *request-threads* (list))

(defvar *worker-mutex* (make-lock "worker-mutex"))
(defvar *workers* (list))
(defvar *worker-num* 0)
(defvar *idle-workers* (list))
(defvar *idle-workers-num* 0)
(defvar *request-queue* (list))

Для принятия и распределения запросов по потокам мы будем использовать отдельный поток, указатель на который будет храниться в *listen-thread*. Начнём с метода start-http:

(defun start-http (host port &key (worker-limit 10) (idle-workers 1))
  (if (not *listen-socket*)
      (setq *listen-thread* 
	    (make-thread (lambda () (http-acceptor host port worker-limit idle-workers)) :name "socket-acceptor"))
      "http server already started"))

Это простая функция для запуска потока-распределителя, который в свою очередь будет вызывать функцию http-acceptor. Также у нас есть два ключа — это worker-limit — максимальное кол-во worker-ов, и idle-workers — кол-во idle worker-ов.
Напишем саму функцию распределения запросов:

(defun http-acceptor (host port worker-limit idle-workers)
  (setq *listen-socket* (socket-listen host port :reuse-address t :element-type '(unsigned-byte 8) :backlog (* worker-limit 2)))
  (let ((request-id 0)
	(worker-id 0))
    (loop while *listen-thread* do
	 (let* ((socket (socket-accept *listen-socket* :element-type '(unsigned-byte 8))))
	   (progn (setq request-id (1+ request-id))
		  (acquire-lock *worker-mutex*)
		  (if (>= *worker-num* worker-limit)
		      (push (cons request-id socket) *request-queue*)
		      ;; Get worker from idle workers
		      (if (> *idle-workers-num* 0)
			  (progn (push (cons request-id socket) *request-queue*)
				 (condition-notify (caar *idle-workers*)))
		      ;; Add new Worker
		      (progn (setq worker-id (1+ worker-id))
			     (setq *worker-num* (1+ *worker-num*))
			     (setq *workers* (cons (make-thread (lambda () (worker-thread request-id socket idle-workers))
						     :name (concatenate 'string "socket-worker-" (prin1-to-string worker-id))) *workers*)))))
		  (release-lock *worker-mutex*)
		  t)))))

Первое, что мы делаем, это socket-listen на указанный адрес и порт. Далее в цикле мы делаем socket-accept, получая в результате socket на подключённого клиента, который мы должны обработать в worker-е. Плюс мы присваиваем запросу request-id. На этом этапе мы должны решить, что делать с запросом и как его обработать. Первым делом мы проверяем количество idle-потоков. Если у нас все worker-ы заняты, мы добавляем запрос в очередь для обработки. Если же у нас есть свободный idle worker, то мы опять-таки добавляем запрос в очередь, но на этот раз вызываем (condition-notify (caar *idle-workers*))). И в третьем случае мы просто создаём новый worker и передаём ему запрос, который будет обработан в функции worker-thread. Всё достаточно просто. Осталось лишь написать функцию обработки worker-потока:

(defun worker-thread (request-id socket idle-workers)
  (if request-id
      ;; Process request if it is not nil
      (progn 
	(with-lock-held (*request-mutex*)
	  (setq *request-threads* (cons (cons request-id (current-thread)) *request-threads*))
	  )
	(http-worker socket)
	(with-lock-held (*request-mutex*)
	  (setq *request-threads* (remove-if (lambda (x) (eq (car x) request-id)) *request-threads*))
	  )
	))
  (acquire-lock *worker-mutex*)
  (if *request-queue*
      (let ((request nil))
	(setq request (car *request-queue*))
	(setq *request-queue* (cdr *request-queue*))
	(release-lock *worker-mutex*)
	(worker-thread (car request) (cdr request) idle-workers))
      (if (< *idle-workers-num* idle-workers)
	  (let ((condition (make-condition-variable))
		(idle-lock (make-lock))
		(request nil))
	    (push (cons condition (current-thread)) *idle-workers*)
	    (setq *idle-workers-num* (1+ *idle-workers-num*))
	    (release-lock *worker-mutex*)
	    (list-workers)
	    (with-lock-held (idle-lock)
	      (condition-wait condition idle-lock)
	      )
	    (with-lock-held (*worker-mutex*)
	      (setq *idle-workers* (cdr *idle-workers*))
	      (setq *idle-workers-num* (1- *idle-workers-num*))
	      (setq request (car *request-queue*))	
	      (setq *request-queue* (cdr *request-queue*))
	      )
	    (worker-thread (car request) (cdr request) idle-workers))
	  (progn (setq *workers* (remove (current-thread) *workers*))
		 (setq *worker-num* (1- *worker-num*))
		 (release-lock *worker-mutex*)))))

Если у нас произошёл вызов с request-id, то нам нужно в первую очередь обработать запрос. Мы просто вызываем вспомогательную функцию http-worker и передаём ей socket клиента. Далее мы проверяем, есть ещё запросы на обработку: просто убираем первый же запрос из очереди и передаём его в worker-thread на обработку, вызывая тем самым функцию worker-thread рекурсивно. Может возникнуть вопрос «а не случится ли recursion limit от того, что стек переполнится в какой-то момент, например при большом кол-ве запросов в очереди?» Так как после вызова worker-thread рекурсивно у нас ничего в функции не вызывается, то recursion limit не произойдёт. Почти все современные реализации Common Lisp поддерживают эту оптимизацию. Ну и если очередь пуста, то нам осталось проверить количество idle worker-ов. Если у нас всё в порядке, то мы просто завершаем запрос и убираем worker из списка worker-ов. Если же нет, то мы делаем condition-wait, и тем самым worker становится idle worker-ом.
Если вы заметили, то мы также вызываем list-workers. Эта вспомогательная функция, которая просто очищает лист worker-ов от мертвых потоков.
Осталось написать http-worker функцию:

(defun http-worker (socket)
  (let* ((stream (socket-stream socket))
	 (request (myweb.util:parse-request stream)))
    (myweb.handler:process-request request stream)
    (finish-output stream)
    (socket-close socket)))

(defun list-workers ()
  (with-lock-held (*worker-mutex*)
    (setq *workers*
	  (remove-if (lambda (w) (not (thread-alive-p w))) *workers*))
    (setq *worker-num* (length *workers*))
	*workers*))

Здесь мы создаем socket-stream, парсим запрос и передаем его в myweb.handler:process-request (об этих функциях мы поговорим во второй части). list-workers просто возвращает нам список worker-ов, предварительно очистив его от мертвых потоков. Мы вызываем эту функцию в worker-thread перед condition-wait.
Последнее, что нам нужно сделать — это написать функцию stop-http, которая будет останавливать наш веб-сервер:

(defun stop-http ()
  (if *listen-socket*
      (progn (stop-thread) 
	(socket-close *listen-socket*)
	     (setq *listen-socket* nil)
	     (setq *request-queue* nil)
	     (setq *worker-num* 0)
	     (setq *workers* nil)
	     (mapcar (lambda (i) (destroy-thread (cdr i))) *idle-workers*)
	     (setq *idle-workers-num* 0)
	     (setq *idle-workers* nil)
	     (release-lock *worker-mutex*)
	     (setq *request-threads* nil)
	     (release-lock *request-mutex*)
	     (setq *request-mutex* (make-lock "request-mutex"))
	     (setq *worker-mutex* (make-lock "worker-mutex")))))

(defun stop-thread ()
  (if (and *listen-thread* (thread-alive-p *listen-thread*))
      (destroy-thread *listen-thread*)))

Как видите, здесь всё просто — мы останавливаем поток распределителя, убиваем все worker-ы и обнуляем списки.
И так, всё готово для того, чтобы обрабатывать наши запросы. Об этом мы поговорим во второй части.

Cпасибо за внимание!

P.S. Спасибо ertaquo за помощь с орфографией и layout-ом
Tags:
Hubs:
+33
Comments 19
Comments Comments 19

Articles