Emacs library to control Basecamp
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

281 lines
10KB

  1. ;;; libbcel-oauth.el --- Connects to basecamp API through oauth -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2019 Damien Cassou
  3. ;; Author: Damien Cassou <damien@cassou.me>
  4. ;; Url: https://gitlab.petton.fr/bcel/libbcel
  5. ;; Package-requires: ((emacs "26.1"))
  6. ;; Version: 0.4.0
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; This program is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; This file implements
  19. ;; https://github.com/basecamp/api/blob/master/sections/authentication.md#oauth-2-from-scratch.
  20. ;;; Code:
  21. (require 'request)
  22. (require 'json)
  23. ;;; Configuration
  24. (defgroup libbcel-oauth nil
  25. "Group for OAuth authentication to Basecamp."
  26. :group 'libbcel)
  27. (defcustom libbcel-oauth-store-filename (concat user-emacs-directory "libbcel-oauth.el.gpg")
  28. "Filename where Basecamp 3 OAuth tokens are stored.
  29. If the filename ends with .gpg, the file will be encrypted with
  30. `libbcel-oauth-store-encryption-keys' if non-nil."
  31. :type 'file)
  32. (defcustom libbcel-oauth-store-encryption-keys nil
  33. "GPG keys to use to encrypt the store."
  34. :type '(repeat string))
  35. (defcustom libbcel-oauth-client-id nil
  36. "Set your basecamp client id here."
  37. :type 'string)
  38. (defcustom libbcel-oauth-client-secret nil
  39. "Set your basecamp client secret here."
  40. :type 'string)
  41. (defcustom libbcel-oauth-local-http-port 9321
  42. "The port number used for the redirect uri.
  43. This number should be specified when defining the integration on
  44. the basecamp website."
  45. :type 'number)
  46. ;;; OAuth2 client protocol
  47. (defun libbcel-oauth--kill-process (process)
  48. "Terminate the network PROCESS."
  49. (stop-process process)
  50. (delete-process process))
  51. (defun libbcel-oauth--make-http-server (client-id client-secret callback)
  52. "Create a network process listening for HTTP connections.
  53. The port the server listens to is
  54. `libbcel-oauth-local-http-port'.
  55. CLIENT-ID and CLIENT-SECRET are provided by basecamp for each
  56. integration.
  57. CALLBACK is executed with the authentication data if the OAUTH
  58. authentication terminates successfully."
  59. (let ((http-server-process))
  60. (let ((kill-process-fn (lambda () (libbcel-oauth--kill-process http-server-process))))
  61. (setq http-server-process
  62. (make-network-process
  63. :server t
  64. :name "libbcel-oauth-http-server"
  65. :service libbcel-oauth-local-http-port
  66. :buffer (generate-new-buffer "*libbcel-oauth-http-server*")
  67. :filter (apply-partially
  68. #'libbcel-oauth--http-server-filter
  69. client-id
  70. client-secret
  71. (libbcel-oauth--redirect-uri)
  72. kill-process-fn
  73. callback))))))
  74. (defun libbcel-oauth--open-browser (client-id redirect-uri)
  75. "Open the user's favorite web browser so s·he can authorize libbcel.
  76. CLIENT-ID is provided by basecamp for each integration.
  77. REDIRECT-URI is specified when creating a new integration. It
  78. should be a string such as \"http://localhost:9321\"."
  79. (browse-url
  80. (format "https://launchpad.37signals.com/authorization/new?type=web_server&client_id=%s&redirect_uri=%s"
  81. client-id
  82. redirect-uri)))
  83. (defun libbcel-oauth--http-server-filter (client-id client-secret redirect-uri kill-process-fn callback process data)
  84. "Analyze DATA and continue the OAUTH process if DATA has a code.
  85. CLIENT-ID and CLIENT-SECRET are provided by basecamp for each
  86. integration.
  87. REDIRECT-URI is specified when creating a new integration. It
  88. should be a string such as \"http://localhost:9321\".
  89. KILL-PROCESS-FN is a function to be called to kill the HTTP server.
  90. CALLBACK is executed with the authentication data if the OAUTH
  91. authentication terminates successfully.
  92. PROCESS is the HTTP process created to communicate with the HTTP
  93. client which opened the connection."
  94. (save-match-data
  95. (with-temp-buffer
  96. (erase-buffer)
  97. (insert data)
  98. (setf (point) (point-min))
  99. (when (re-search-forward (rx bol "GET /?code=" (group-n 1 (+ (not (any " ")))) " ") nil t)
  100. (let ((code (match-string 1)))
  101. (libbcel-oauth--send-auth-request
  102. `((type . "web_server")
  103. (client_id . ,client-id)
  104. (redirect_uri . ,redirect-uri)
  105. (client_secret . ,client-secret)
  106. (code . ,code))
  107. (lambda (data)
  108. (libbcel-oauth--http-respond process)
  109. (funcall callback data)
  110. ;; stop the connection to the client:
  111. (stop-process process)
  112. (delete-process process)
  113. ;; prevent the server from
  114. ;; accepting new connections:
  115. (funcall kill-process-fn))
  116. kill-process-fn))))))
  117. (defun libbcel-oauth--http-respond (process)
  118. "Respond to the http client in PROCESS that everything went well."
  119. (let ((content "<p>Everything ok, you may go back to Emacs.</p>")
  120. (time (current-time-string)))
  121. (send-string process
  122. (format "HTTP/1.1 200 OK
  123. Date: %s
  124. Server: Emacs
  125. Last-Modified: %s
  126. Content-Length: %s
  127. Content-Type: text/html
  128. Connection: Closed
  129. %s" time time (length content) content))))
  130. (defun libbcel-oauth--refresh-access-token (store callback)
  131. "Execute CALLBACK with a refreshed access token from STORE."
  132. (let* ((client-id (map-elt store :client-id))
  133. (client-secret (map-elt store :client-secret))
  134. (refresh-token (map-elt store :refresh-token)))
  135. (libbcel-oauth--send-auth-request
  136. `((type . "refresh")
  137. (refresh_token . ,refresh-token)
  138. (client_id . ,client-id)
  139. (redirect_uri . ,(libbcel-oauth--redirect-uri))
  140. (client_secret . ,client-secret))
  141. (lambda (data)
  142. (funcall callback data))
  143. (lambda ()
  144. (user-error "Failed to refresh basecamp access token")
  145. (funcall callback)))))
  146. (defun libbcel-oauth--send-auth-request (params success failure)
  147. "Do a POST request with PARAMS on Basecamp auth URL.
  148. Execute SUCCESS with data upon success, or FAILURE."
  149. (request
  150. "https://launchpad.37signals.com/authorization/token"
  151. :type "POST"
  152. :data ""
  153. :params params
  154. :parser #'json-read
  155. :success (cl-function (lambda (&key data &allow-other-keys)
  156. (funcall success data)))
  157. :error (cl-function (lambda (&rest _args)
  158. (funcall failure)))))
  159. (defun libbcel-oauth--redirect-uri ()
  160. "Generate a local redirect-uri from `libbcel-oauth-local-http-port'.
  161. REDIRECT-URI is specified when creating a new integration. It is
  162. a string such as \"http://localhost:9321\"."
  163. (concat "http://localhost:" (number-to-string libbcel-oauth-local-http-port)))
  164. (defun libbcel-oauth--fetch (store callback)
  165. "Get new tokens using credentials in STORE and pass them to CALLBACK."
  166. (let* ((client-id (map-elt store :client-id))
  167. (client-secret (map-elt store :client-secret)))
  168. (libbcel-oauth--make-http-server client-id client-secret callback)
  169. (libbcel-oauth--open-browser client-id (libbcel-oauth--redirect-uri))))
  170. ;;; Token storage
  171. (defun libbcel-oauth--store-has-access-token-p (store)
  172. "Return non-nil if STORE has an access token."
  173. (map-contains-key store :access-token))
  174. (defun libbcel-oauth--store-needs-refresh-p (store)
  175. "Return non-nil if STORE has an outdated access token."
  176. (time-less-p
  177. (map-elt store :deadline)
  178. (current-time)))
  179. (cl-defun libbcel-oauth--store-save (store &key auth-token client-id client-secret)
  180. "Save AUTH-TOKEN within STORE."
  181. (let* ((access-token (map-elt auth-token 'access_token))
  182. (refresh-token (map-elt auth-token 'refresh_token))
  183. (expires-in (map-elt auth-token 'expires_in))
  184. (deadline (when expires-in
  185. (time-add (current-time) expires-in))))
  186. (when access-token
  187. (puthash :access-token access-token store))
  188. (when refresh-token
  189. (puthash :refresh-token refresh-token store))
  190. (when deadline
  191. (puthash :deadline deadline store))
  192. (when client-id
  193. (puthash :client-id client-id store))
  194. (when client-secret
  195. (puthash :client-secret client-secret store)))
  196. (with-current-buffer (find-file-noselect libbcel-oauth-store-filename)
  197. (erase-buffer)
  198. (insert (format "%S" store))
  199. (setq-local epa-file-encrypt-to libbcel-oauth-store-encryption-keys)
  200. (make-directory (file-name-directory (expand-file-name libbcel-oauth-store-filename)) t)
  201. (save-buffer)))
  202. ;;; Public function
  203. (defun libbcel-oauth-get-store ()
  204. "Return a `store' where Basecamp tokens should be saved."
  205. (let ((store (if (file-readable-p libbcel-oauth-store-filename)
  206. (with-current-buffer (find-file-noselect libbcel-oauth-store-filename)
  207. (setf (point) (point-min))
  208. (read (current-buffer)))
  209. (make-hash-table :size 10))))
  210. (puthash :client-id libbcel-oauth-client-id store)
  211. (puthash :client-secret libbcel-oauth-client-secret store)
  212. store))
  213. (defun libbcel-oauth-get-access-token (store callback)
  214. "Execute CALLBACK with an access-token using the credentials saved in STORE.
  215. To create STORE, call `libbcel-oauth-get-store'."
  216. (let ((auth-token-callback
  217. (lambda (auth-token)
  218. (libbcel-oauth--store-save store :auth-token auth-token)
  219. (funcall callback (map-elt store :access-token)))))
  220. (if (not (libbcel-oauth--store-has-access-token-p store))
  221. (libbcel-oauth--fetch store auth-token-callback)
  222. (if (libbcel-oauth--store-needs-refresh-p store)
  223. (libbcel-oauth--refresh-access-token store auth-token-callback)
  224. (funcall callback (map-elt store :access-token)))))
  225. t)
  226. (provide 'libbcel-oauth)
  227. ;;; libbcel-oauth.el ends here