emacs/external/ljupdate/http-post.el

   1 ;;; http-post.el --- simple HTTP POST
   2
   3 ;; Copyright (C) 2002, 2003  Alex Schroeder
   4
   5 ;; Author: Alex Schroeder <alex@gnu.org>
   6 ;; Maintainer: David Hansen <david.hansen@physik.fu-berlin.de>
   7 ;; Version: 1.0.5
   8 ;; Keywords: hypermedia
   9 ;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?HttpPost
  10
  11 ;; This file is not part of GNU Emacs.
  12
  13 ;; This is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Use `http-post' to post to a URL.
  31
  32 ;;; Change Log:
  33
  34 ;; 1.0.5
  35 ;;   - Added experimental cookies support.
  36 ;; 1.0.4
  37 ;;   - Fixed bug in `http-post' that ignored the headers argument.
  38 ;; 1.0.3
  39 ;;   - Minor fix.
  40 ;; 1.0.1
  41 ;;   - Moved http-url-encode to http-get.
  42
  43 ;;; Code:
  44
  45 (require 'http-get)
  46 (require 'http-cookies)
  47
  48 (defvar http-post-version "1.0.5")
  49
  50
  51 ;; The main function
  52
  53 (defun http-post (url parameters content-type &optional headers sentinel
  54                       version verbose bufname)
  55   "Post to a URL in a buffer using HTTP 1.1, and return the process.
  56 You can get the buffer associated with this process using
  57 `process-buffer'.
  58
  59
  60
  61 PARAMETERS is an alist of parameters to use.  Each element has the
  62 form \(NAME . VALUE).  These usually correspond to successful controls
  63 on HTML forms.
  64
  65 CONTENT-TYPE is a coding system to use.  Its upper case print name
  66 will be used for the server.  Possible values are `iso-8859-1' or
  67 `euc-jp' and others.
  68
  69 The optional HEADERS are an alist where each element has the form
  70 \(NAME . VALUE).  Both must be strings and will be passed along with
  71 the request.  The reason CONTENT-TYPE is not just passed along as one
  72 of the headers is that part of the Content-Type value is fixed and
  73 cannot be changed: The basic encoding is implemented using
  74 `html-url-encode' and is called application/x-www-form-urlencoded.
  75
  76 With optional argument SENTINEL, the buffer is not shown.  It is the
  77 responsibility of the sentinel to show it, if appropriate.  A sentinel
  78 function takes two arguments, process and message.  It is called when
  79 the process is killed, for example.  This is useful when specifying a
  80 non-persistent connection.  By default, connections are persistent.
  81 Add \(\"Connection\" . \"close\") to HEADERS in order to specify a
  82 non-persistent connection.  Usually you do not need to specify a
  83 sentinel, and `ignore' is used instead, to prevent a message being
  84 printed when the connection is closed.
  85
  86 If you want to filter the content as it arrives, bind
  87 `http-filter-pre-insert-hook' and `http-filter-post-insert-hook'.
  88
  89 The optional argument VERSION specifies the HTTP version to use.  It
  90 defaults to version 1.0, such that the connection is automatically
  91 closed when the entire document has been downloaded.
  92
  93 If the optional argument VERBOSE is non-nil, a message will show the
  94 command sent to the server.
  95
  96 The coding system of the process is set to `binary', because we need to
  97 distinguish between \\r and \\n.  To correctly decode the text later,
  98 use `decode-coding-region' and get the coding system to use from
  99 `http-headers'."
 100   (interactive)
 101   (setq version (or version 1.0))
 102   (let* (host dir file port proc buf header body content-length)
 103     (unless (string-match
 104              "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)"
 105              url)
 106       (error "Cannot parse URL %s" url))
 107     (unless bufname (setq bufname
 108                           (format "*HTTP POST %s *" url)))
 109     (setq host (match-string 1 url)
 110           port (or (and (setq port (match-string 3 url))
 111                         (string-to-int port)) 80)
 112           dir  (or (match-string 4 url) "")
 113           file (or (match-string 5 url) "")
 114           buf (get-buffer-create bufname)
 115           proc (open-network-stream
 116                 (concat "HTTP POST " url)
 117                 buf (if http-proxy-host http-proxy-host host)
 118                 (if http-proxy-port http-proxy-port port)))
 119     (set-process-sentinel proc (or sentinel 'ignore))
 120     (set-process-coding-system proc 'binary 'binary) ; we need \r\n
 121     (set-process-filter proc 'http-filter)
 122     (set-marker (process-mark proc) (point-min) buf)
 123     (if sentinel
 124         (set-buffer buf)
 125       (switch-to-buffer buf))
 126     (erase-buffer)
 127     (kill-all-local-variables)
 128
 129     (with-current-buffer buf
 130       (setq http-host host)
 131       (setq http-url url))
 132
 133     (let (result)
 134       (dolist (param parameters)
 135         (setq result (cons (concat (car param) "="
 136                                    (http-url-encode (cdr param)
 137                                                     content-type))
 138                            result)))
 139       (setq body (mapconcat 'identity result "&")))
 140
 141     (setq header
 142           (concat (format "POST %s%s%s HTTP/%.1f\r\n"
 143                           (if http-proxy-host
 144                               (concat "http://" host "/")
 145                             "/") dir file version)
 146                   (format "Host: %s\r\n" host)
 147                   "Content-Type: application/x-www-form-urlencoded"
 148                   (format "; charset=%s\r\n"
 149                           (upcase (symbol-name content-type)))
 150                   (format "Content-Length: %d\r\n" (length body))))
 151
 152     (when http-emacs-use-cookies
 153       (let ((cookie (http-cookies-build-header url)))
 154         (when cookie (add-to-list 'headers cookie))))
 155     (if headers
 156         (setq header (concat header
 157                              (mapconcat (lambda (pair)
 158                                           (concat (car pair) ": " (cdr pair)))
 159                                         headers
 160                                         "\r\n")
 161                              "\r\n\r\n"))
 162       (setq header (concat header "\r\n")))
 163     (when verbose
 164       ;;(when t
 165       (message "%s" (concat header body "\n\n")))
 166     (process-send-string proc (concat header body "\r\n"))
 167     proc))
 168
 169
 170 (provide 'http-post)
 171
 172 ;;; http-post.el ends here