emacs/external/ljupdate/lj-login.el

   1 ;;; lj-login.el --- lj protocol login 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 'cl)
  38
  39 (require 'lj-compat)
  40 (require 'lj-custom)
  41 (require 'lj-acct)
  42 (require 'lj-protocol)
  43 (require 'lj-util)
  44
  45 ;; from ljupdate.el
  46 (eval-when-compile (defvar lj-client-version))
  47
  48 (defvar lj-last-server nil
  49   "The last LJ server we used during this Emacs session.")
  50
  51 (defvar lj-last-username nil
  52   "The last LJ username we used during this Emacs session.")
  53
  54 (defun lj-process-login-response (server username info)
  55   "Process SERVER's login information returned when we logged in as USERNAME.
  56 Argument INFO is the bundle of values returned by the server."
  57
  58   (let ((name (gethash "name" info))
  59         (access-count (lj-number (gethash "access_count" info 0)))
  60         (pickw-count (lj-number (gethash "pickw_count" info 0)))
  61         (frgrp-maxnum (lj-number (gethash "frgrp_maxnum" info 0)))
  62         (mood-count (lj-number (gethash "mood_count" info 0)))
  63         (message (gethash "message" info)))
  64
  65     (when message
  66       (message "%s" message)
  67       (sit-for 2))
  68
  69     (when name
  70       (lj-user-put server username :name name))
  71
  72     (let ((access-list '()))
  73       (dotimes (access-num access-count)
  74         (let ((name (gethash (format "access_%d" (1+ access-num)) info)))
  75           (push name access-list)))
  76       (lj-user-put server username :access access-list))
  77
  78     (let ((pickw-list '()))
  79       (dotimes (pickw-num pickw-count)
  80         (let ((name (gethash (format "pickw_%d" (1+ pickw-num)) info)))
  81           (push name pickw-list)))
  82       (lj-user-put server username :pics pickw-list))
  83
  84     (let ((frgrp-alist '()))
  85       (dotimes (frgrp-num frgrp-maxnum)
  86         (let ((name (gethash (format "frgrp_%d_name" (1+ frgrp-num)) info))
  87               (sort (gethash (format "frgrp_%d_sortorder" (1+ frgrp-num)) info)))
  88           (when name
  89             (push (cons name (1+ frgrp-num)) frgrp-alist))))
  90       (lj-user-put server username :friends-groups frgrp-alist))
  91
  92     (let ((mood-max (or (lj-number (lj-server-get server :mood-max)) 0))
  93           (mood-alist (lj-server-get server :moods)))
  94       (dotimes (mood-num mood-count)
  95         (let ((name (gethash (format "mood_%d_name" (1+ mood-num)) info))
  96               (id (lj-number (or (gethash (format "mood_%d_id" (1+ mood-num)) info)
  97                                  0))))
  98           (when (> id mood-max)
  99             (lj-server-put server :mood-max id))
 100           (push (cons name id) mood-alist)))
 101       (lj-server-put server :moods mood-alist))))
 102
 103 (defun lj-attempt-login-once (server username password)
 104   "Try to log in to SERVER with USERNAME and PASSWORD.
 105 Returns a boolean indicating whether or not the login attempt succeeded.
 106 PASSWORD is the downcased MD5sum of the user's password."
 107   (message "Logging into `%s' as `%s'. Please wait." server username)
 108
 109   (let ((challenge (lj-getchallenge server)))
 110     (let* ((auth-response (lj-md5 (concat challenge password)))
 111            (response
 112             (lj-protocol-send-request
 113              server
 114              `(("mode"           . "login")
 115                ("ver"            . ,(if (eq lj-coding-system 'utf-8)
 116                                         "1"
 117                                       "0"))
 118                ("clientversion"  . ,lj-client-version)
 119                ("user"           . ,username)
 120                ("auth_method"    . "challenge")
 121                ("auth_challenge" . ,challenge)
 122                ("auth_response"  . ,auth-response)
 123                ("getmoods"       . ,(format "%s"
 124                                             (or (lj-server-get server :mood-max)
 125                                                 0)))
 126                ("getpickws"      . "1"))))) ; get userpics
 127       (if (hash-table-p response)
 128           (cond ((string= (gethash "success" response) "OK")
 129                  (lj-process-login-response server username response)
 130                  t)
 131                 ((string= (gethash "success" response) "FAIL")
 132                  (message "Logging into `%s' failed; error message is `%s'."
 133                           server (gethash "errmsg" response))
 134                  nil)
 135                 (t
 136                  (message
 137                   "Logging into `%s' failed (empty response); please try again later."
 138                   server)))
 139         (message "Logging into `%s' failed (null response); please try again later."
 140                  server)
 141         nil))))
 142
 143 (defun lj-attempt-login (server username explicit-login)
 144   "Attempt to log into SERVER (as USERNAME) once.
 145
 146 If EXPLICIT-LOGIN is non-nil, the user has requested this login
 147 explicitly, so we message useful feedback to the echo area."
 148   (let ((tries 0)
 149         (logged-in nil)
 150         (password nil))
 151     (while (and (not logged-in) (< tries 3))
 152       (setq password
 153             (lj-md5 (read-passwd
 154                      (format "Password for %s@%s: " username server))))
 155       (setq tries (+ tries 1)
 156             logged-in (lj-attempt-login-once server username password)))
 157     (if logged-in
 158         (progn
 159           (setq lj-last-username username
 160                 lj-last-server   server)
 161           (lj-user-put server username :password password)
 162           (when explicit-login
 163             (message "Successfully logged in as %s@%s." username server))
 164           password)
 165       (when explicit-login
 166         (message "Login failure for %s@%s." username server)
 167         nil))))
 168
 169 (defun lj-read-server ()
 170   "Read a server name from the user."
 171   (let ((guess (or lj-last-server lj-default-server "www.livejournal.com")))
 172     (completing-read "Server: "
 173                      (mapcar (lambda (item) (cons item item))
 174                              (lj-servers))
 175                      nil nil guess nil guess nil)))
 176
 177 (defun lj-read-username (&optional server)
 178   "Read a username (of SERVER, if supplied) from the user."
 179   (completing-read "Username: "
 180                    (mapcar (lambda (item) (cons item item))
 181                            (lj-users (or server
 182                                          lj-last-server
 183                                          lj-default-server)))
 184                    nil nil lj-default-username nil lj-default-username nil))
 185
 186 (defun lj-read-server-username-pair ()
 187   "Read a server and a username at that server from the user."
 188   (let ((server (lj-read-server)))
 189     (list server (lj-read-username server))))
 190
 191 ;;;###autoload
 192 (defun lj-login (server username)
 193   "Logs into SERVER as USERNAME, and return the md5sum of USERNAME's password."
 194   (interactive (lj-read-server-username-pair))
 195   (or (lj-user-get server username :password)
 196       (lj-attempt-login server username (interactive-p))
 197       (error "Unable to log into %s as %s" server username)))
 198
 199 ;;;###autoload
 200 (defun lj-logout (server username)
 201   "Logs off of SERVER (as USERNAME)."
 202   (interactive (lj-read-server-username-pair))
 203   (lj-user-rem server username :password))
 204
 205 ;; Internally, I call this to get the password for the given user@host.
 206 ;; So let's make code calling this easier to read.
 207 ;;;###autoload
 208 (defalias 'lj-password 'lj-login)
 209
 210 (provide 'lj-login)
 211
 212 ;;; lj-login.el ends here