(blog ‘lucindo)

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