oauth.el

   1 ;;; oauth.el --- Oauth library.
   2
   3 ;; Copyright (C) 2009 Peter Sanford
   4
   5 ;; Author: Peter Sanford <peter AT petersdanceparty.com>
   6 ;; Version: 1.03
   7 ;; Keywords: comm
   8 ;; Contributors:
   9 ;;     Anthony Garcia <lagg@lavabit.com>
  10 ;;     Leo Shidai Liu <github.com/leoliu>
  11 ;;     Neil Roberts <bpeeluk@yahoo.co.uk>
  12
  13 ;; This file is NOT part of GNU Emacs.
  14
  15 ;; This program is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 3, or (at your option)
  18 ;; any later version.
  19 ;;
  20 ;; This program is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  23 ;; GNU General Public License for more details.
  24 ;;
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
  27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  28 ;; Boston, MA 02110-1301, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; This is oauth client library implementation in elisp. It is
  33 ;; capable of authenticating (receiving an access token) and signing
  34 ;; requests. Currently it only supports HMAC-SHA1, although adding
  35 ;; additional signature methods should be relatively straight forward.
  36
  37 ;; Visit http://oauth.net/core/1.0a for the complete oauth spec.
  38
  39 ;; Oauth requires the client application to receive user authorization in order
  40 ;; to access restricted content on behalf of the user. This allows for
  41 ;; authenticated communication without jeopardizing the user's password.
  42 ;; In order for an application to use oauth it needs a key and secret
  43 ;; issued by the service provider.
  44
  45 ;; Usage:
  46
  47 ;; Obtain access token:
  48
  49 ;; The easiest way to obtain an access token is to call (oauth-authorize-app)
  50 ;; This will authorize the application and return an oauth-access-token.
  51 ;; You will use this token for all subsequent requests. In many cases
  52 ;; it will make sense to serialize this token and reuse it for future sessions.
  53 ;; At this time, that functionality is left to the application developers to
  54 ;; implement (see yammer.el for an example of token serialization).
  55
  56 ;; Two helper functions are provided to handle authenticated requests:
  57 ;; (oauth-fetch-url) and (oauth-post-url)
  58 ;; Both take the access-token and a url.
  59 ;; Post takes an additional parameter post-vars-alist which is a
  60 ;; list of key val pairs to be used in a x-www-form-urlencoded message.
  61
  62 ;; yammer.el:
  63 ;; http://github.com/psanford/emacs-yammer/tree/master is an example
  64 ;; mode that uses oauth.el
  65
  66 ;; Dependencies:
  67
  68 ;; The default behavior of oauth.el is to dispatch to curl for http
  69 ;; communication. It is strongly recommended that you use curl.
  70 ;; If curl is unavailable you can set oauth-use-curl to nil and oauth.el
  71 ;; will try to use the emacs internal http functions (url-request).
  72 ;; Note: if you plan on doing https and have oauth-use-curl set to nil,
  73 ;; make sure you have gnutls-bin installed.
  74
  75 ;; oauth.el uses hmac-sha1 library for generating signatures. An implementation
  76 ;; by Derek Upham is included for convenience.
  77
  78 ;; This library assumes that you are using the oauth_verifier method
  79 ;; described in the 1.0a spec.
  80
  81 ;;; Code:
  82
  83 (require 'url)
  84 (require 'url-util)
  85 (require 'hmac-sha1)
  86
  87 (defvar oauth-nonce-function nil
  88 "Fuction used to generate nonce.
  89
  90 Use (sasl-unique-id) if available otherwise oauth-internal-make-nonce")
  91
  92 (defvar oauth-hmac-sha1-param-reverse nil)
  93 (eval-when-compile
  94   (require 'cl)
  95
  96   ;; Sad hack: There are two different implementations of hmac-sha1
  97   ;; One by Derek Upham (included with oauth),
  98   ;; and one by Shuhei KOBAYASHI (in the FLIM package).
  99   ;; Both functions work but they have different parameter orderings.
 100   ;; To deal with this we have this nice test to figure out which one
 101   ;; is actually available to us. Hopefully things will *just work*.
 102   (when (equal
 103          (encode-hex-string (hmac-sha1 "Hi There" (make-string 20 ?\x0b)))
 104          "b617318655057264e28bc0b6fb378c8ef146be00")
 105     (setq oauth-hmac-sha1-param-reverse t))
 106
 107   ;; Use sasl if available, otherwise make the nonce ourselves
 108   (if (require 'sasl nil t)
 109       (setq oauth-nonce-function #'sasl-unique-id)
 110     (setq oauth-nonce-function #'oauth-internal-make-nonce)))
 111
 112 (defstruct oauth-request
 113   "Container for request information.
 114
 115 This includes both oauth header parameters as well as general
 116 request information (url and http-method)."
 117   params ; alist
 118   token ; oauth-t
 119   url (http-method "GET"))
 120
 121 (defstruct oauth-t
 122   "Token used for both Unauth Request Token (6.1.2) and Access Token (6.3.2)"
 123   token token-secret)
 124
 125 (defstruct oauth-access-token
 126   consumer-key consumer-secret auth-t)
 127
 128 (defvar oauth-enable-browse-url t
 129   "Specifies whether or not to use call browse-url for authorizing apps.
 130
 131 Disabling is useful for remote machines.
 132 Most of the time you will want this set to t.")
 133
 134 (defvar oauth-use-curl t
 135   "Specifies whether to use curl (external) or url-request (emacs internal) for requests.
 136
 137 It is generally recomended that you use curl for your requests.")
 138
 139 (defvar oauth-curl-insecure t
 140   "Use the curl insecure flag (-k) which ignores ssl certificate errors.")
 141
 142 (defvar oauth-post-vars-alist nil
 143   "Alist containing key/vals for POSTing (x-www-form-urlencoded) requests.")
 144
 145 (defvar oauth-callback-url "oob"
 146   "Callback url for the server to redirect the client after the client authorizes the application.
 147
 148 This is mainly intended for web apps. Most client side apps will use 'oob' instead of a url.")
 149
 150 (defun oauth-authorize-app (consumer-key consumer-secret request-url access-url authorize-url)
 151   "Authorize application.
 152
 153 CONSUMER-KEY and CONSUMER-SECRET are the key and secret issued by the
 154 service provider.
 155
 156 REQUEST-URL is the url to request an unauthorized token.
 157 ACCESS-URL is the url to request an access token.
 158 AUTHORIZE-URL is the url that oauth.el should redirect the user to once
 159 it has recieved an unauthorized token.
 160
 161 This will fetch an unauthorized token, prompt the user to authorize this
 162 application and the fetch the authorized token.
 163
 164 Returns an oauth-access-token if everything was successful."
 165   (let ((auth-t) (auth-req) (unauth-t) (auth-url) (access-token)
 166         (unauth-req (oauth-sign-request-hmac-sha1
 167                      (oauth-make-request request-url consumer-key)
 168                      consumer-secret)))
 169     (setq unauth-t (oauth-fetch-token unauth-req))
 170     (setq auth-url (format "%s?oauth_token=%s"
 171                            authorize-url (oauth-t-token unauth-t)))
 172     (if oauth-enable-browse-url
 173         (browse-url auth-url)
 174       (read-string (concat
 175                     "Please authorize this application by visiting: " auth-url
 176                     " \nPress enter once you have done so: ")))
 177     (setq access-token (read-string
 178                         "Please enter the provided code: "))
 179     (setq auth-req
 180           (oauth-sign-request-hmac-sha1
 181            (oauth-make-request
 182             (concat access-url "?oauth_verifier=" access-token)
 183             consumer-key unauth-t)
 184            consumer-secret))
 185     (setq auth-t (oauth-fetch-token auth-req))
 186     (make-oauth-access-token :consumer-key consumer-key
 187                              :consumer-secret consumer-secret
 188                              :auth-t auth-t)))
 189
 190 (defun oauth-url-retrieve (access-token url &optional async-callback cb-data)
 191   "Like url retrieve, with url-request-extra-headers set to the necessary
 192 oauth headers."
 193   (let ((req (oauth-make-request
 194               url
 195               (oauth-access-token-consumer-key access-token)
 196               (oauth-access-token-auth-t access-token))))
 197     (setf (oauth-request-http-method req) (or url-request-method "GET"))
 198     (when oauth-post-vars-alist
 199       (setf (oauth-request-params req)
 200             (append (oauth-request-params req) oauth-post-vars-alist)))
 201     (oauth-sign-request-hmac-sha1
 202      req (oauth-access-token-consumer-secret access-token))
 203     (let ((url-request-extra-headers (if url-request-extra-headers
 204                                          (append url-request-extra-headers
 205                                                  (oauth-request-to-header req))
 206                                        (oauth-request-to-header req)))
 207           (url-request-method (oauth-request-http-method req)))
 208       (cond
 209        (async-callback (url-retrieve (oauth-request-url req)
 210                                      async-callback cb-data))
 211        (oauth-use-curl (oauth-curl-retrieve (oauth-request-url req)))
 212        (t (url-retrieve-synchronously (oauth-request-url req)))))))
 213
 214 (defun oauth-fetch-url (access-token url)
 215   "Wrapper around url-retrieve-synchronously using the the authorized-token
 216 to authenticate.
 217
 218 This is intended for simple get reqests.
 219 Returns a buffer of the xresponse."
 220   (oauth-url-retrieve access-token url))
 221
 222 (defun oauth-post-url (access-token url post-vars-alist)
 223   "Wrapper around url-retrieve-synchronously using the the authorized-token
 224 to authenticate.
 225
 226 This is intended for simple post reqests.
 227 Returns a buffer of the response."
 228   (let ((url-request-method "POST")
 229         (oauth-post-vars-alist post-vars-alist))
 230     (oauth-url-retrieve access-token url)))
 231
 232 (defun oauth-epoch-string ()
 233   "Returns a unix epoch timestamp string"
 234   (format "%d" (ftruncate (float-time (current-time)))))
 235
 236 (defun oauth-make-nonce ()
 237   (funcall oauth-nonce-function))
 238
 239 (defun oauth-internal-make-nonce ()
 240   (number-to-string (random t)))
 241
 242 (defun oauth-make-request (url consumer-key &optional token)
 243   "Generates a oauth-request object with default values
 244
 245 Most consumers should call this function instead of creating
 246 oauth-request objects directly"
 247   (make-oauth-request :url url
 248                       :token token
 249                       :params `(("oauth_consumer_key" . ,consumer-key)
 250                                 ("oauth_timestamp" . ,(oauth-epoch-string))
 251                                 ("oauth_nonce" . ,(oauth-make-nonce))
 252                                 ("oauth_callback" . ,oauth-callback-url)
 253                                 ("oauth_version" . "1.0"))))
 254
 255 ;; HMAC-SHA1 specific code
 256 (defun oauth-sign-request-hmac-sha1 (req secret)
 257   "Adds signature and signature_method to req.
 258
 259 This function is destructive"
 260   (let ((token (oauth-request-token req)))
 261     (push '("oauth_signature_method" . "HMAC-SHA1")
 262           (oauth-request-params req))
 263     (when token
 264       (push `("oauth_token" . ,(oauth-t-token token))
 265             (oauth-request-params req)))
 266     (push `("oauth_signature" . ,(oauth-build-signature-hmac-sha1 req secret))
 267           (oauth-request-params req)))
 268   req)
 269
 270 (defun oauth-build-signature-hmac-sha1 (req secret)
 271   "Returns the signature for the given request object"
 272   (let* ((token (oauth-request-token req))
 273          (key (concat secret "&" (when token (oauth-t-token-secret token))))
 274          (hmac-params
 275           (list (encode-coding-string key 'utf-8 t)
 276                 (encode-coding-string
 277                  (oauth-build-signature-basestring-hmac-sha1 req) 'utf-8 t))))
 278     (if oauth-hmac-sha1-param-reverse (setq hmac-params (reverse hmac-params)))
 279     (base64-encode-string (apply 'hmac-sha1 hmac-params))))
 280
 281 (defun oauth-build-signature-basestring-hmac-sha1 (req)
 282   "Returns the base string for the hmac-sha1 signing function"
 283   (let ((base-url (oauth-extract-base-url req))
 284          (params (append
 285                   (oauth-extract-url-params req)
 286                   (copy-sequence (oauth-request-params req)))))
 287     (concat
 288      (oauth-request-http-method req) "&"
 289      (oauth-hexify-string base-url) "&"
 290      (oauth-hexify-string
 291       (mapconcat
 292        (lambda (pair)
 293          (concat (car pair) "=" (oauth-hexify-string (cdr pair))))
 294        (sort params
 295              (lambda (a b) (string< (car a) (car b))))
 296        "&")))))
 297
 298 (defun oauth-extract-base-url (req)
 299   "Returns just the base url.
 300
 301 For example: http://example.com?param=1 returns http://example.com"
 302   (let ((url (oauth-request-url req)))
 303     (if (string-match "\\([^?]+\\)" url)
 304         (match-string 1 url)
 305       url)))
 306
 307 (defun oauth-extract-url-params (req)
 308   "Returns an alist of param name . param value from the url"
 309   (let ((url (oauth-request-url req)))
 310     (when (string-match (regexp-quote "?") url)
 311       (mapcar (lambda (pair)
 312                 `(,(car pair) . ,(cadr pair)))
 313               (url-parse-query-string (substring url (match-end 0)))))))
 314
 315 (defun oauth-fetch-token (req)
 316   "Fetches a token based on the given request object"
 317   (let ((token (make-oauth-t)))
 318     (set-buffer (oauth-do-request req))
 319     (goto-char (point-min))
 320     (let ((linebreak (search-forward "\n\n" nil t nil)))
 321       (when linebreak
 322         (delete-region (point-min) linebreak)))
 323     (goto-char (point-max))
 324     (let ((line-start (search-backward "\r\n" nil t nil)))
 325       (when line-start
 326         (delete-region (point-min) (+ line-start 2))))
 327     (loop for pair in (mapcar (lambda (str) (split-string str "="))
 328                               (split-string
 329                                (buffer-substring (point-min) (point-max)) "&"))
 330           do
 331           (cond
 332            ((equal (car pair) "oauth_token_secret")
 333             (setf (oauth-t-token-secret token) (cadr pair)))
 334            ((equal (car pair) "oauth_token")
 335             (setf (oauth-t-token token) (cadr pair)))))
 336     token))
 337
 338 (defun oauth-do-request (req)
 339   "Make an http request to url using the request object to generate the oauth
 340 headers. Returns the http response buffer."
 341   (if oauth-use-curl (oauth-do-request-curl req)
 342     (oauth-do-request-emacs req)))
 343
 344 (defun oauth-do-request-emacs (req)
 345   "Make an http request to url using the request object to generate the oauth
 346 headers. Returns the http response buffer.
 347
 348 This function uses the emacs function `url-retrieve' for the http connection."
 349   (let ((url-request-extra-headers (oauth-request-to-header req))
 350         (url-request-method (oauth-request-http-method req)))
 351   (url-retrieve-synchronously (oauth-request-url req))))
 352
 353 (defun oauth-do-request-curl (req)
 354   "Make an http request to url using the request object to generate the oauth
 355 headers. Returns the http response buffer.
 356
 357 This function dispatches to an external curl process"
 358
 359   (let ((url-request-extra-headers (oauth-request-to-header req))
 360         (url-request-method (oauth-request-http-method req)))
 361   (oauth-curl-retrieve (oauth-request-url req))))
 362
 363 (defun oauth-headers-to-curl (headers)
 364   "Converts header alist (like `url-request-extra-headers') to a string that
 365 can be fed to curl"
 366   (apply
 367    'append
 368    (mapcar
 369     (lambda (header) `("--header"
 370                        ,(concat (car header) ": " (cdr header)))) headers)))
 371
 372 (defun oauth-curl-retrieve (url)
 373   "Retrieve via curl"
 374   (url-gc-dead-buffers)
 375   (set-buffer (generate-new-buffer " *oauth-request*"))
 376   (let ((curl-args `("-s" ,(when oauth-curl-insecure "-k")
 377                      "-X" ,url-request-method
 378                      "-i" ,url
 379                      ,@(when oauth-post-vars-alist
 380                          (apply
 381                           'append
 382                           (mapcar
 383                            (lambda (pair)
 384                              (list
 385                               "-d"
 386                               (concat (car pair) "="
 387                                       (oauth-hexify-string (cdr pair)))))
 388                            oauth-post-vars-alist)))
 389                      ,@(oauth-headers-to-curl url-request-extra-headers))))
 390     (apply 'call-process "curl" nil t nil curl-args))
 391   (url-mark-buffer-as-dead (current-buffer))
 392   (current-buffer))
 393
 394 (defun oauth-request-to-header (req)
 395   "Given a requst will return a alist of header pairs. This can
 396 be consumed by `url-request-extra-headers'."
 397   (let ((params (copy-sequence (oauth-request-params req))))
 398     (cons
 399      (cons
 400       "Authorization"
 401       (apply 'concat "OAuth realm=\"\""
 402              (mapcar
 403               (lambda (pair)
 404                 (format ", %s=\"%s\""
 405                         (car pair)
 406                         (oauth-hexify-string (cdr pair))))
 407               (sort params
 408                     (lambda (a b) (string< (car a) (car b))))))) '())))
 409
 410 (defconst oauth-unreserved-chars
 411   '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m
 412     ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
 413     ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M
 414     ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
 415     ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
 416     ?- ?_ ?. ?~ )
 417   "A list of characters that are _NOT_ reserved for oauth.")
 418
 419 (defun oauth-hexify-string (string)
 420   "Similar to hexify-string from `url-utils.el' except the hex
 421 characters are upper case and the reserved char set is slightly different."
 422   (mapconcat (lambda (byte)
 423                (if (memq byte oauth-unreserved-chars)
 424                    (char-to-string byte)
 425                  (format "%%%02X" byte)))
 426              (if (multibyte-string-p string)
 427                  (encode-coding-string string 'utf-8)
 428                string)
 429              ""))
 430
 431 (provide 'oauth)
 432
 433 ;;; oauth.el ends here