sekka 0.8.0

data/emacs/http-get.el

@@ -0,0 +1,448 @@
+;;; http-get.el --- simple HTTP GET
+
+;; Copyright (C) 2002, 2003 Alex Schroeder
+
+;; Author: Alex Schroeder <alex@gnu.org>
+;;         Pierre Gaston <pierre@gaston-karlaouzou.com>
+;;         David Hansen <david.hansen@physik.fu-berlin.de>
+;; Maintainer: David Hansen <david.hansen@physik.fu-berlin.de>
+;; Version: 1.0.15
+;; Keywords: hypermedia
+;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?HttpGet
+
+;; This file is not part of GNU Emacs.
+
+;; This is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; This is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+
+;;; Commentary:
+
+;; Use `http-get' to download an URL.
+
+;;; Change log:
+
+;; 1.0.15
+;;   - made `http-parse-headers' RFC 2616 compatible (removing whitespaces,
+;;     headers may spawn several line)
+;;   - log message headers
+;;   - made most variables buffer local with `make-variable-buffer-local'
+;; 1.0.14
+;;   - Removed attempt to fix bug in 1.0.12, not needed anymore since 1.0.13.
+;; 1.0.13
+;;   - The string is now not anymore decoded in the http-filter.
+;;     You have to run `http-decode' yourself.
+;; 1.0.12
+;;   - Hopefully fixed the bug with inserting "half" multi byte chars.
+;; 1.0.11
+;;   - Added (setq string (string-make-unibyte string)) to http-filter
+;;     this seems to solve problems with multi byte chars.
+;;   - Fixed bug when building the headers.
+;;   - Fixed indentation (please guys, read the coding conventions in the
+;;     elisp manual)
+;;   - Replaced string-bytes with length (string-bytes shouldn't be needed
+;;     anymore as we force the string to be unibyte)
+;; 1.0.10
+;;   - Fix some codings problems again.
+;; 1.0.9
+;;   - Added better coding support.
+;; 1.0.8
+;;   - Rewrote the parser.
+;;   - Correction to the http 1.0 usage.
+;; 1.0.3
+;;   - Move http-url-encode from http-post.el to http-get.el.
+;;   - Add a param to http-get to specify the encoding of the params in the url.
+
+;;; Code:
+
+(require 'hexl)
+(require 'http-cookies)
+
+(defvar http-get-version "1.0.15")
+
+;; Proxy
+(defvar http-proxy-host nil
+  "*If nil dont use proxy, else name of proxy server.")
+
+(defvar http-proxy-port nil
+  "*Port number of proxy server.  Default is 80.")
+
+(defvar http-coding 'iso-8859-1
+   "Default coding to be use when the string is inserted in the buffer.
+This coding will be modified on Finding the content-type header")
+(make-variable-buffer-local 'http-coding)
+
+(defvar  http-filter-pre-insert-hook '(http-parser)
+  "Hook run by the `http-filter'.
+This is called whenever a chunk of input arrives, before it is
+inserted into the buffer.  If you want to modify the string that gets
+inserted, modify the variable `string' which is dynamically bound to
+what will get inserted in the end.  The string will be inserted at
+the `process-mark', which you can get by calling \(process-mark proc).
+`proc' is dynamically bound to the process, and the current buffer
+is the very buffer where the string will be inserted.")
+
+(defvar http-filter-post-insert-hook  nil
+  "Hook run by the `http-filter'.
+This is called whenever a chunk of input arrives, after it has been
+inserted, but before the `process-mark' has moved.  Therefore, the new
+text lies between the `process-mark' and point.  You can get the values
+of the `process-mark' by calling (process-mark proc).  Please take care
+to leave point at the right place, eg.  by wrapping your code in a
+`save-excursion'.")
+
+(defun http-filter (proc string)
+  "Filter function for HTTP buffers.
+See `http-filter-pre-insert-hook' and `http-filter-post-insert-hook'
+for places where you can do your own stuff such as HTML rendering.
+Argument PROC is the process that is filtered.
+Argument STRING is the string outputted by the process."
+  ;; emacs seems to screw this sometimes
+  (when (fboundp 'string-make-unibyte)
+    (setq string (string-make-unibyte string)))
+  (with-current-buffer (process-buffer proc)
+    (let ((moving (= (point) (process-mark proc))))
+      (save-excursion
+	" Insert the text, advancing the process marker."
+	(goto-char (process-mark proc))
+	(run-hooks 'http-filter-pre-insert-hook)
+        ;; Note: the string is inserted binary in a unibyte buffer
+        (insert string)
+	(run-hooks 'http-filter-post-insert-hook)
+	(set-marker (process-mark proc) (point)))
+      (if moving (goto-char (process-mark proc))))))
+
+(defvar http-status-code nil
+  "The status code returned for the current buffer.
+This is set by the function `http-headers'.")
+(make-variable-buffer-local 'http-status-code)
+
+(defvar http-reason-phrase nil
+  "The reason phrase returned for the `http-status-code'.
+This is set by the function `http-headers'.")
+(make-variable-buffer-local 'http-reason-phrase)
+
+(defvar http-headers nil
+  "An alist of the headers that have been parsed and removed from the buffer.
+The headers are stored as an alist.
+This is set by the function `http-headers'.")
+(make-variable-buffer-local 'http-headers)
+
+(defvar http-parser-state 'status-line
+  "Parser status.")
+(make-variable-buffer-local 'http-parser-state)
+
+(defvar http-unchunk-chunk-size  0
+  "Size of the current unfinished chunk.")
+(make-variable-buffer-local 'http-unchunk-chunk-size)
+
+(defvar http-not-yet-parsed  ""
+  "Received bytes that have not yet been parsed.")
+(make-variable-buffer-local 'http-not-yet-parsed)
+
+(defvar http-host ""
+  "The host to which we have sent the request.")
+(make-variable-buffer-local 'http-host)
+
+(defvar http-url ""
+  "The requested URL.")
+(make-variable-buffer-local 'http-url)
+
+(defun http-parser ()
+  "Simple parser for http message.
+Parse the status line, headers and chunk."
+  (let ((parsed-string (concat http-not-yet-parsed string)) content-type)
+    (setq string "")
+    (setq http-not-yet-parsed "")
+    (while (> (length parsed-string) 0)
+      (cond
+
+       ((eq http-parser-state 'status-line)
+	;; parsing status line
+	(if (string-match "HTTP/[0-9.]+ \\([0-9]+\\) \\(.*\\)\r\n"
+                          parsed-string)
+	    (progn
+              (setq http-status-code
+                    (string-to-number (match-string 1 parsed-string)))
+              (setq http-reason-phrase (match-string 2 parsed-string))
+              (setq http-parser-state 'header)
+              (setq parsed-string (substring parsed-string (match-end 0))))
+	  ;; status line not found
+          (setq http-not-yet-parsed parsed-string)
+          (setq parsed-string "")))
+
+       ((eq http-parser-state 'header)
+	;; parsing headers
+	(if (string-match "\r\n\r\n" parsed-string)
+	    (let ((end-headers (match-end 0)))
+	      (setq http-headers
+                    (http-parse-headers
+                     (substring parsed-string 0 (match-beginning 0))))
+	      (if (string= "chunked"
+			   (cdr (assoc "transfer-encoding" http-headers)))
+		  (setq http-parser-state 'chunked)
+		(setq http-parser-state 'dump))
+	      (when (and
+		     (setq content-type
+			   (cdr (assoc "content-type" http-headers)))
+		     (string-match "charset=\\(.*\\)" content-type))
+		(setq http-coding
+                      (intern-soft (downcase (match-string 1 content-type)))))
+	      (setq parsed-string (substring parsed-string end-headers))
+              ;; set cookies
+              (when http-emacs-use-cookies
+                  (http-cookies-set http-url http-headers)))
+	  ;; we don't have all the headers yet
+	  (setq http-not-yet-parsed parsed-string)
+	  (setq parsed-string "")))
+
+       ((eq http-parser-state 'chunked)
+	;; parsing chunked content
+        (if (> (length parsed-string) http-unchunk-chunk-size)
+	    (progn
+	      (setq string (concat string
+                                   (substring parsed-string 0
+                                              http-unchunk-chunk-size)))
+	      (setq parsed-string
+                    (substring parsed-string http-unchunk-chunk-size))
+	      (setq http-unchunk-chunk-size 0)
+
+	      (if (string-match  "\\([0-9a-f]+\\)[^\r^\b]*\\(\r\n\\)"
+                                 parsed-string)
+		  (if (> (setq http-unchunk-chunk-size
+                               (hexl-hex-string-to-integer
+                                (match-string 1 parsed-string)))
+			 0)
+		      (setq parsed-string
+                            (substring parsed-string (match-end 2)))
+		    ;; chunk 0 found we just burry it
+		    (setq parsed-string "")
+		    (setq http-parser-state 'trailer))
+                ;; we don't have the next chunk-size yet
+		(setq http-not-yet-parsed parsed-string)
+		(setq parsed-string "")))
+	  ;; the current chunk is not finished yet
+	  (setq string  (concat string parsed-string))
+	  (setq http-unchunk-chunk-size
+                (- http-unchunk-chunk-size (length parsed-string)))
+          (setq parsed-string "")))
+
+       ((eq http-parser-state 'trailer)
+        ;; parsing trailer
+        (setq  parsed-string ""))
+
+       ((eq http-parser-state 'dump)
+	 (setq  string parsed-string)
+	 (setq  parsed-string ""))))))
+
+
+(defun http-parse-headers (header-string)
+  "Parse the header string.
+Argument HEADER-STRING A string containing a header list."
+  ;; headers may spawn several line if the nth, n>1, line starts with
+  ;; at least one whitespace
+  (setq header-string (replace-regexp-in-string "\r\n[ \t]+" " "
+                                                header-string))
+  (let ((lines-list (split-string header-string "\r\n")))
+    (mapcar (lambda (line)
+	      (if (string-match ":[ \t]+\\(.*?\\)[ \t]*$" line)
+                    (cons (downcase (substring line 0 (match-beginning 0)))
+                          (match-string 1 line))
+		line))
+            lines-list)))
+
+
+;; URL encoding for parameters
+(defun http-url-encode (str content-type)
+  "URL encode STR using CONTENT-TYPE as the coding system."
+  (apply 'concat
+	 (mapcar (lambda (c)
+		   (if (or (and (>= c ?a) (<= c ?z))
+			   (and (>= c ?A) (<= c ?Z))
+			   (and (>= c ?0) (<= c ?9)))
+		       (string c)
+		     (format "%%%02x" c)))
+		 (encode-coding-string str content-type))))
+
+
+(defun http-decode-buffer ()
+  "Decode buffer according to the buffer local variable `http-coding'."
+  (when (and
+	 (fboundp 'set-buffer-multibyte)
+	 (fboundp 'multibyte-string-p))
+    (when (multibyte-string-p (decode-coding-string "test" http-coding))
+      (set-buffer-multibyte t)))
+  (decode-coding-region (point-min) (point-max) http-coding))
+
+;; Debugging
+(defvar http-log-function 'ignore
+  "Function to call for log messages.")
+
+(defun http-log (str)
+  "Log STR using `http-log-function'.
+The default value just ignores STR."
+  (funcall http-log-function str))
+
+
+(defun http-get-debug (url &optional headers version)
+  "Debug the call to `http-get'."
+  (interactive "sURL: ")
+  (let* ((http-log-function (lambda (str)
+			      (save-excursion
+				;; dynamic binding -- buf from http-get is used
+				(set-buffer buf)
+				(insert str))))
+	 proc)
+    (when (get-buffer "*Debug HTTP-GET*")
+      (kill-buffer "*Debug HTTP-GET*"))
+    (setq proc (http-get url headers nil version))
+    (set (make-local-variable 'http-filter-pre-insert-hook) nil)
+    (set (make-local-variable 'http-filter-post-insert-hook) nil)
+    (rename-buffer "*Debug HTTP-GET*")))
+
+
+;; The main function
+
+;;;###autoload
+(defun http-get (url &optional headers sentinel version bufname content-type)
+  "Get URL in a buffer, and return the process.
+You can get the buffer associated with this process using
+`process-buffer'.
+
+The optional HEADERS are an alist where each element has the form
+\(NAME . VALUE).  Both must be strings and will be passed along with
+the request.
+
+With optional argument SENTINEL, the buffer is not shown.  It is the
+responsibility of the sentinel to show it, if appropriate.  A sentinel
+function takes two arguments, process and message.  It is called when
+the process is killed, for example.  This is useful when specifying a
+non-persistent connection.  By default, connections are persistent.
+Add \(\"Connection\" . \"close\") to HEADERS in order to specify a
+non-persistent connection.  Usually you do not need to specify a
+sentinel, and `ignore' is used instead, to prevent a message being
+printed when the connection is closed.
+
+If you want to filter the content as it arrives, bind
+`http-filter-pre-insert-hook' and `http-filter-post-insert-hook'.
+
+The optional argument VERSION specifies the HTTP version to use.  It
+defaults to version 1.0, such that the connection is automatically
+closed when the entire document has been downloaded.  This will then
+call SENTINEL, if provided.  If no sentinel is provided, `ignore' will
+be used in order to prevent a message in the buffer when the process
+is killed.
+
+CONTENT-TYPE is a coding system to use for the encoding of the url
+param value.  Its upper case print name will be used for the server.
+Possible values are `iso-8859-1' or `euc-jp' and others.
+
+The coding system of the process is set to `binary', because we need to
+distinguish between \\r and \\n.  To correctly decode the text later,
+use `decode-coding-region' and get the coding system to use from
+`http-headers'."
+  (interactive "sURL: ")
+  (setq version (or version 1.0))
+  (let* (host dir file port proc buf command start-line (message-headers "") )
+    (unless (string-match
+	     "http://\\([^/:]+\\)\\(:\\([0-9]+\\)\\)?/\\(.*/\\)?\\([^:]*\\)"
+             url)
+      (error "Cannot parse URL %s." url))
+    (unless bufname
+      (setq bufname (format "*HTTP GET %s *" url)))
+
+    (setq host (match-string 1 url)
+	  port (or (and (setq port (match-string 3 url))
+                        (string-to-int port)) 80)
+	  dir (or (match-string 4 url) "")
+	  file (or (match-string 5 url) "")
+	  buf (get-buffer-create bufname)
+	  proc (open-network-stream
+                (concat "HTTP GET " url) buf
+                (if http-proxy-host http-proxy-host host)
+                (if http-proxy-port http-proxy-port port) ))
+    (if sentinel
+	(set-buffer buf)
+      (switch-to-buffer buf))
+    (erase-buffer)
+    (kill-all-local-variables)
+    (with-current-buffer buf
+      (setq http-host host)
+      (setq http-url url))
+    (if content-type
+	(setq file
+	      (replace-regexp-in-string
+	       "=[^&]+"
+	       (lambda (param)
+		 (concat "="
+			 (http-url-encode (substring param 1) content-type)))
+	       file)))
+    (setq start-line
+	  (concat (format "GET %s%s%s HTTP/%.1f\r\n"
+                          (if http-proxy-host
+                              (concat "http://" host "/") "/") dir file version)
+		  (format "Host: %s\r\n" host)))
+    (when http-emacs-use-cookies
+      (let ((cookie (http-cookies-build-header url)))
+        (when cookie (add-to-list 'headers cookie))))
+    (when headers
+      (setq message-headers (mapconcat (lambda (pair)
+					 (concat (car pair) ": " (cdr pair)))
+				       headers
+				       "\r\n")))
+    ;; mapconcat doesn't append the \r\n for the final line
+    (setq command (format "%s%s\r\n\r\n" start-line message-headers))
+    (http-log (format "Connecting to %s %d\nCommand:\n%s\n" host port command))
+    (http-log message-headers)
+    (set-process-sentinel proc (or sentinel 'ignore))
+    (set-process-coding-system proc 'binary 'binary) ; we need \r\n
+    ;; we need this to be able to correctly decode the buffer with
+    ;; decode-coding-region later
+    (when (fboundp 'set-buffer-multibyte)
+      (with-current-buffer buf (set-buffer-multibyte nil)))
+    (set-process-filter proc 'http-filter)
+    (set-marker (process-mark proc) (point-max))
+    (process-send-string proc command)
+
+    proc))
+
+
+;; needed for xemacs.  c&p from gnu emacs cvs sources
+(unless (fboundp 'replace-regexp-in-string)
+  (defun replace-regexp-in-string (regexp rep string &optional
+                                          fixedcase literal subexp start)
+    (let ((l (length string))
+          (start (or start 0))
+          matches str mb me)
+      (save-match-data
+        (while (and (< start l) (string-match regexp string start))
+          (setq mb (match-beginning 0)
+                me (match-end 0))
+          (when (= me mb) (setq me (min l (1+ mb))))
+          (string-match regexp (setq str (substring string mb me)))
+          (setq matches
+                (cons (replace-match (if (stringp rep)
+                                         rep
+                                       (funcall rep (match-string 0 str)))
+                                     fixedcase literal str subexp)
+                      (cons (substring string start mb)
+                            matches)))
+          (setq start me))
+        (setq matches (cons (substring string start l) matches))
+        (apply #'concat (nreverse matches))))))
+
+(provide 'http-get)
+
+;;; http-get.el ends here