1 ;;; muse-http.el --- publish HTML files over HTTP
3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
4 ;; Free Software Foundation, Inc.
6 ;; This file is part of Emacs Muse. It is not part of GNU Emacs.
8 ;; Emacs Muse is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published
10 ;; by the Free Software Foundation; either version 3, or (at your
11 ;; option) any later version.
13 ;; Emacs Muse is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 ;; General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with Emacs Muse; see the file COPYING. If not, write to the
20 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
21 ;; Boston, MA 02110-1301, USA.
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 ;; Publishing HTML over HTTP (using httpd.el)
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 (require 'muse-project)
40 (defgroup muse-http nil
41 "Options controlling the behavior of Emacs Muse over HTTP."
44 (defcustom muse-http-maintainer (concat "webmaster@" (system-name))
45 "The maintainer address to use for the HTTP 'From' field."
49 (defcustom muse-http-publishing-style "html"
50 "The style to use when publishing projects over http."
54 (defcustom muse-http-max-cache-size 64
55 "The number of pages to cache when serving over HTTP.
56 This only applies if set while running the persisted invocation
57 server. See main documentation for the `muse-http'
62 (defvar muse-buffer-mtime nil)
63 (make-variable-buffer-local 'muse-buffer-mtime)
65 (defun muse-sort-buffers (l r)
66 (let ((l-mtime (with-current-buffer l muse-buffer-mtime))
67 (r-mtime (with-current-buffer r muse-buffer-mtime)))
69 ((and (null l-mtime) (null r-mtime)) l)
72 (t (muse-time-less-p r-mtime l-mtime)))))
74 (defun muse-winnow-list (entries &optional predicate)
75 "Return only those ENTRIES for which PREDICATE returns non-nil."
76 (let ((flist (list t)))
77 (let ((entry entries))
79 (if (funcall predicate (car entry))
80 (nconc flist (list (car entry))))
81 (setq entry (cdr entry))))
84 (defun muse-http-prune-cache ()
85 "If the page cache has become too large, prune it."
87 (sort (muse-winnow-list (buffer-list)
90 (with-current-buffer buf
93 (len (length buflist)))
94 (while (> len muse-http-max-cache-size)
95 (kill-buffer (car buflist))
96 (setq len (1- len)))))
98 (defvar muse-http-serving-p nil)
100 (defun muse-http-send-buffer (&optional modified code msg)
101 "Markup and send the contents of the current buffer via HTTP."
102 (httpd-send (or code 200) (or msg "OK")
103 "Server: muse.el/" muse-version httpd-endl
104 "Connection: close" httpd-endl
105 "MIME-Version: 1.0" httpd-endl
106 "Date: " (format-time-string "%a, %e %b %Y %T %Z")
108 "From: " muse-http-maintainer httpd-endl)
110 (httpd-send-data "Last-Modified: "
111 (format-time-string "%a, %e %b %Y %T %Z" modified)
113 (httpd-send-data "Content-Type: text/html; charset=iso-8859-1" httpd-endl
114 "Content-Length: " (number-to-string (1- (point-max)))
115 httpd-endl httpd-endl
119 (defun muse-http-reject (title msg &optional annotation)
120 (muse-with-temp-buffer
123 (insert annotation "\n"))
124 (muse-publish-markup-buffer title muse-http-publishing-style)
125 (muse-http-send-buffer nil 404 msg)))
127 (defun muse-http-prepare-url (target explicit)
129 (unless (or (not explicit)
130 (string-match muse-url-regexp target)
131 (string-match muse-image-regexp target)
132 (string-match muse-file-regexp target))
133 (setq target (concat "page?" target
134 "&project=" muse-http-serving-p))))
135 (muse-publish-read-only target))
137 (defun muse-http-render-page (name)
138 "Render the Muse page identified by NAME.
139 When serving from a dedicated Emacs process (see the httpd-serve
140 script), a maximum of `muse-http-max-cache-size' pages will be
141 cached in memory to speed up serving time."
142 (let ((file (muse-project-page-file name muse-http-serving-p))
143 (muse-publish-url-transforms
144 (cons 'muse-http-prepare-url muse-publish-url-transforms))
145 (inhibit-read-only t))
147 (with-current-buffer (get-buffer-create file)
148 (let ((modified-time (nth 5 (file-attributes file)))
149 (muse-publishing-current-file file)
150 muse-publishing-current-style)
151 (when (or (null muse-buffer-mtime)
152 (muse-time-less-p muse-buffer-mtime modified-time))
154 (setq muse-buffer-mtime modified-time))
155 (goto-char (point-max))
157 (muse-insert-file-contents file t)
158 (let ((styles (cddr (muse-project muse-http-serving-p)))
160 (while (and styles (null style))
161 (let ((include-regexp
162 (muse-style-element :include (car styles)))
164 (muse-style-element :exclude (car styles))))
165 (when (and (or (and (null include-regexp)
166 (null exclude-regexp))
168 (string-match include-regexp file)
169 (not (string-match exclude-regexp file))))
170 (not (muse-project-private-p file)))
171 (setq style (car styles))
172 (while (muse-style-element :base style)
174 (muse-style (muse-style-element :base style))))
175 (if (string= (car style) muse-http-publishing-style)
176 (setq style (car styles))
178 (setq styles (cdr styles)))
179 (muse-publish-markup-buffer
180 name (or style muse-http-publishing-style))))
181 (set-buffer-modified-p nil)
182 (muse-http-prune-cache)
183 (current-buffer))))))
185 (defun muse-http-transmit-page (name)
186 "Render the Muse page identified by NAME.
187 When serving from a dedicated Emacs process (see the httpd-serve
188 script), a maximum of `muse-http-max-cache-size' pages will be
189 cached in memory to speed up serving time."
190 (let ((inhibit-read-only t)
191 (buffer (muse-http-render-page name)))
193 (with-current-buffer buffer
194 (muse-http-send-buffer muse-buffer-mtime)))))
196 (defvar httpd-vars nil)
198 (defsubst httpd-var (var)
199 "Return value of VAR as a URL variable. If VAR doesn't exist, nil."
200 (cdr (assoc var httpd-vars)))
202 (defsubst httpd-var-p (var)
203 "Return non-nil if VAR was passed as a URL variable."
204 (not (null (assoc var httpd-vars))))
206 (defun muse-http-serve (page &optional content)
207 "Serve the given PAGE from this press server."
208 ;; index.html is really a reference to the project home page
209 (if (and muse-project-alist
210 (string-match "\\`index.html?\\'" page))
211 (setq page (concat "page?"
212 (muse-get-keyword :default
213 (cadr (car muse-project-alist))))))
214 ;; handle the actual request
215 (let ((vc-follow-symlinks t)
216 (muse-publish-report-threshhold nil)
220 ;; process any CGI variables, if cgi.el is available
221 (if (string-match "\\`\\([^&]+\\)&" page)
222 (setq httpd-vars (cgi-decode (substring page (match-end 0)))
223 page (match-string 1 page)))
224 (unless (setq muse-http-serving-p (httpd-var "project"))
225 (let ((project (car muse-project-alist)))
226 (setq muse-http-serving-p (car project))
227 (setq httpd-vars (cons (cons "project" (car project))
229 (if (and muse-http-serving-p
230 (string-match "\\`page\\?\\(.+\\)" page))
231 (muse-http-transmit-page (match-string 1 page))))))
233 (if (featurep 'httpd)
234 (httpd-add-handler "\\`\\(index\\.html?\\|page\\(\\?\\|\\'\\)\\)"
239 ;;; muse-http.el ends here