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

    Не так давно я взялся за изучение 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-ом
    Поделиться публикацией
    Ммм, длинные выходные!
    Самое время просмотреть заказы на Фрилансим.
    Мне повезёт!
    Реклама
    Комментарии 19
    • +4
      Сэр, я понимаю, что в Лиспе запятые нужны редко, однако в естественных языках они все еще в моде.
      • 0
        Если я где-то пропустил запятую буду признателен за советы
        • +4
          Ох… Пропущенных запятых там примерно столько же, сколько скобочек в приведенном коде. :)
          • 0
            Будем исправлять постепенно
            • +3
              Неопределённость Гейзенберга. Либо много скобок, либо мало запятых.
              • +2
                В CL запятая — синтаксический сахар для сокращения количества скобочек.

                image
            • +1
              Здесь.
              • +1
                А да точно :)
                • +2
                  оппа, не туда.
                  Простите сэры, больше не буду!

                  (Defun рекурсия_пять_минут (x)
                  (cond((null x)nil)(t(progn
                  (Сволочь эта минусовая карма, пока извинишься раз в пять минут, уже подумают, что ты какой-нибудь сумасшедший (приходится сидеть и писать о внутренних мотивах (да (а нет, правильнее(t)))))
                  (рекурсия_пять_минут((cdr x))))))
                  )

                  Кажись прошло пять минут.
                  Сэры, позвольте откланяться!
                  • +4
                    а… нет, все-таки туда. Простите, судари все-таки, чо-то сам не свой, под конец дня. А вот вам для смены темы и отвлечения внимания от моих промахов незакрытая скобка (… даже две (
            • +2
              Код ужасен. На CL не похож вообще.

              Анахронизмы (setq), неэффективный код, ( (setq *worker-num* (1+ *worker-num*)) ), незнание базовых конструкций (if progn вместо when/unless/cond)…

              плюсую :)
              • 0
                очень будет интересно если опишите алтернативные варианты как было бы лучше писать это
                • 0
                  1. setq — в этом сезоне не популярен. Все угорают по setf;
                  2. incf/decf;
                  3. почти всегда when/unless/cond предпочтительнее чем if (меньше скобок).

                  И, умоляю, исправьте отступы! Распугаете всех читателей.
                  • 0
                    насчёт отступов я почему когда текст с табами сюда копирую он все табы убирает, постораюсь исправить заменой табов на пробелы
            • +2
              Мне кажется или это нормально для лиспа, что этот метод такой огромный defun worker-thread? может можно было бы разбить как то на составные части?
              • 0
                Я точно не знаю потому что особого опыта в отладке производительности я не делал в Common Lisp никогда. Если разбить на несколько частей то он будет быстрее работать?
                • 0
                  Да нет, просто с ним будет намного проще работать имхо, одна задача — 1 метод классика жанра…
                  • 0
                    я немного привёл в порядок код, последнюю версию можете взять с git репозитория

              Только полноправные пользователи могут оставлять комментарии. Войдите, пожалуйста.