1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;; Publishing HTML over HTTP (using httpd.el)
5 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8 (require 'muse-project
)
12 (defgroup muse-http nil
13 "Options controlling the behaviour of Emacs Muse over HTTP."
16 (defcustom muse-http-maintainer
(concat "webmaster@" (system-name))
17 "The maintainer address to use for the HTTP 'From' field."
21 (defcustom muse-http-publishing-style
"html"
22 "The style to use when publishing projects over http."
26 (defcustom muse-http-max-cache-size
64
27 "The number of pages to cache when serving over HTTP.
28 This only applies if set while running the persisted invocation
29 server. See main documentation for the `muse-http'
34 (defvar muse-buffer-mtime nil
)
35 (make-variable-buffer-local 'muse-buffer-mtime
)
37 (defun muse-sort-buffers (l r
)
38 (let ((l-mtime (with-current-buffer l muse-buffer-mtime
))
39 (r-mtime (with-current-buffer r muse-buffer-mtime
)))
41 ((and (null l-mtime
) (null r-mtime
)) l
)
44 (t (muse-time-less-p r-mtime l-mtime
)))))
46 (defun muse-winnow-list (entries &optional predicate
)
47 "Return only those ENTRIES for which PREDICATE returns non-nil."
48 (let ((flist (list t
))
50 (let ((entry entries
))
52 (if (funcall predicate
(car entry
))
53 (nconc flist
(list (car entry
))))
54 (setq entry
(cdr entry
))))
57 (defun muse-http-prune-cache ()
58 "If the page cache has become too large, prune it."
60 (sort (muse-winnow-list (buffer-list)
63 (with-current-buffer buf
66 (len (length buflist
)))
67 (while (> len muse-http-max-cache-size
)
68 (kill-buffer (car buflist
))
69 (setq len
(1- len
)))))
71 (defvar muse-http-serving-p nil
)
73 (defun muse-http-send-buffer (&optional modified code msg
)
74 "Markup and send the contents of the current buffer via HTTP."
75 (httpd-send (or code
200) (or msg
"OK")
76 "Server: muse.el/" muse-version httpd-endl
77 "Connection: close" httpd-endl
78 "MIME-Version: 1.0" httpd-endl
79 "Date: " (format-time-string "%a, %e %b %Y %T %Z")
81 "From: " muse-http-maintainer httpd-endl
)
83 (httpd-send-data "Last-Modified: "
84 (format-time-string "%a, %e %b %Y %T %Z" modified
)
86 (httpd-send-data "Content-Type: text/html; charset=iso-8859-1" httpd-endl
87 "Content-Length: " (number-to-string (1- (point-max)))
92 (defun muse-http-reject (title msg
&optional annotation
)
96 (insert annotation
"\n"))
97 (muse-publish-markup-buffer title muse-http-publishing-style
)
98 (muse-http-send-buffer nil
404 msg
)))
100 (defun muse-http-prepare-url (target)
102 (unless (or (string-match muse-url-regexp target
)
103 (string-match muse-image-regexp target
)
104 (string-match muse-file-regexp target
))
105 (setq target
(concat "page?" target
106 "&project=" muse-http-serving-p
))))
107 (muse-publish-read-only target
))
109 (defun muse-http-render-page (name)
110 "Render the Muse page identified by NAME.
111 When serving from a dedicated Emacs process (see the httpd-serve
112 script), a maximum of `muse-http-max-cache-size' pages will be
113 cached in memory to speed up serving time."
114 (let ((file (muse-project-page-file name muse-http-serving-p
))
115 (muse-publish-url-transforms
116 (cons 'muse-http-prepare-url muse-publish-url-transforms
))
117 (inhibit-read-only t
))
119 (with-current-buffer (get-buffer-create file
)
120 (let ((modified-time (nth 5 (file-attributes file
)))
121 (muse-publishing-current-file file
)
122 muse-publishing-current-style
)
123 (when (or (null muse-buffer-mtime
)
124 (muse-time-less-p muse-buffer-mtime modified-time
))
126 (setq muse-buffer-mtime modified-time
))
127 (goto-char (point-max))
129 (insert-file-contents file t
)
130 (let ((styles (cddr (muse-project muse-http-serving-p
)))
132 (while (and styles
(null style
))
133 (let ((include-regexp
134 (muse-style-element :include
(car styles
)))
136 (muse-style-element :exclude
(car styles
))))
137 (when (and (or (and (null include-regexp
)
138 (null exclude-regexp
))
140 (string-match include-regexp file
)
141 (not (string-match exclude-regexp file
))))
142 (not (muse-project-private-p file
)))
143 (setq style
(car styles
))
144 (while (muse-style-element :base style
)
146 (muse-style (muse-style-element :base style
))))
147 (if (string= (car style
) muse-http-publishing-style
)
148 (setq style
(car styles
))
150 (setq styles
(cdr styles
)))
151 (muse-publish-markup-buffer
152 name
(or style muse-http-publishing-style
))))
153 (set-buffer-modified-p nil
)
154 (muse-http-prune-cache)
155 (current-buffer))))))
157 (defun muse-http-transmit-page (name)
158 "Render the Muse page identified by NAME.
159 When serving from a dedicated Emacs process (see the httpd-serve
160 script), a maximum of `muse-http-max-cache-size' pages will be
161 cached in memory to speed up serving time."
162 (let ((inhibit-read-only t
)
163 (buffer (muse-http-render-page name
)))
165 (with-current-buffer buffer
166 (muse-http-send-buffer muse-buffer-mtime
)))))
168 (defvar httpd-vars nil
)
170 (defsubst httpd-var
(var)
171 "Return value of VAR as a URL variable. If VAR doesn't exist, nil."
172 (cdr (assoc var httpd-vars
)))
174 (defsubst httpd-var-p
(var)
175 "Return non-nil if VAR was passed as a URL variable."
176 (not (null (assoc var httpd-vars
))))
178 (defun muse-http-serve (page &optional content
)
179 "Serve the given PAGE from this press server."
180 ;; index.html is really a reference to the project home page
181 (if (and muse-project-alist
182 (string-match "\\`index.html?\\'" page
))
183 (setq page
(concat "page?"
184 (muse-get-keyword :default
185 (cadr (car muse-project-alist
))))))
186 ;; handle the actual request
187 (let ((vc-follow-symlinks t
)
188 (muse-publish-report-threshhold nil
)
192 ;; process any CGI variables, if cgi.el is available
193 (if (string-match "\\`\\([^&]+\\)&" page
)
194 (setq httpd-vars
(cgi-decode (substring page
(match-end 0)))
195 page
(match-string 1 page
)))
196 (unless (setq muse-http-serving-p
(httpd-var "project"))
197 (let ((project (car muse-project-alist
)))
198 (setq muse-http-serving-p
(car project
))
199 (setq httpd-vars
(cons (cons "project" (car project
))
201 (if (and muse-http-serving-p
202 (string-match "\\`page\\?\\(.+\\)" page
))
203 (muse-http-transmit-page (match-string 1 page
))))))
205 (if (featurep 'httpd
)
206 (httpd-add-handler "\\`\\(index\\.html?\\|page\\(\\?\\|\\'\\)\\)"
211 ;;; muse-http.el ends here