code.delx.au - gnu-emacs-elpa/blob - packages/muse/cgi.el

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