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, 2014 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     (let ((split-=
 124            (lambda (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 ;;; cgi.el ends here