googleaccount.el

[Riccardo Murri]

;;; googleaccount.el --- Google Accounts login from Emacs

;;; Author: Riccardo Murri <address@hidden>
;;; Version: 1.0
;;; X-URL: http://www.emacswiki.org/cgi-bin/emacs/googleaccount.el


;;; Copyright (c) 2007 Riccardo Murri <address@hidden>

;; 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, write to the Free Software
;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA


;;; Commentary:

;; This file should be useful only to authors of packages that
;; interface Emacs to Google services; it implements functions to
;; request an authorization token using the Google ClientLogin web
;; service (see
;; http://code.google.com/apis/accounts/AuthForInstalledApps.html )
;; and handle the error cases.

;; Sample usage::
;;
;;   (require 'googleaccount)
;;   ...
;;   (setq auth-header
;;      (googleaccount-login service email passwd))
;;   ...
;;   (if auth-header
;;     (let ((url-request-extra-headers (list auth-headers)))
;;        (url-retrieve ...some Google service URL...)

;; Function `googleaccount-login' tries to do the right thing: 
;; - returns the authorization header to be added to
;;   `url-request-extra-headers' when authorization is successful;
;; - returns nil when Google requires a CAPTCHA challenge to unlock
;;   the account, so that the calling program may retry login at a
;;   later time; 
;; - signals an error on any other case.

;; If you want full control, use `googleaccount-login-response', that
;; simply returns an alist with all data sent and received, and never
;; interacts with the user.

;; Only tried in Emacs 22.1; all the code relating to CAPTCHA and
;; errors other than "BadAuthentication" is *totally* untested.


;;; History:

;; 2007-10-23: Initial release.


;;; Code:

(require 'url)


(defconst googleaccount-login-url "https://www.google.com/accounts/ClientLogin";
  "URL to submit GoogleAccount login requests to.")

(defconst googleaccount-captcha-unlock-url 
  "https://www.google.com/accounts/DisplayUnlockCaptcha";
  "URL for Google page to unlock CAPTCHAs.")

(defconst googleaccount-source-name "emacs-googleaccount-1.0"
  "Client application name and version string.
Required by Google for logging purposes.")


(eval-when-compile
  (defmacro googleaccount-define-error (error-symbol &optional error-message)
  `(put ,error-symbol
        'error-conditions
        `(error googleaccount-error ,error-symbol))
  (if error-message
    `(put ,error-symbol 'error-message ,error-message))))

(googleaccount-define-error 
 'googleaccount-error "GoogleAccount login error")
;; see http://code.google.com/apis/accounts/AuthForInstalledApps.html#Errors
(googleaccount-define-error 'googleaccount-bad-authentication)
(googleaccount-define-error 'googleaccount-not-verified)
(googleaccount-define-error 'googleaccount-terms-not-agreed)
(googleaccount-define-error 'googleaccount-captcha-required)
(googleaccount-define-error 'googleaccount-account-deleted)
(googleaccount-define-error 'googleaccount-account-disabled)
(googleaccount-define-error 'googleaccount-service-disabled)
(googleaccount-define-error 'googleaccount-service-unavailable)
(googleaccount-define-error 'googleaccount-unknown)
(googleaccount-define-error 'googleaccount-unexpected)


(defun googleaccount-parse-response (&optional buffer alist)
  "Add (string) key=value pairs found in BUFFER to ALIST, and return it."
  (save-excursion
    (if buffer (set-buffer buffer))
    ;; FIXME: bound the search at the first blank line
    (while (re-search-backward "^\\([A-Za-z]+\\)=\\(.+\\)$" nil t)
      (setq alist (list* (cons (match-string 1) (match-string 2)) alist))))
  alist)


(defun googleaccount-uncamelcase-string (s &optional sep start)
  "Convert CamelCase string S to lower case with word separator SEP.
Default for SEP is a hyphen \"-\".

If third argument START is non-nil, start converting at that
index in STRING.

Return modified string."
  (let ((case-fold-search nil))
    (while (string-match "[A-Z]" s (or start 1))
      (setq s (replace-match (concat (or sep "-") 
                                             (downcase (match-string 0 s))) 
                                     t nil s)))
    (downcase s)))


(defun googleaccount-login (service email passwd)
  "Login into Google Account identified by EMAIL and PASSWD.
Upon successful login, returns the pair of strings 
(AUTH-HEADER . AUTH-KEY), suitable for adding 
to `url-request-extra-headers'.
If a CAPTCHA challenge was received, notify user and return nil.
Otherwise, signal error.
"
  (lexical-let* ((response (googleaccount-login-response service email passwd))
                 (status (cdr (assq 'status response))))
  (cond
    ((eq status 'ok)
      (googleaccount-auth-http-header response))
    ((eq status 'captcha)
     (googleaccount-handle-captcha response))
    ((eq status 'error)
     (googleaccount-handle-error response)))))


(defun googleaccount-login-response (service email passwd)
  "Login into Google Account identified by EMAIL and PASSWD, and return 
response.

Returns an alist, associating:
- to the key `status', one of the symbols:
    - `ok': user was successfully authenticated;
    - `captcha': a CAPTCHA challenge was issued;
    - `error': some other error occurred, in which case the key
      `google-error' contains the appropriate Emacs error symbol;
- to the string keys \"Email\", \"Passwd\", \"service\" and
  \"source\", the like-named arguments of this function;
- any other key/value pair corresponds to the key/value pairs
  gotten from the Google ClientLogin HTTP response.

See also `googleaccount-login'.
"
  (let* ((rr (list
              (cons "Email" email)
              (cons "Passwd" passwd)
              (cons "service" service)
              (cons "source" googleaccount-source-name)))
         (url-request-method "POST")
         (url-request-extra-headers
          '(("Content-Type" . "application/x-www-form-urlencoded")))
         (url-request-data
          (mapconcat (lambda (arg)
                       (format (concat (car arg) "=%s") 
                               (url-hexify-string (cdr arg))))
                     rr "&"))
         (response-buf (url-retrieve-synchronously googleaccount-login-url)))
    (if (not response-buf)
        (signal 'googleaccount-error "Error in HTTP POST to Google Account 
URL"))
    (nconc rr (googleaccount-parse-response response-buf))
    (kill-buffer response-buf)
    (cond
     ((assoc-string "Auth" rr t)
      ;; set 'status to 'ok and return response
      (list* '(status . ok) rr))
           
     ((assoc-string "CaptchaUrl" rr t)
      ;; set 'status to 'captcha and return response
      (list* '(status . captcha) rr))

     ((assoc-string "Error" rr t)
      (list* '(status . error)
             (cons 'google-error 
                   (intern (concat "googleaccount-"
                                   (googleaccount-uncamelcase-string 
                                    (cdr (assoc-string "Error" rr t))))))
             rr)))))


(defun googleaccount-handle-captcha (login-response)
  "Handle a CAPTCHA response from Google ClientLogin.
Offers user to display the CAPTCHA unlock page: if user refuses,
signal an error, otherwise try to show it with `browse-url'.

Argument LOGIN-RESPONSE should be the association list returned
by `googleaccount-login-response'.
"
  ;; FIXME: how to handle this in Emacs?
  (if (yes-or-no-p 
       "A CAPTCHA is required to unlock the account; do you want to visit the 
CAPTCHA URL now?")
      (progn
        (require 'browse-url)
        (browse-url googleaccount-captcha-unlock-url)
        (message "Login again when the CAPTCHA is unlocked."))
    (signal 'googleaccount-captcha-required
            (concat
             "A CAPTCHA is required to unlock the Google Account; visit "
             googleaccount-captcha-unlock-url
             " to unlock"))))


(defun googleaccount-authorized-p (login-response)
  "Return t if LOGIN-RESPONSE indicates successful authentication."
  (eq 'ok (assq 'status login-response)))


(defun googleaccount-captcha-p (login-response)
  "Return t if LOGIN-RESPONSE indicates that a CAPTCHA is required."
  (eq 'captcha (assq 'status login-response)))


(defun googleaccount-error-p (login-response)
  "Return t if LOGIN-RESPONSE indicates that Google reported an error."
  (eq 'error (assq 'status login-response)))


(defun googleaccount-auth-http-header (login-response)
  "Returns HTTP headers needed for authenticated Google service sessions.
Argument LOGIN-RESPONSE should be the association list returned
by `googleaccount-login-response'.

Return the pair of strings (AUTH-HEADER . AUTH-KEY), 
suitable for adding to `url-request-extra-headers'.
If LOGIN-RESPONSE contains no authorization tokens,
retuns nil."
  (lexical-let ((token (assoc "Auth" login-response)))
    (if token
        (cons "Authorization" 
              (format "GoogleLogin auth=%s" (cdr token))))))


(defun googleaccount-handle-error (login-response)
  "Signal the error condition appropriate to LOGIN-RESPONSE.
Argument LOGIN-RESPONSE should be an alist returned by
`googleaccount-login-response'."  
  (lexical-let ((err (cdr (assq 'google-error login-response)))
                (msg (googleaccount-error-message login-response)))
    (signal err msg)))


(defun googleaccount-error-message (login-response)
  "Return error message pertaining to LOGIN-RESPONSE."
  (lexical-let ((err (cdr (assq 'google-error login-response)))
                (errname (cdr (assoc-string "Error" login-response t)))
                (email (cdr (assoc-string "Email" login-response t)))
                (service (cdr (assoc-string "service" login-response t))))
    (format-spec
     (cdr (assq err
               ;; see 
http://code.google.com/apis/accounts/AuthForInstalledApps.html#Errors
               ;;
               ;; format specs:
               ;;   %u for email (user id)
               ;;   %s for service
               ;;
               '((googleaccount-bad-authentication .
                  "Authentication failed, either Email or password is 
incorrect")
                 (googleaccount-not-verified .
                  "The account email address has not been verified.  Access the 
Google account directly to resolve the issue before trying to log in again")
                 (googleaccount-terms-not-agreed .
                  "User of account %u has not agreed to terms. Access the 
Google account directly to resolve the issue before trying to log in again")
                 (googleaccount-captcha-required .
                  "A CAPTCHA is required")
                 (googleaccount-account-deleted .
                  "Google account `%u' has been deleted")
                 (googleaccount-account-disabled .
                  "Google account `%u' has been disabled")
                 (googleaccount-service-disabled .
                  "Account `%u' access to Google service has been disabled")
                 (googleaccount-service-unavailable .
                  "Google service `%s' is not available; try again later")
                 (googleaccount-unknown .
                  "Unspecified error accessing Google account `%u'")
                 (googleaccount-unexpected .
                   "Unexpected error accessing Google account `%u': `%n'"))))
     (list
      (cons ?n errname)
      (cons ?u email)
      (cons ?s service)))))

  
;; that's all folks!
(provide 'googleaccount)

;;; googleaccount.el ends here