emacs/external/ljupdate/lj-protocol.el

   1 ;;; lj-protocol.el --- "flat" protocol support for ljupdate
   2
   3 ;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor <ted@oconnor.cx>
   4
   5 ;; Author: Edward O'Connor <ted@oconnor.cx>
   6 ;; Keywords: convenience
   7
   8 ;; This file is part of ljupdate, a LiveJournal client for Emacs.
   9
  10 ;; ljupdate is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or
  13 ;; {at your option} any later version.
  14
  15 ;; ljupdate is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING, or type `C-h C-c'. If
  22 ;; not, write to the Free Software Foundation at this address:
  23
  24 ;;   Free Software Foundation
  25 ;;   51 Franklin Street, Fifth Floor
  26 ;;   Boston, MA 02110-1301
  27 ;;   USA
  28
  29 ;;; Commentary:
  30 ;;
  31
  32 ;;; History:
  33 ;;
  34
  35 ;;; Code:
  36
  37 (require 'http-post)
  38
  39 (require 'lj-compat)
  40 (require 'lj-util)
  41
  42 (defun lj-protocol-server-url (hostname)
  43   "Return the URL to the LJ protocol's \"flat\" interface on HOSTNAME."
  44   (concat "http://" hostname "/interface/flat"))
  45
  46 (defsubst lj-this-line ()
  47   "Return a string containing the current line in the current buffer."
  48   (buffer-substring-no-properties (line-beginning-position)
  49                                   (line-end-position)))
  50
  51 (defun lj-protocol-send-request (server request)
  52   "Send to SERVER a REQUEST via the LiveJournal protocol.
  53 If the request succeeds, this returns a hash table whose keys and values
  54 contain the server's response. Or, if the request was unsuccessful, this
  55 returns nil ."
  56   (let ((process (http-post (lj-protocol-server-url server) request
  57                             lj-coding-system '(("Connection" . "close"))
  58                             'ignore 1.0 nil " *LiveJournal response*")))
  59     (while (accept-process-output process))
  60     (with-current-buffer (process-buffer process)
  61       ;; (if (and (stringp http-status-code) (= http-status-code 200)) ; HTTP 200 OK
  62       (let ((response (make-hash-table :test 'equal))
  63             (have-frobbed nil))
  64         (goto-char (point-min))
  65         (let ((on-variable-name-line t)
  66               var)
  67           (while (< (point) (point-max))
  68             (cond (on-variable-name-line (setq var (lj-this-line)))
  69                   (t
  70                    (puthash var (decode-coding-string (string-make-unibyte (lj-this-line)) lj-coding-system) response)
  71                    (setq have-frobbed t)))
  72             (forward-line 1)
  73             (setq on-variable-name-line (not on-variable-name-line))))
  74         (if have-frobbed
  75             (prog1 response
  76               (kill-buffer (current-buffer)))
  77           (rename-buffer "*LiveJournal debug*"))))))
  78
  79 (defun lj-getchallenge (server)
  80   "Get an authentication challenge from SERVER."
  81   (let* ((response (lj-protocol-send-request
  82                     server '(("mode" . "getchallenge"))))
  83          (challenge (and (hash-table-p response) (gethash "challenge" response))))
  84     (unless (stringp challenge)
  85       (error "Unable to connect to %s" server))
  86     challenge))
  87
  88 (provide 'lj-protocol)
  89
  90 ;;; lj-protocol.el ends here