1 ;;; lj-protocol.el --- "flat" protocol support for ljupdate
3 ;; Copyright (C) 2002, 2003, 2004, 2005 Edward O'Connor <ted@oconnor.cx>
5 ;; Author: Edward O'Connor <ted@oconnor.cx>
6 ;; Keywords: convenience
8 ;; This file is part of ljupdate, a LiveJournal client for Emacs.
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.
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.
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:
24 ;; Free Software Foundation
25 ;; 51 Franklin Street, Fifth Floor
26 ;; Boston, MA 02110-1301
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"))
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)
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
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
))
64 (goto-char (point-min))
65 (let ((on-variable-name-line t
)
67 (while (< (point) (point-max))
68 (cond (on-variable-name-line (setq var
(lj-this-line)))
70 (puthash var
(decode-coding-string (string-make-unibyte (lj-this-line)) lj-coding-system
) response
)
71 (setq have-frobbed t
)))
73 (setq on-variable-name-line
(not on-variable-name-line
))))
76 (kill-buffer (current-buffer)))
77 (rename-buffer "*LiveJournal debug*"))))))
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
))
88 (provide 'lj-protocol
)
90 ;;; lj-protocol.el ends here