[elpa] externals/url-scgi 2d43fa147c 02/48: Add url-scgi.el: SCGI Uniform Resource Locator retrieval code

[ELPA Syncer]

branch: externals/url-scgi
commit 2d43fa147c22c6b4c83f21ce1471f56858fe6558
Author: Stefan Kangas <skangas@skangas.se>
Commit: Stefan Kangas <skangas@skangas.se>

    Add url-scgi.el: SCGI Uniform Resource Locator retrieval code
---
 url-scgi.el | 184 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 184 insertions(+)

diff --git a/url-scgi.el b/url-scgi.el
new file mode 100644
index 0000000000..4d1c45d6fc
--- /dev/null
+++ b/url-scgi.el
@@ -0,0 +1,184 @@
+;;; url-scgi.el --- SCGI Uniform Resource Locator retrieval code
+
+;; Copyright (C) 2011 Stefan Kangas.
+
+;; Author: Stefan Kangas
+;; Version: 0.1
+;; Keywords: comm, data, processes, scgi
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; The SCGI specification document can be found at:
+;;
+;; http://python.ca/scgi/protocol.txt
+
+;;; Change Log:
+
+;; 0.1 First public version
+
+;;; Code:
+
+(eval-when-compile (require 'cl))
+
+(defvar url-scgi-content-length)
+(defvar url-scgi-content-type)
+(defvar url-scgi-connection-opened)
+
+(defconst url-scgi-asynchronous-p t "SCGI retrievals are asynchronous.")
+
+(defun scgi-string-to-netstring (str)
+  "Converts a string into a netstring as defined by the SCGI
+specification."
+  (let ((len (length str)))
+    (concat (number-to-string len)
+            ":" str ",")))
+
+(defun scgi-add-null-bytes (&rest args)
+  (apply 'concat (mapcar (lambda (a) (concat a "\000")) args)))
+
+(defmacro scgi-parse-request-header (name desc conv)
+  `(let ((,name (plist-get headers ,(intern
+                                     (concat ":" (symbol-name name))))))
+     (when name
+      (scgi-add-null-bytes ,desc
+                           ,(if conv
+                                (list conv name)
+                              name)))))
+
+(defun scgi-make-request-header (headers)
+  (concat
+   (scgi-parse-request-header length "CONTENT_LENGTH" number-to-string)
+   (scgi-add-null-bytes "SCGI" "1")))
+
+(defun url-scgi-create-request ()
+  (declare (special url-request-data))
+  (concat
+   (scgi-string-to-netstring
+    (scgi-make-request-header `(:length ,(length url-request-data))))
+   url-request-data))
+
+(defun url-scgi-activate-callback ()
+  "Activate callback specified when this buffer was created."
+  (declare (special url-callback-function
+                   url-callback-arguments))
+  (apply url-callback-function url-callback-arguments))
+
+(defun url-scgi-parse-headers ()
+  (declare (special url-scgi-content-length
+                    url-scgi-content-type))
+  (save-restriction
+    (save-match-data
+      (mail-narrow-to-head)
+      (goto-char (point-min))
+      (while (re-search-forward "\r$" nil t)
+        (replace-match ""))
+      (let ((status (mail-fetch-field "status"))
+            (content-length (mail-fetch-field "content-length"))
+            (content-type (mail-fetch-field "content-type")))
+        (when content-length
+          (setq url-scgi-content-length content-length))
+        (when content-type
+          (setq url-scgi-content-length content-type))
+        (when (and status (not (equal status "200 OK")))
+          (error (message (concat "Got status response: " status)))))))
+  t)
+
+(defun url-scgi-get-connection (host port)
+  (let ((buf (generate-new-buffer " *url-scgi-temp*")))
+    ;; `url-open-stream' needs a buffer in which to do things
+    ;; like authentication.  But we use another buffer afterwards.
+    (unwind-protect
+        (let ((proc (url-open-stream host buf host port)))
+          ;; url-open-stream might return nil.
+          (when (processp proc)
+            ;; Drop the temp buffer link before killing the buffer.
+            (set-process-buffer proc nil))
+          proc)
+      (kill-buffer buf))))
+
+;;;###autoload
+(defun url-scgi (url callback cbargs)
+  "Handle SCGI URLs from internal Emacs functions."
+  (check-type url vector "Need a pre-parsed URL.")
+  (declare (special url-scgi-connection-opened
+                   url-callback-function
+                   url-callback-arguments))
+  (let* ((host (url-host url))
+        (port (url-port url))
+        (connection (url-scgi-get-connection host port))
+        (buffer (generate-new-buffer (format " *scgi %s:%d*" host port))))
+    (if (not connection)
+       ;; Failed to open the connection for some reason
+       (progn
+         (kill-buffer buffer)
+         (setq buffer nil)
+         (error "Could not create connection to %s:%d" host port))
+      (with-current-buffer buffer
+       (mm-disable-multibyte)
+       (setq url-current-object url
+             mode-line-format "%b [%s]")
+
+       (dolist (var '(url-scgi-connection-opened
+                       url-scgi-content-type
+                      url-scgi-content-length
+                      url-callback-function
+                      url-callback-arguments))
+         (set (make-local-variable var) nil))
+
+       (setq url-callback-function callback
+             url-callback-arguments cbargs
+             url-scgi-connection-opened nil)
+
+       (set-process-buffer connection buffer)
+       (set-process-filter connection 'url-scgi-filter)
+        (set-process-sentinel connection 'url-scgi-async-sentinel)
+       (let ((status (process-status connection)))
+          (cond ((eq status 'failed)
+                 (error "Could not create connection to %s:%d" host port))  
+                ((eq status 'open)
+                 (process-send-string connection (url-scgi-create-request))
+                 (setq url-scgi-connection-opened t))))))
+    buffer))
+
+(defun url-scgi-async-sentinel (proc why)
+  (declare (special url-callback-arguments))
+  (with-current-buffer (process-buffer proc)
+    (cond
+     (url-scgi-connection-opened
+      (if (url-scgi-parse-headers)
+          (url-scgi-activate-callback)))
+     ((string= (substring why 0 4) "open")
+      (setq url-scgi-connection-opened t)
+      (process-send-string proc (url-scgi-create-request)))
+     (t
+      (setf (car url-callback-arguments)
+           (nconc (list :error (list 'error 'connection-failed why
+                                     :host (url-host url-current-object)
+                                     :service (url-port url-current-object)))
+                  (car url-callback-arguments)))
+      (url-scgi-activate-callback)))))
+
+(defun url-scgi-filter (proc data)
+  (with-current-buffer (process-buffer proc)
+    (save-excursion
+      (goto-char (point-max))
+      (insert data))))
+
+(provide 'url-scgi)
+
+;;; url-scgi.el ends here