Add COPYING file; update headers.
[muse-el.git] / contrib / cgi.el
bloba516b756c39209b0536d99ab874f105bb3b00cfb
1 ;;; cgi.el -- using Emacs for CGI scripting
2 ;;;
3 ;;; Author: Eric Marsden <emarsden@laas.fr>
4 ;;; Keywords: CGI web scripting slow
5 ;;; Version: 0.2
6 ;;; Time-stamp: <2001-08-24 emarsden>
7 ;;; Copyright: (C) 2000 Eric Marsden
8 ;;
9 ;; This program is free software; you can redistribute it and/or
10 ;; modify it under the terms of the GNU General Public License as
11 ;; published by the Free Software Foundation; either version 2 of
12 ;; the License, or (at your option) any later version.
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ;; GNU General Public License for more details.
19 ;; You should have received a copy of the GNU General Public
20 ;; License along with this program; if not, write to the Free
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
22 ;; MA 02111-1307, USA.
25 ;;; Commentary:
27 ;; People who like this sort of thing will find this the sort of
28 ;; thing they like. -- Abraham Lincoln
31 ;; Overview ==========================================================
33 ;; A simple library for the Common Gateway Interface for Emacs,
34 ;; allowing you to service requests for non static web pages in elisp.
35 ;; Provides routines for decoding arguments to GET- and POST-type CGI
36 ;; requests.
38 ;; Usage: place a shell script such as the following in your web
39 ;; server's CGI directory (typically called something like
40 ;; /var/www/cgi-bin/):
42 ;; ,-------------------------------------------------------------------
43 ;; | #!/bin/sh
44 ;; |
45 ;; | emacs -batch -l cgi.el -f cgi-calendar
46 ;; `-------------------------------------------------------------------
48 ;; (`cgi-calendar' is a sample elisp CGI script provided at the end of
49 ;; this file).
51 ;; Alternatively, if you're running version 2.x of the linux kernel
52 ;; you could make .elc files directly executable via the binfmt_misc
53 ;; mechanism and run them straight from the cgi-bin directory.
55 ;; Efficiency would be improved by having Emacs bind to the http
56 ;; service port and spawn a thread per connection. Extending Emacs to
57 ;; support server sockets and multithreading is left as an exercise
58 ;; for the reader.
60 ;; References:
61 ;; * rfc1738 "Uniform Resource Locators"
62 ;; * rfc1630 "Universal Resource Identifiers in WWW"
64 ;; Thanks to Christoph Conrad <christoph.conrad@gmx.de> for pointing
65 ;; out a bug in the URI-decoding.
67 ;;; Code:
69 (require 'cl)
72 (defconst cgi-url-unreserved-chars '(
73 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
74 ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
75 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
76 ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
77 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
78 ?\$ ?\- ?\_ ?\. ?\! ?\~ ?\* ?\' ?\( ?\) ?\,))
80 (defun cgi-int-char (i)
81 (if (fboundp 'int-char) (int-char i) i))
83 (defun cgi-hex-char-p (ch)
84 (declare (character ch))
85 (let ((hexchars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
86 ?A ?B ?C ?D ?E ?F)))
87 (member (upcase ch) hexchars)))
89 ;; decode %xx to the corresponding character and + to ' '
90 (defun cgi-decode-string (str)
91 (do ((i 0)
92 (len (length str))
93 (decoded '()))
94 ((>= i len) (concat (nreverse decoded)))
95 (let ((ch (aref str i)))
96 (cond ((eq ?+ ch)
97 (push ?\ decoded)
98 (incf i))
99 ((and (eq ?% ch)
100 (< (+ i 2) len)
101 (cgi-hex-char-p (aref str (+ i 1)))
102 (cgi-hex-char-p (aref str (+ i 2))))
103 (let ((hex (string-to-number (substring str (+ i 1) (+ i 3)) 16)))
104 (push (cgi-int-char hex) decoded)
105 (incf i 3)))
106 (t (push ch decoded)
107 (incf i))))))
109 ;; Parse "foo=x&bar=y+re" into (("foo" . "x") ("bar" . "y re"))
110 ;; Substrings are plus-decoded and then URI-decoded.
111 (defun cgi-decode (q)
112 (when q
113 (flet ((split-= (str)
114 (let ((pos (or (position ?= str) 0)))
115 (cons (cgi-decode-string (subseq str 0 pos))
116 (cgi-decode-string (subseq str (+ pos 1)))))))
117 (mapcar #'split-= (split-string q "&")))))
119 (defun cgi-lose (fmt &rest args)
120 (let ((why (apply #'format fmt args)))
121 (message "Script error: %s" why) ; to error_log
122 (princ "Content-type: text/html\n\n") ; to browser
123 (princ "<html><head><title>Script error</title></head>\r\n")
124 (princ "<body><h1>Script error</h1>\r\n<p>\r\n")
125 (princ why)
126 (princ "\r\n</body></html>\r\n")
127 (kill-emacs 0)))
129 (defmacro cgi-evaluate (&rest forms)
130 `(condition-case why
131 (princ (with-output-to-string ,@forms))
132 (error (cgi-lose "Emacs Lisp error: %s" why))))
134 (defun cgi-arguments ()
135 (let ((method (getenv "REQUEST_METHOD"))
136 req buf)
137 (cond ((null method)
138 (cgi-lose "No request method specified"))
139 ((string= "GET" method)
140 (unless (getenv "QUERY_STRING")
141 (cgi-lose "No query string for GET request"))
142 (cgi-decode (getenv "QUERY_STRING")))
143 ((string= "POST" method)
144 (setq req (getenv "CONTENT_LENGTH"))
145 (unless req
146 (cgi-lose "No content-length for POST request"))
147 (setq buf (get-buffer-create " *cgi*"))
148 (set-buffer buf)
149 (erase-buffer)
150 (loop for i from 1 to (string-to-number req)
151 do (insert (read-event)))
152 (cgi-decode (buffer-string)))
154 (cgi-lose "Can't handle request method %s" method)))))
156 (provide 'cgi)
158 ;; cgi.el ends here