(blog ‘lucindo)

O Ivan colocou na sua página dois benchmarks interessantes:

• Expressões regulares: tempo para verificar se 170K strings são URLs
• “Hello Interwebs!”: número de requests por segundo em uma página dinâmica

Linguagens testadas: C, C++, Java, Perl, Python, Ruby, Ocaml, PHP, D, Erlang e Common Lisp.

Observação: Nenhum dos testes prova nada além do que um bando de programadores não tem nada mais para fazer da vida depois rola uma discussão na hora do café.

Eu precisava de uma wiki para ajudar a organizar idéias de um projeto. Depois de conversar com os outros envolvidos eu fiquei de instalar uma em um servidor para começarmos a usar no dia seguinte.
Resolvi que seria uma experiência interessante escrever uma wiki em CL. Como precisávamos da wiki para o dia seguinte eu tinha que escrever tudo em uma noite, e se não desse certo eu instalaria uma wiki qualquer.
Bom, foi aí que surgiu a Milki, que estamos usando até hoje. As bibliotecas que eu usei:

• Hunchentoot: web sever/container
• CL-WHO: para escrever HTML em sexps
• CL-Store: serialização de objetos
• CL-Fad: manipulação de arquivos e diretórios
• S-Utils: para formação de datas

Todas elas podem ser instaladas via ASDF-Install.

Para a formatação usei a sintaxe Markdown. A renderização é feita via JavaScript, com o pacote Showdown.

Vou tentar colocar algumas partes do código explicando como tudo foi implementado. No final desse post tem alguns links com o código-fonte completo.

Começamos carregando todas as dependências e definindo o pacote:

;;; MILKI - MInimal Lisp wiKI
(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :hunchentoot)
  (require :cl-who)
  (require :cl-store)
  (require :s-utils)
  (require :cl-fad))

(defpackage :milki
  (:use :common-lisp :cl-who)
  (:export #:start-wiki #:stop-wiki
           #:add-user #:change-password #:remove-user))

(in-package :milki)

As funções para iniciar e terminar a execução do servidor web são wrappers para funções do Hunchentoot:

; we need a variable to hold the server instance
(defvar *wiki-server* nil “the hunchentoot server instance”)

(defun start-wiki (&key (port 8080))
  (setf *wiki-server* (hunchentoot:start-server :port port)))

(defun stop-wiki ()
  (hunchentoot:stop-server *wiki-server*))

Milki usa três diretórios separados: um para os arquivos estáticos (CSS, JavaScript, etc), um para os arquivos recebidos via upload e um outro para armazenar os dados das páginas. Nesses dois últimos é necessário ter permissão de escrita:

(defparameter *static-files-dir* “/home/lucindo/milki/static/”
  “place where we can put all JavaScript and CSS files”)
(defparameter *data-storage-dir* “/home/lucindo/milki/data/”
  “place where we’ll store all data”)
(defparameter *upload-dir* “/home/lucindo/milki/files/”
  “place to put uploaded files”)

Como esse sistema vai rodar num ambiente multi-threaded usei um lock global que será aplicado ao acesso de arquivos e estruturas.

;; this will run on a multithreaded environment and for
;; some operations we will use a global lock
(defvar *lock* (hunchentoot-mp:make-lock “milki-lock”))

(defmacro locked (&body body)
  `(hunchentoot-mp:with-lock (*lock*) ,@body))

Agora temos a implementação do controle usuários. Apenas a autenticação é acessada pelo Hunchentoot, ou seja, a criação, remoção e mudança de senha não são feitas online, e sim avaliando as expressões correspondentes na imagem lisp (por isso essas funções são exportadas no pacote).

;; we need users
;; users are stored in a assoc-list: (”username” password)
;; the password is a md5 of password string
;; here we use the md5 package (required by hunchentoot)
;; the users list is stored in a file using cl-store
(defun users-file ()
  (concatenate ’string *data-storage-dir* “.users”))

; will be nil at first run
(defvar *user-alist* (ignore-errors (cl-store:restore (users-file))))

(defun sync-users-file ()
  (locked
    (cl-store:store *user-alist* (users-file))))

(defun add-user (user pass)
  (push (cons user (md5:md5sum-sequence pass)) *user-alist*)
  (sync-users-file))

(defun remove-user (user)
  (setf *user-alist*
        (remove-if #’(lambda (up-pair)
                       (string= user (car up-pair))) *user-alist*))
  (sync-users-file))

(defun user-pass-match-p (user pass)
  (and user pass
       (equalp (cdr (assoc user *user-alist* :test #’string=))
               (md5:md5sum-sequence pass))))

(defun change-password (user oldpass newpass)
  (when (and (user-pass-match-p user oldpass) newpass)
    (setf (cdr (assoc user *user-alist* :test #’string=))
          (md5:md5sum-sequence newpass))
    (sync-users-file)))

Essa wiki é privada. Só é possível acessá-la tendo um usuário. Assim todas as páginas precisam de controle de acesso, e para isso usamos macros:

; require a digest autorization
(defmacro with-authorization (&body body)
  (let ((user (gensym))
        (pass (gensym)))
    `(multiple-value-bind (,user ,pass)
         (hunchentoot:authorization)
       (if (user-pass-match-p ,user ,pass)
           ,@body
           (hunchentoot:require-authorization “[milki login]”)))))

; all wiki pages requires authorization (this is a private wiki!)
(defmacro with-wiki-page-body (&body body)
  `(with-authorization
     (with-html-output-to-string (*standard-output* nil :prologue t)
       (:html
        (:head
         (:title “milki - a very simple wiki”)
         (:script :type “text/javascript” :src “/static/showdown.js”)
         (:script :type “text/javascript” :src “/static/milki.js”)
         (:link :rel “stylesheet” :href “/static/milki.css” :type “text/css”))
        (:body ,@body)))))

Agora, cada página é armazenada como uma lista de instancias do objeto wiki-post. Sempre que uma página é alterada criamos uma instância desse objeto e adicionamos à lista. Assim mandemos o histórico. Cada item da lista é uma versão da página, sendo que o primeiro deles é a versão mais atual.

;; we’ll store wiki posts in files
(defun wiki-post-file-name (post-name)
  (concatenate ’string *data-storage-dir* “wiki-” (hunchentoot:url-encode post-name)))

(defun sync-wiki-post (post-name wiki-post-list)
  (locked
    (cl-store:store wiki-post-list (wiki-post-file-name post-name))))

; may return nil
(defun get-wiki-post (post-name)
  (locked
    (ignore-errors (cl-store:restore (wiki-post-file-name post-name)))))

;; a wiki post is very simple
(defclass wiki-post ()
  ((contents :initarg :contents
             :accessor post-contents)
   (timestamp :initform (get-universal-time)
              :accessor post-timestamp)
   (user :initarg :user
         :accessor post-user)))

(defun add-wiki-post (post-name contents user)
  (let ((new-post (make-instance ‘wiki-post :contents contents :user user))
        (post-list (get-wiki-post post-name)))
    (if post-list
        (push new-post post-list)
        (setf post-list (list new-post)))
    (sync-wiki-post post-name post-list)))

A seguir definimos as funções principais da wiki: a que imprime uma página, a de edição de páginas e o handler principal. Como a renderização é feita via JavaScript não existe preview da edição, pois o mesmo é feito online, conforme o usuário edita:

(defun show-wiki-post (post-name post-version post)
  (let ((edit-link (conc post-name “?edit=true&version=” (princ-to-string post-version))))
    (with-wiki-page-body
      (:div :align “right”
            (:font :size “-1″
                   (:a :href (str edit-link) “edit”)))
      (:div :id “wiki-post” :class “wiki-post”
            :ondblclick (conc “document.location=”" edit-link “”;”)
            (str (post-contents post)))
      (:hr :class “footer”)
      (:span :id “footer” :class “footer”
             (:font :size “-1″
                    (:table :border “0″
                            :width “98%”
                            :align “center”
                            :cellpadding “0″
                            :cellspacing “0″
                            (:tr
                             (:td :align “left”
                                  “useful links: “
                                  (:a :href “/” “start page”)
                                  ” - “
                                  (:a :href “/index” “wiki index”))
                             (:td :align “right”
                                  (str (conc “last updated by “
                                             (post-user post)
                                             ” on “
                                             (s-utils:format-universal-time
                                              (post-timestamp post))))))))))))

(defun print-wiki-post (post-name post-version)
  (let* ((wiki-post-list (get-wiki-post post-name))
         (the-post (nth post-version wiki-post-list)))
    (cond ((not wiki-post-list)
           (with-wiki-page-body (:center (:h2 “Hey! I’m an empty page!”)
                                         (:a :href (conc post-name “?edit=true”)
                                             (:h3 “edit me”)))))
          ((not the-post) (show-wiki-post post-name post-version (car wiki-post-list)))
          (t (show-wiki-post post-name post-version the-post)))))

(defun edit-wiki-post (post-name post-version)
  (let* ((wiki-post-list (get-wiki-post post-name))
         (the-post (nth post-version wiki-post-list)))
    (with-wiki-page-body
      (:center
       (:h2 (str (conc “editing: “ post-name)))
       (:div :align “right”
             (:font :size “-1″
                    (:a :href “/upload” “click here to upload files”)
                    (:br)
                    “use markdown syntax: cheatsheet “
                    (:a :href “javascript: open_markdown_cheatsheet()” “here”)))
       (:form :method :post :action (str post-name)
              (:table :with “98%” :border “0″ :cellpadding “10″ :cellspacing “2″
                      (:tr
                       (:td :width “48%” :valign “top”
                            (:textarea :id “wiki-input”
                                       :name “contents” :cols 60 :rows 20 :style “width: 100%;”
                                       (when the-post (str (post-contents the-post)))))
                       (:td :width “48%” :valign “top” :style “border-left: solid 1px #736F6E”
                            (:div :id “wiki-preview”)))
                      (:tr :rowspan “2″
                           (:td
                                (:input :type :submit :value “save”)
                                (str ” or “)
                                (:a :href (princ-to-string post-name) “cancel”))))))
       (when  wiki-post-list
         (htm
          (:p “version history:”)
          (:ul
           (loop for i from 0
              for wiki-post in wiki-post-list
              do (htm (:li (fmt “version ~a by ~a: “ i (post-user wiki-post))
                           (:a :href (conc post-name “?version=” (princ-to-string i))
                               (str (conc (s-utils:format-duration
                                           (- (get-universal-time)
                                              (post-timestamp wiki-post)))
                                          ” ago”))))))))))))

;; the main function handler
(defun milki ()
  (hunchentoot:no-cache)
  (let ((post-name (hunchentoot:script-name))
        (post-version (hunchentoot:get-parameter “version”))
        (edit-p (hunchentoot:get-parameter “edit”))
        (contents (hunchentoot:post-parameter “contents”)))
    (if post-version
        (setq post-version (parse-integer post-version))
        (setq post-version 0))
    (when contents
      (add-wiki-post post-name contents (hunchentoot:authorization)))
    (if edit-p
        (edit-wiki-post post-name post-version)
        (print-wiki-post post-name post-version))))

Além de poder criar e editar páginas, deveríamos poder fazer upload de arquivos. O seguinte handler adiciona essa funcionalidade:

; file-upload handler
(defun milki-upload ()
  (let ((sent-file (hunchentoot:post-parameter “file”))
        (remove-file (hunchentoot:get-parameter “remove”)))
    (when remove-file
      (ignore-errors (delete-file
                      (cl-fad:pathname-as-file
                       (concatenate ’string *upload-dir* remove-file))))
      (hunchentoot:redirect (hunchentoot:script-name)))
    (when (and sent-file (listp sent-file))
      (let ((path (car sent-file))
            (file-name (cadr sent-file)))
        ;; strip directory info sent by Windows browsers
        (when (search “Windows” (hunchentoot:user-agent) :test #’char-equal)
          (setq file-name (cl-ppcre:regex-replace “.*\\” file-name “”)))
        (let ((new-path (concatenate ’string *upload-dir* file-name)))
          (rename-file path (ensure-directories-exist new-path))))))
  (hunchentoot:no-cache)
  (let ((file-list (cl-fad:list-directory *upload-dir*)))
    (with-wiki-page-body
      (:center
       (:h2 “file uploader”)
       (:form :method :post :enctype “multipart/form-data”
              (:input :type :file :name “file”)
              (:input :type :submit :value “upload”))
       (when file-list
         (htm
          (:table :border “1″ :width “95%”
                  (dolist (file file-list)
                    (let ((file-link-name
                           (hunchentoot:url-encode
                            (cl-ppcre:regex-replace “.*/” (princ-to-string file) “”))))
                      (htm (:tr
                            (:td (:a :href
                                     (conc “/static/files/” file-link-name)
                                     (str file-link-name)))
                            (:td (str (conc “/static/files/” file-link-name)))
                            (:td (:a :href
                                     (conc (hunchentoot:script-name)
                                           “?remove=”
                                           file-link-name) “remove”)))))))))

Uma outra funcionalidade necessária é o índice, que lista todas as páginas já criadas (mesmo as que não conseguimos acessar pela estrutura de links):

;; milki page index
(defun generate-wiki-index ()
  (let ((wiki-pages-list ())
        (wiki-files (cl-fad:list-directory *data-storage-dir*)))
    (dolist (file-path wiki-files)
      (let ((file-name (cl-ppcre:regex-replace “.*/” (princ-to-string file-path) “”)))
        (when (string= (subseq file-name 0 5) “wiki-”)
          (push (hunchentoot:url-decode (subseq file-name 5)) wiki-pages-list))))
    (sort wiki-pages-list #’string<)))

; index handler
(defun milki-index ()
  (let ((wiki-pages (generate-wiki-index)))
    (with-wiki-page-body
      (:center (:h2 “wiki index”)
               (:h4 (fmt “~a pages so far…” (length wiki-pages))))
      (:ul
       (dolist (page wiki-pages)
         (htm (:li (:a :href page (str page)))))))))

Por fim, precisamos associar as funcões e diretórios às urls:

;; finally we setup hunchentoot environment
(eval-when (:execute :load-toplevel)
  (setf hunchentoot:*show-lisp-errors-p* t
        hunchentoot:*show-lisp-backtraces-p* t
        hunchentoot:*dispatch-table*
        (list ‘hunchentoot:dispatch-easy-handlers
              (hunchentoot:create-folder-dispatcher-and-handler
               “/static/files/” *upload-dir*)
              (hunchentoot:create-folder-dispatcher-and-handler
               “/static/” *static-files-dir*)
              (hunchentoot:create-prefix-dispatcher “/upload” ‘milki-upload)
              (hunchentoot:create-prefix-dispatcher “/index” ‘milki-index)
              (hunchentoot:create-prefix-dispatcher “/” ‘milki))))

E é isso. Uma wiki bem simples, feita para poucos usuários. Estou usando há quase um mês e até agora parece que funciona. Uma coisa que eu não vi em outras wikis (mas também não procurei muito) é a funcionalidade de preview online, que ajuda muito na hora de editar. Quem quiser o código completo é só seguir os links abaixo.

Download: milki.lisp
Arquivos que ficam no diretório de arquivos estáticos:

• milki.css: CSS da wiki
• showdown.js: pacote para renderizar markdown
• milki.js: chamadas para o showdown.js
• markdown.html: ajuda da sintaxe markdown

Nova versão do Postmoden-utils.

Download: http://www.lucindo.com.br/lisp/postmodern-utils.tar.gz

Para instalar via ASDF-Install:

* (require :asdf-install)
* (asdf-install:install "http://lucindo.com.br/lisp/postmodern-utils.tar.gz")


Mudanças:

• Bug fix na função select-daos: agora ela trata direito tipos em que o nome da tabela e da classe são diferentes.
• A macro with-pooled-connection pode ser chamada recursivamente e usará apenas uma conexão

Fiz umas mudanças mínimas no programa teste:

• Adicionei :external-format :latin-1 no with-open-file.
• Mudei a declaração do índice para:

  (defparameter *index*
    (make-instance ‘montezuma:index
                   :path “/tmp/montezuma-test”
                   :analyzer (make-instance
                              ‘montezuma:whitespace-analyzer)
                   :min-merge-docs 500
                   :default-field “*”
                   :fields ‘(“file” “content”)))

Indexando apenas o /Documentation do source do Linux:

$ pwd
/linux-2.6.23.1/Documentation
$ find . -type f | wc -l
993
$ du -hs .
11M .
$ cd ~/Documents/Lisp/search
$ sbcl --noinform --no-linedit
* (load (compile-file "montezuma-test2.lisp"))
....
; compilation finished in 0:00:05
T
* (time (montezuma-test:add-dir-to-index "/linux-2.6.23.1/Documentation"))

Evaluation took:
31.639 seconds of real time
28.463371 seconds of user run time
2.271331 seconds of system run time
[Run times include 1.967 seconds GC run time.]
0 calls to %EVAL
0 page faults and
885,615,248 bytes consed.
* (time (montezuma-test:search-index "linux"))
/linux-2.6.23.1/Documentation/kbuild/00-INDEX score: 0.22367968
/linux-2.6.23.1/Documentation/video4linux/README.ir score: 0.11622737
/linux-2.6.23.1/Documentation/fujitsu/frv/README.txt score: 0.11183984
/linux-2.6.23.1/Documentation/scsi/scsi-generic.txt score: 0.11183984
/linux-2.6.23.1/Documentation/usb/auerswald.txt score: 0.11183984
/linux-2.6.23.1/Documentation/filesystems/befs.txt score: 0.09685614
/linux-2.6.23.1/Documentation/scsi/ChangeLog.arcmsr score: 0.09489925
/linux-2.6.23.1/Documentation/arm/Samsung-S3C24XX/SMDK2440.txt score: 0.08947187
/linux-2.6.23.1/Documentation/basic_profiling.txt score: 0.08947187
/linux-2.6.23.1/Documentation/isdn/README.pcbit score: 0.08947187
Evaluation took:
0.307 seconds of real time
0.249204 seconds of user run time
0.034769 seconds of system run time
[Run times include 0.011 seconds GC run time.]
0 calls to %EVAL
0 page faults and
11,145,488 bytes consed.
79
* (time (montezuma-test:search-index "net"))
/linux-2.6.23.1/Documentation/networking/spider_net.txt score: 0.24094483
/linux-2.6.23.1/Documentation/video4linux/se401.txt score: 0.15144332
/linux-2.6.23.1/Documentation/networking/dmfe.txt score: 0.1325129
/linux-2.6.23.1/Documentation/networking/ewrk3.txt score: 0.1325129
/linux-2.6.23.1/Documentation/networking/framerelay.txt score: 0.11358249
/linux-2.6.23.1/Documentation/networking/pt.txt score: 0.09465207
/linux-2.6.23.1/Documentation/isdn/README.hysdn score: 0.09370077
/linux-2.6.23.1/Documentation/networking/DLINK.txt score: 0.09370077
/linux-2.6.23.1/Documentation/networking/ray_cs.txt score: 0.07572166
/linux-2.6.23.1/Documentation/input/xpad.txt score: 0.06625645
Evaluation took:
0.083 seconds of real time
0.070906 seconds of user run time
0.008872 seconds of system run time
[Run times include 0.021 seconds GC run time.]
0 calls to %EVAL
0 page faults and
2,154,208 bytes consed.
23
* (quit)
$ du -hs /tmp/montezuma-test
27M /tmp/montezuma-test


Fonte: montezuma-test2.lisp