Skip to content


Subversion checkout URL

You can clone with
Download ZIP
Tree: 3e4fcd0a15
Fetching contributors…

Cannot retrieve contributors at this time

385 lines (335 sloc) 12.6 KB
;;; elnode-wiki.el --- a wiki with Elnode -*- lexical-binding: t -*-
;; Copyright (C) 2010, 2011, 2012 Nic Ferrier
;; Author: Nic Ferrier <>
;; Maintainer: Nic Ferrier <>
;; Created: 5th October 2010
;; Keywords: lisp, http, hypermedia
;; This file is NOT part of GNU Emacs.
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <>.
;;; Commentary:
;; This is a Wiki Engine completely written in EmacsLisp, using Elnode
;; as a server.
;;; Source code
;; elnode's code can be found here:
;;; Style note
;; This codes uses the Emacs style of:
;; elnode-wiki--private-function
;; for private functions.
;;; Code:
(require 'elnode)
(eval-when-compile 'fakir)
(require 'creole nil 't)
;;(require 'vc)
(defgroup elnode-wikiserver nil
"A Wiki server written with Elnode."
:group 'elnode)
(defconst elnode-wikiserver-wikiroot-default
(expand-file-name (concat elnode-config-directory "wiki/"))
"The default location of the wiki root.
This is used to detect whether elnode needs to create this
directory or not.")
(defcustom elnode-wikiserver-wikiroot
"The root for the Elnode wiki files.
This is where elnode-wikiserver serves wiki files from."
:type '(directory)
:group 'elnode-wikiserver)
(defcustom elnode-wikiserver-body-header
"<div id='top'></div>"
"HTML BODY preamable of a rendered Wiki page."
:type '(string)
:group 'elnode-wikiserver)
(defcustom elnode-wikiserver-body-footer
"<div id='footer'>
<form action='{{page}}' method='POST'>
<legend>Edit this page</legend>
<textarea cols='80' rows='20' name='wikitext'>
<input type='text' name='comment' value=''/>
<input type='submit' name='save' value='save'/>
<input type='submit' name='preview' value='preview'/>
"HTML BODY footter for a rendered Wiki page."
:type '(string)
:group 'elnode-wikiserver)
(defcustom elnode-wikiserver-body-footer-not-loggedin
"<div id='footer'>
<a href='/wiki/login/?redirect={{page}}'>login to edit</a>
"HTML BODY footter for a rendered Wiki page."
:type '(string)
:group 'elnode-wikiserver)
(defun elnode-wiki--setup ()
"Setup the wiki."
(elnode--dir-setup elnode-wikiserver-wikiroot
(ert-deftest elnode-wiki--setup ()
"Test the wiki setup function."
;; Test that it's not called if we can't find the source file
(let (called)
(flet ((make-directory (dirname &optional parents)
(setq called t))
;; We fake buffer-file-name so that the wiki-index-source
;; will not be found
(buffer-file-name ()
(should-not called)))
;; Test that when called we're going to copy things right
(let (make-dir
;; Ensure the configurable wikiroot is set to the default
(elnode-wikiserver-wikiroot elnode-wikiserver-wikiroot-default))
(flet ((make-directory (dirname &optional parents)
(setq make-dir (list dirname parents)))
(dired-copy-file (from to ok-flag)
(setq copy-file (list from to ok-flag)))
;; Mock the source filename environment
(buffer-file-name ()
(file-exists-p (filename)
;; This is the dir we should make
'("/home/nferrier/.emacs.d/elnode/wiki/" t)
;; This is the copy file spec
;; So this is the directory that make-directory will create
;; and the copy-file spec
(list make-dir copy-file))))))
(defun elnode--wiki-call (out-buf page-text page)
"Call a wiki page sending output OUT-BUF.
The page is faked with PAGE-TEXT."
((elnode--worker-lisp-helper (child-lisp)
(require 'creole)
(require 'cl)
(flet ((creole--get-file (filename)
(let ((buf (get-buffer-create "wikibuf")))
(with-current-buffer buf
(insert ,page-text))
((target page)
(page-info page)
(header elnode-wikiserver-body-header)
(footer elnode-wikiserver-body-footer))
(require 'creole)
:destination t
:variables `((page . ,page-info))
:body-header header
:body-footer footer)))))
;; Deprecated
(defun elnode-wiki-send (httpcon wikipage &optional pageinfo)
"Sends the WIKIPAGE to the HTTPCON.
If PAGEINFO is specified it's the HTTP path to the Wiki page.
Uses Elnode's worker elisp stuff which is now deprecated."
(elnode-http-start httpcon 200 `("Content-type" . "text/html"))
(let ((page (or pageinfo (elnode-http-pathinfo httpcon))))
((target wikipage)
(page-info page)
(header elnode-wikiserver-body-header)
(footer elnode-wikiserver-body-footer))
(require 'creole)
:destination t
:variables `((page . ,page-info))
:body-header header
:body-footer footer))))
"The worker elisp code that this depends on is deprecated in
favour of Enode RLE.")
(defvar elnode-wiki-page-use-rle nil
"Whether to use RLE for this wiki or not.
The RLE stuff is not really stable yet so this is a switch that
let's developers play with but does not affect use.")
(defun elnode-wiki-page-rle (httpcon wikipage &optional pageinfo)
"Creole render the WIKIPAGE to the HTTPCON.
If PAGEINFO is specified it's the HTTP path to the Wiki page.
This version uses RLE which renders the Wiki page in a child
(let ((authenticated (elnode-http-cookie httpcon "elnodeauth")))
(let ((page-info (or pageinfo (elnode-http-pathinfo httpcon)))
(header elnode-wikiserver-body-header)
(footer (if authenticated
requires (creole elnode)
with-environment ((target wikipage)
(page-info page-info)
(header header)
(footer footer))
:destination t
:variables `((page . ,page-info))
:body-header header
:body-footer footer)))))
(defun elnode-wiki-page (httpcon wikipage &optional pageinfo)
"Creole render a WIKIPAGE back to the HTTPCON."
(if elnode-wiki-page-use-rle
(elnode-wiki-page-rle httpcon wikipage pageinfo)
;; Otherwise just do it
(elnode-http-start httpcon 200 `("Content-type" . "text/html"))
(with-stdout-to-elnode httpcon
(let ((page-info (or pageinfo (elnode-http-pathinfo httpcon)))
(header elnode-wikiserver-body-header)
(footer (if-elnode-auth httpcon 'elnode-wiki-auth
:destination t
:variables (list (cons 'page page-info))
:body-header header
:body-footer footer)))))
(defun elnode-wiki--text-param (httpcon)
"Get the text param from HTTPCON and convert it."
"\r" "" ; browsers send text in DOS line ending format
(elnode-http-param httpcon "wikitext")))
(defun elnode-wiki--save-request (httpcon wikiroot path text)
"Process an update request."
(let* ((page (if path
(string-match "/wiki/\\(.*\\)$" path)
(match-string 1 path))))
(comment (elnode-http-param httpcon "comment"))
(file-name (if (equal page "")
(concat wikiroot "index.creole")
(concat (file-name-as-directory wikiroot) page)))
(buffer (find-file-noselect file-name)))
(with-current-buffer buffer
(insert text)
(let ((git-buf
"* elnode wiki commit buf *"))))
(format "git commit -m '%s' %s" comment file-name)
(kill-buffer git-buf))
(elnode-wiki-page httpcon file-name))))
(defun elnode-wiki-handler (httpcon wikiroot)
"A low level handler for Wiki operations.
Send the Wiki page requested, which must be a file existing under
the WIKIROOT, back to the HTTPCON.
Update operations are protected by authentication."
(elnode-method httpcon
(elnode-docroot-for wikiroot
with target-path
on httpcon
(if (equal target-path (expand-file-name (concat wikiroot "/")))
(elnode-wiki-page httpcon (concat wikiroot "/index.creole"))
(elnode-wiki-page httpcon target-path))))
(with-elnode-auth httpcon 'elnode-wiki-auth
(let* ((path (elnode-http-pathinfo httpcon))
(text (elnode-wiki--text-param httpcon)))
(if (not (elnode-http-param httpcon "preview"))
;; A save request in which case save the new text and then
;; send the wiki text.
(elnode-wiki--save-request httpcon wikiroot path text)
;; Might be a preview request in which case send back the WIKI
;; text that's been sent.
(with-temp-file "/tmp/preview"
(insert text))
(elnode-wiki-send httpcon "/tmp/preview" path)))))))
(defun elnode-wikiserver-test ()
"Test whether we should serve Wiki or not."
(featurep 'creole))
(define-elnode-handler elnode-wikiserver (httpcon)
"Serve Wiki pages from `elnode-wikiserver-wikiroot'.
HTTPCON is the request.
The Wiki server is only available if the `creole' package is
provided. Otherwise it will just error."
(if (not (elnode-wikiserver-test))
(elnode-send-500 httpcon "The Emacs feature 'creole is required.")
(elnode-wiki-handler httpcon elnode-wikiserver-wikiroot)))
(defvar elnode-wiki-db
(concat elnode-config-directory "elnode-wiki-auth")))))
;; Define the authentication scheme for the wiki
:auth-db elnode-wiki-db
:redirect (elnode-auth-make-login-wrapper
:target "/wiki/login/"))
;;; Tests
(ert-deftest elnode-wiki-page ()
"Full stack Wiki test."
;; The dispatcher function
(lambda (httpcon)
(let ((elnode-wikiserver-wikiroot "/home/elnode/wiki"))
'(("[^/]*//wiki/\\(.*\\)" . elnode-wikiserver))))) t
(fakir-mock-file (fakir-file
:filename "test.creole"
:directory "/home/elnode/wiki"
:content "= Hello World =\nthis is a creole wiki file!\n")
(let* ((elnode--do-error-logging nil)
(elnode--do-access-logging-on-dispatch nil))
(elnode-test-call "/wiki/test.creole")
:status-code 200
:body-match ".*<h1>Hello World</h1>.*")))))
(provide 'elnode-wiki)
;;; elnode-wiki.el ends here
Jump to Line
Something went wrong with that request. Please try again.