contrib/cgi.el

   1 ;;; cgi.el -- using Emacs for CGI scripting
   2 ;;;
   3 ;;; Author: Eric Marsden  <emarsden@laas.fr>
   4 ;;;         Michael Olson <mwolson@gnu.org> (slight modifications)
   5 ;;; Keywords: CGI web scripting slow
   6 ;;; Version: 0.3
   7 ;;; Time-stamp: <2001-08-24 emarsden>
   8 ;;; Copyright: (C) 2000  Eric Marsden
   9 ;;; Parts copyright (C) 2006 Free Software Foundation, Inc.
  10 ;;
  11 ;;     This program is free software; you can redistribute it and/or
  12 ;;     modify it under the terms of the GNU General Public License as
  13 ;;     published by the Free Software Foundation; either version 3 of
  14 ;;     the License, or (at your option) any later version.
  15 ;;
  16 ;;     This program is distributed in the hope that it will be useful,
  17 ;;     but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;;     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  19 ;;     GNU General Public License for more details.
  20 ;;
  21 ;;     You should have received a copy of the GNU General Public
  22 ;;     License along with this program; if not, write to the Free
  23 ;;     Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  24 ;;     MA 02111-1307, USA.
  25 ;;
  26 ;;
  27 ;;; Commentary:
  28 ;;
  29 ;; People who like this sort of thing will find this the sort of
  30 ;; thing they like.                           -- Abraham Lincoln
  31 ;;
  32 ;;
  33 ;; Overview ==========================================================
  34 ;;
  35 ;; A simple library for the Common Gateway Interface for Emacs,
  36 ;; allowing you to service requests for non static web pages in elisp.
  37 ;; Provides routines for decoding arguments to GET- and POST-type CGI
  38 ;; requests.
  39 ;;
  40 ;; Usage: place a shell script such as the following in your web
  41 ;; server's CGI directory (typically called something like
  42 ;; /var/www/cgi-bin/):
  43 ;;
  44 ;; ,-------------------------------------------------------------------
  45 ;; | #!/bin/sh
  46 ;; |
  47 ;; | emacs -batch -l cgi.el -f cgi-calendar
  48 ;; `-------------------------------------------------------------------
  49 ;;
  50 ;; (`cgi-calendar' is a sample elisp CGI script provided at the end of
  51 ;; this file).
  52 ;;
  53 ;; Alternatively, if you're running version 2.x of the linux kernel
  54 ;; you could make .elc files directly executable via the binfmt_misc
  55 ;; mechanism and run them straight from the cgi-bin directory.
  56 ;;
  57 ;; Efficiency would be improved by having Emacs bind to the http
  58 ;; service port and spawn a thread per connection. Extending Emacs to
  59 ;; support server sockets and multithreading is left as an exercise
  60 ;; for the reader.
  61 ;;
  62 ;; References:
  63 ;;   * rfc1738 "Uniform Resource Locators"
  64 ;;   * rfc1630 "Universal Resource Identifiers in WWW"
  65 ;;
  66 ;; Thanks to Christoph Conrad <christoph.conrad@gmx.de> for pointing
  67 ;; out a bug in the URI-decoding.
  68
  69 ;;; Code:
  70
  71 (eval-when-compile
  72   (require 'cl)
  73   (require 'calendar))
  74
  75 (defconst cgi-url-unreserved-chars '(
  76     ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
  77     ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
  78     ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
  79     ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
  80     ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
  81     ?\$ ?\- ?\_ ?\. ?\! ?\~ ?\* ?\' ?\( ?\) ?\,))
  82
  83 (defun cgi-int-char (i)
  84   (if (fboundp 'int-char) (int-char i) i))
  85
  86 (defun cgi-hex-char-p (ch)
  87   (declare (character ch))
  88   (let ((hexchars '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
  89                     ?A ?B ?C ?D ?E ?F)))
  90     (member (upcase ch) hexchars)))
  91
  92 ;; decode %xx to the corresponding character and + to ' '
  93 (defun cgi-decode-string (str)
  94   (do ((i 0)
  95        (len (length str))
  96        (decoded '()))
  97       ((>= i len) (concat (nreverse decoded)))
  98     (let ((ch (aref str i)))
  99       (cond ((eq ?+ ch)
 100              (push ?\  decoded)
 101              (incf i))
 102             ((and (eq ?% ch)
 103                   (< (+ i 2) len)
 104                   (cgi-hex-char-p (aref str (+ i 1)))
 105                   (cgi-hex-char-p (aref str (+ i 2))))
 106              (let ((hex (string-to-number (substring str (+ i 1) (+ i 3)) 16)))
 107                (push (cgi-int-char hex) decoded)
 108                (incf i 3)))
 109             (t (push ch decoded)
 110                (incf i))))))
 111
 112 (defun cgi-position (item seq &optional start end)
 113   (or start (setq start 0))
 114   (or end (setq end (length seq)))
 115   (while (and (< start end)
 116               (not (equal item (aref seq start))))
 117     (setq start (1+ start)))
 118   (and (< start end) start))
 119
 120 ;; Parse "foo=x&bar=y+re" into (("foo" . "x") ("bar" . "y re"))
 121 ;; Substrings are plus-decoded and then URI-decoded.
 122 (defun cgi-decode (q)
 123   (when q
 124     (flet ((split-= (str)
 125             (let ((pos (or (cgi-position ?= str) 0)))
 126               (cons (cgi-decode-string (substring str 0 pos))
 127                     (cgi-decode-string (substring str (+ pos 1)))))))
 128       (mapcar #'split-= (split-string q "&")))))
 129
 130 (defun cgi-lose (fmt &rest args)
 131   (let ((why (apply #'format fmt args)))
 132     (message "Script error: %s" why)    ; to error_log
 133     (princ "Content-type: text/html\n\n") ; to browser
 134     (princ "<html><head><title>Script error</title></head>\r\n")
 135     (princ "<body><h1>Script error</h1>\r\n<p>\r\n")
 136     (princ why)
 137     (princ "\r\n</body></html>\r\n")
 138     (kill-emacs 0)))
 139
 140 (defmacro cgi-evaluate (&rest forms)
 141   `(condition-case why
 142        (princ (with-output-to-string ,@forms))
 143      (error (cgi-lose "Emacs Lisp error: %s" why))))
 144
 145 (defun cgi-arguments ()
 146   (let ((method (getenv "REQUEST_METHOD"))
 147         req buf)
 148     (cond ((null method)
 149            (cgi-lose "No request method specified"))
 150           ((string= "GET" method)
 151            (unless (getenv "QUERY_STRING")
 152              (cgi-lose "No query string for GET request"))
 153            (cgi-decode (getenv "QUERY_STRING")))
 154           ((string= "POST" method)
 155            (setq req (getenv "CONTENT_LENGTH"))
 156            (unless req
 157              (cgi-lose "No content-length for POST request"))
 158            (setq buf (get-buffer-create " *cgi*"))
 159            (set-buffer buf)
 160            (erase-buffer)
 161            (loop for i from 1 to (string-to-number req)
 162                  do (insert (read-event)))
 163            (cgi-decode (buffer-string)))
 164           (t
 165            (cgi-lose "Can't handle request method %s" method)))))
 166
 167 ;; ====================================================================
 168 ;; a sample application: calendar via the web. If invoked without
 169 ;; arguments, presents a calendar for the three months around the
 170 ;; current date. You can request a calendar for a specific period by
 171 ;; specifying the year and the month in the query string:
 172 ;;
 173 ;;   ~$ lynx -dump 'http://localhost/cgi-bin/cal?year=1975&month=6'
 174 ;;
 175 ;; When run in batch mode, text normally displayed in the echo area
 176 ;; (via `princ' for example) goes to stdout, and thus to the browser.
 177 ;; Text output using `message' goes to stderr, and thus normally to
 178 ;; your web server's error_log.
 179 ;; ====================================================================
 180
 181 (eval-and-compile
 182   (if (fboundp 'calendar-extract-month)
 183       (defalias 'cgi-calendar-extract-month 'calendar-extract-month)
 184     (defalias 'cgi-calendar-extract-month 'extract-calendar-month))
 185
 186   (if (fboundp 'calendar-extract-year)
 187       (defalias 'cgi-calendar-extract-year 'calendar-extract-year)
 188     (defalias 'cgi-calendar-extract-year 'extract-calendar-year))
 189
 190   (if (fboundp 'calendar-generate)
 191       (defalias 'cgi-calendar-generate 'calendar-generate)
 192     (defalias 'cgi-calendar-generate 'generate-calendar)))
 193
 194 (defun cgi-calendar-string ()
 195   (require 'calendar)
 196   (let* ((args (cgi-arguments))
 197          (now (calendar-current-date))
 198          (mnth (cdr (assoc "month" args)))
 199          (month (if mnth (string-to-number mnth)
 200                   (cgi-calendar-extract-month now)))
 201          (yr (cdr (assoc "year" args)))
 202          (year (if yr (string-to-number yr)
 203                  (cgi-calendar-extract-year now))))
 204     (with-temp-buffer
 205       (cgi-calendar-generate month year)
 206       (buffer-string))))
 207
 208 (defun cgi-calendar ()
 209   (cgi-evaluate
 210    (princ "Content-type: text/html\n\n")
 211    (princ "<html><head><title>Emacs calendar</title></head>\r\n")
 212    (princ "<body> <h1>Emacs calendar</h1>\r\n")
 213    (princ "<pre>\r\n")
 214    (princ (cgi-calendar-string))
 215    (princ "\r\n</pre></body></html>\r\n")))
 216
 217 (provide 'cgi)
 218
 219 ;; cgi.el ends here