Новый форум о Scheme

По просьбам страждущих ;) добавил на lisper.ru новый форум, посвященный программированию на языке Scheme: http://lisper.ru/forum/scheme. Сам я Scheme не люблю, и как-то сомневаюсь, что этом форуме будет какая-либо активность, но всё же... вдруг я ошибаюсь...

Нужен перевод на русский статьи про eval-when

Разыскивается желающий перевести статью: http://fare.livejournal.com/146698.html :) Перевод (если он будет) будет размещён на сайте lisper.ru в разделе Статьи

cl-closure-template 0.1.2

Выпустил новую версию cl-closure-template - 0.1.2. Новая версия содержит изменения, любезно предоставленные Alexey Lebedeff, за что ему большое спасибо.

Простейшая загрузка файла с помощью RESTAS

После предыдущего поста меня попросили показать пример использования RESTAS для загрузки файла. Формально говоря, этот вопрос не имеет отношения к RESTAS, ибо решается за счёт средств hunchentoot, но тем не менее:

(asdf:operate 'asdf:load-op :cl-who)
(asdf:operate 'asdf:load-op :restas)

(restas:defsite :restas.example-3
 (:use :cl))

(in-package :restas.example-3)

(define-route main ("" :method :get)
 (who:with-html-output-to-string (out)
   (:html
    (:body
     ((:form :method :post
             :enctype "multipart/form-data")
      ((:input :name "file"
               :type "file"))
      (:br)
      ((:input :type "submit"
               :value "Send")))))))

(define-route main/post ("" :method :post)
 (let ((file-info (hunchentoot:post-parameter "file")))
   (if file-info
       (who:with-html-output-to-string (out)
         (:html
          (:body
           (:div
            (:b  "Name: ")
            (who:str (second file-info)))
           (:div
            (:b  "Content-Type: ")
            (who:str (third file-info)))
           (:div
            (:b "Content")
            (:br)
            (who:str (hunchentoot:escape-for-html (alexandria:read-file-into-string (first file-info)))))
           ((:a :href (restas:genurl 'main)) "Try again"))))
       (restas:redirect 'main))))

(restas:start-site :restas.example-3 :port 8080)

Данный пример выводит форму, в которой предлагается указать файл для загрузки. После отправки формы на сервер отображается страница с информацией о загруженном файле: имя, content-type, а также выводится его содержимое (по этой причине данный пример работоспособен только с текстовыми файлами). Код в основном повторяет пример про обработку POST-запроса, но теперь вместо строки в форме отправляется файл. Основное отличие состоит в том, что вызов hunchentoot:post-parameter для файла возвращает не строку, а список, содержащий путь к загруженному файлу (во временной директории hunchentoot:*tmp-directory*), его имя и content-type.

"Hello World" с RESTAS

Я немного переработал RESTAS, отказавшись от пары заблуждений (впрочем, во внутренностях ещё остались их следы), что позволило избавиться от одного "магического" элемента в коде примеров и теперь я готов их немного прокомментировать.

Да, теперь RESTAS имеет текущую версию 0.0.3 и доступен для лёгкой установки либо через мой форк gentoo-lisp-overlay, либо через мой форк clbuild.

Hello World

Классический "Hello world", куда же без него:

(asdf:operate 'asdf:load-op '#:restas)

(restas:defsite #:restas.hello-world
 (:use :cl))

(in-package #:restas.hello-world)

(define-route main ("")
 "<h1>Hello world!</h1>")

(restas:start-site '#:restas.hello-world :port 8080)

Если после выполнения данного кода открыть в браузере ссылку http://localhost:8080/, то можно будет увидеть заголовок "Hello world", очень мило :)

Теперь по порядку, строчка за строчкой:

1. Для начала загружает сам RESTAS:

   (asdf:operate 'asdf:load-op '#:restas)

2. Объявляем новый сайт:

   (restas:defsite #:restas.hello-world
    (:use :cl))
   

   Фактически, данный код просто создаёт пакет и проводит его инициализацию: добавляет несколько переменных. Это довольно любопытный момент, что сайт не является объектом, либо символом, а связан с пакетом. Почему так сделано? Я хочу, что бы процесс создания веб-приложения был максимально простым и не требовал бы много буков. А использовании "пакета в качестве сайта" позволяет во многих случаях не указывать сайт явно, а просто размещать код, как-то влияющий на сайт, внутрь связанного с ним пакета.
3. Меняем текущий пакет, как следует из предыдущего пункта, это важно:

   (in-package #:restas.hello-world)

4. Создаём маршрут, ответственный за обработку GET-запроса к корню сайта:

   (define-route main ("")
    "<h1>Hello world!</h1>")

   Внутри макроса define-route может быть произвольный код, который должен вернуть либо строку, либо octets array, либо pathname (в этом случае клиент получит соответствующий файл), либо целое число (которое будет интерпретироваться как статус ответа, например hunchentoot:+http-not-found++). Также, это код может свободно использовать все переменные, указанные в документации на веб-сервер hunchentoot (например, hunchentoot:*request* или hunchentoot:*reply*). О маршрутах в RESTAS можно почитать ещё здесь.
5. Запускаем веб-сервер и активизуем сайт:

   (restas:start-site '#:restas.hello-world :port 8080)

Обработка POST-запросов

А это пример демонстрирует различную обработку GET и POST-запросов:

(asdf:operate 'asdf:load-op :cl-who)
(asdf:operate 'asdf:load-op :restas)

(restas:defsite :restas.example-1
 (:use :cl))

(in-package :restas.example-1)

(define-route main ("" :method :get)
 (who:with-html-output-to-string (out)
   (:html
    (:body
     ((:form :method :post)
      ((:input :name "message"))
      ((:input :type "submit" :value "Send")))))))

(define-route main/post ("" :method :post)
 (who:with-html-output-to-string (out)
   (:html
    (:body
     (:div
      (:b (who:fmt "test message: ~A"
                   (hunchentoot:post-parameter "message"))))
     ((:a :href (restas:genurl 'main)) "Try again")))))

(restas:start-site :restas.example-1 :port 8080)

После его выполнения и открытия страницы http://localhost:8080/ становится доступна элементарная форма, в которую предлагается ввести произвольное сообщение. После чего можно выполнить Send и получить новую страницу, содержащую введённое сообщение и ссылку с предположение повторить, ещё немного доработать и можно будет продавать :)

Данный пример отличается от предыдущего тем, что содержит уже целых два маршрута, один для обработки GET-запроса, а другой для обработки POST. Как видно, тип запроса, за который отвечает маршрут, можно указать с помощью ключа :method, по-умолчанию это :get. Наличие в имени маршрута 'main/post, отвечающего за обработку POST-запроса, суффикса "post" является чистым совпадением: маршруты могу именоваться произвольным образом, лишь бы каждый маршрут имел уникальное имя. Также, в данном коде для генерации html используется библиотека cl-who, которую я совершенно не рекомендую использовать для реальных приложений, но для небольших демонстраций это самое то.

Маршруты с параметрами

Шаблон url, указываемый в define-route не обязан быть столь простым, как в предыдущих примерах, и может содержать несколько параметров, которые являются доступными для кода-обработчика, указанного внутри define-route.

(asdf:operate 'asdf:load-op :cl-who)
(asdf:operate 'asdf:load-op :restas)

(restas:defsite :restas.example-2
 (:use :cl :iter))

(in-package :restas.example-2)

(define-route root ("")
 (who:with-html-output-to-string (out)
   (:html
    (:head
     (:title "Example 2: Index"))
    (:body
     (:h1 "Index")
     (:ul
      (iter (for x from 1 to 10)
            (who:htm (:li
                      ((:a :href (genurl 'chapter-?.html :id x))
                       (who:fmt "Chapter ~A" x))))))))))

(define-route chapter-?.html ("chapter-:(id).html")
 (who:with-html-output-to-string (out)
   (:html
    (:head
     (:title (who:fmt "Example 2. Chapter ~A" id)))
    (:body
     (:h1 (who:fmt "Chapter ~A" id))
     (:ul
      (iter (for x from 1 to 10)
            (who:htm (:li
                      ((:a :href (genurl 'chapter-?-?.html :id1 id :id2 x))
                       (who:fmt "Chapter ~A-~A" id x))))))
     ((:a :href (genurl 'root))
      "Back to Index")))))

(define-route chapter-?-?.html ("chapter-:(id1)-:(id2).html")
 (who:with-html-output-to-string (out)
   (:html
    (:head
     (:title (who:fmt "Example 2. Chapter ~A-~A" id1 id2)))
    (:body
     (:h1 (who:fmt "Chapter ~A-~A" id1 id2))
     (:p (who:fmt "This is a chapter ~A-~A" id1 id2))
     ((:a :href (genurl 'chapter-?.html :id id1))
      (who:fmt "Back to Chapter ~A" id1))))))

(restas:start-site :restas.example-2 :port 8080)

Я не знаю, какой из примеров является более глупым, но данный демонстрирует навигацию по некой "книге с оглавлением" и нравится мне меньше всего. С другой стороны, он позволят не только показать маршруты с параметрами, но также и генерацию ссылок на основе имени маршрутов.

Код приведённых примеров входит в поставку RESTAS и находиться в директории example.

Ошибка в Hunchentoot

Сразу после запуска lisper.ru наблюдались достаточно регулярные зависания (раз в несколько дней): система работала, но http-запросы отрабатывать переставала. Удивительно, но подобное я наблюдал на одном единственном сервере, на других машинах (которые работают в заметно более интенсивном режиме) ничего подобного я не видел. Отладить lisp-процесс на удалённом сервере (в данном случае в Германии) с помощью SLIME почти так же просто как и локальный и при очередном зависании я обнаружил следующую картину:

 23: (SB-IMPL::%WITH-STANDARD-IO-SYNTAX #)
 24: (INVOKE-DEBUGGER #)
 25: (ERROR SB-BSD-SOCKETS:NOT-CONNECTED-ERROR)[:EXTERNAL]
 26: (SB-BSD-SOCKETS:SOCKET-ERROR "getpeername")
 27: ((SB-PCL::FAST-METHOD SB-BSD-SOCKETS:SOCKET-PEERNAME (SB-BSD-SOCKETS:SOCKET)) # # #)
 28: ((SB-PCL::FAST-METHOD USOCKET:GET-PEER-ADDRESS (USOCKET:STREAM-USOCKET)) # # #)
 29: (HUNCHENTOOT::CLIENT-AS-STRING #)
 30: ((SB-PCL::FAST-METHOD HUNCHENTOOT:HANDLE-INCOMING-CONNECTION (HUNCHENTOOT:ONE-THREAD-PER-CONNECTION-TASKMASTER T)) ..)
 31: ((SB-PCL::FAST-METHOD HUNCHENTOOT:ACCEPT-CONNECTIONS (HUNCHENTOOT:ACCEPTOR)) # # #)
 32: ((LAMBDA ()))

Судя по этому стэку вызовов проблема связана с ошибкой при вызове функции getpeername и происходит в функции HUNCHENTOOT::CLIENT-AS-STRING, которая вызывается в HUNCHENTOOT:ACCEPT-CONNECTIONS. Вот код HUNCHENTOOT:ACCEPT-CONNECTIONS:

(defmethod accept-connections ((acceptor acceptor))
  (usocket:with-server-socket (listener (acceptor-listen-socket acceptor))
    (loop
     (when (acceptor-shutdown-p acceptor)
       (return))
     (when (usocket:wait-for-input listener :ready-only t :timeout +new-connection-wait-time+)
       (when-let (client-connection
                  (handler-case* (usocket:socket-accept listener)                               
                    ;; ignore condition
                    (usocket:connection-aborted-error ())))
         (set-timeouts client-connection
                       (acceptor-read-timeout acceptor)
                       (acceptor-write-timeout acceptor))
         (handle-incoming-connection (acceptor-taskmaster acceptor)
                                     client-connection))))))

Вероятно, подобные ошибки являются большой редкостью, но к (не)счастью на одной машине я наблюдаю их постоянно. Для решения проблемы с зависаниями я поступил довольно грубо, изменив данную функцию в RESTAS путём добавление в основной цикл макроса ignore-errors:

(defmethod hunchentoot:accept-connections ((acceptor restas-acceptor))
  (usocket:with-server-socket (listener (hunchentoot::acceptor-listen-socket acceptor))
    (loop
       (when (hunchentoot::acceptor-shutdown-p acceptor)
         (return))
       (ignore-errors
         (when (usocket:wait-for-input listener :timeout hunchentoot::+new-connection-wait-time+)
           (handler-case
               (hunchentoot::when-let (client-connection (usocket:socket-accept listener))
                 (hunchentoot::set-timeouts client-connection
                                            (hunchentoot:acceptor-read-timeout acceptor)
                                            (hunchentoot:acceptor-write-timeout acceptor))
                 (hunchentoot:handle-incoming-connection (hunchentoot::acceptor-taskmaster acceptor)
                                                         client-connection))
             ;; ignore condition
             (usocket:connection-aborted-error ())))))))

С тех пор прошло около месяца и никаких зависаний больше не было, так что можно считать, что данный код хотя и грубоват, но таки работает :)

P.S. Описанная проблема слишком сложна для моего английского, поэтому в рассылку hunchentoot я об этом не писал. Было бы здорово, если бы кто-нибудь сделал это вместо меня :)

gentoo-lisp-overlay исправляется :)

Перед новым годом написал небольшой пост о некоторых проблемах в gentoo-lisp-overlay. То ли Stelian Ionescu может читать на великом и могучем ;) то ли ему кто подсказал, но сегодня при закачке обновлений в свой форк обнаружил, что упомянутые проблемы исправленны. Кроме того, к оригинальному gentoo-lisp-overlay были добавлены некоторые мои ebuild-ы, а также ebuild-ы для cl-gtk2. Судя по всему, это было сделано на основе моего форка, но с некоторыми переработками, некоторые из которых заставили меня проникнуться качеством проделанной работы :) Это, правда, привело к множественным конфликтам (в паре десятков файлов) в моём форке, которые я разруливал примерно в течении часа.

clbuild

Решил немного по разбираться с clbuild и должен сказать, что это удивительно тупой проект: столько усилий на бесперспективную системы, ибо она не претендует на что-то большое, плюс убивающий (не теоретически, но на практике) идею распределенных систем контроля версий darcs. Увы, но вне Gentoo это остаётся пожалуй самым простым способом установки CL-пакетов. Поэтому, решил это дело немного форкнуть. Итак, во-первых теперь есть http://github.com/archimag/clbuild-origin - git-версия оригинального darcs-репозитория, предназначена для желающих форкнуть это дело. Буду стараться сихронизировать с darcs более-менее регулярно, для чего использую тормозящий darcs-to-git. Во-вторых, есть http://github.com/archimag/clbuild-archimag - мой форк, который включает некоторые мои пакеты, в данный момент это:

• cl-routes
• garbage-pools
• restas
• wiki-parser
• cl-closure-template

Со временем, по мере возможности, собираюсь добавить и другие свои библиотеки.