os-rtm.el 5.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176
  1. ;;; os-rtm.el --- Remember The Milk backend for org-sync.
  2. ;; Copyright (C) 2012 Aurelien Aptel
  3. ;;
  4. ;; Author: Aurelien Aptel <aurelien dot aptel at gmail dot com>
  5. ;; Keywords: org, rtm, synchronization
  6. ;; Homepage: http://orgmode.org/worg/org-contrib/gsoc2012/student-projects/org-sync
  7. ;;
  8. ;; This program is free software; you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; This file is not part of GNU Emacs.
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  19. ;;; Commentary:
  20. ;; This package implements a backend for org-sync to synchnonize
  21. ;; issues from a remember the milk repo with an org-mode buffer. Read
  22. ;; Org-sync documentation for more information about it.
  23. ;;; Code:
  24. (eval-when-compile (require 'cl))
  25. (require 'os)
  26. (require 'json)
  27. (require 'url)
  28. (defvar os-rtm-api-key "e9b28a9ac67f1bffc3dab1bd94dab722")
  29. (defvar os-rtm-shared-secret "caef7e509a8dcd82")
  30. (defvar os-rtm-token nil)
  31. (defvar url-http-end-of-headers)
  32. (defvar url-http-response-status)
  33. (defun os-rtm-call (method &rest args)
  34. "Call API METHOD and return result."
  35. (let* ((param `(("method" . ,method)
  36. ,@args)))
  37. (os-rtm-request "GET" "http://api.rememberthemilk.com/services/rest/" param nil 'sign)))
  38. (defvar os-rtm-backend
  39. '((base-url . os-rtm-base-url)
  40. (fetch-buglist . os-rtm-fetch-buglist)
  41. (send-buglist . os-rtm-send-buglist))
  42. "Bitbucket backend.")
  43. (defun os-rtm-base-url (url)
  44. "Return base URL. Not used with RTM."
  45. url)
  46. (defun os-rtm-filter-tasks (response)
  47. "Return all the real task from RTM rtm.tasks.getList RESPONSE."
  48. (let (final)
  49. (mapc (lambda (e)
  50. (when (assoc 'taskseries e)
  51. (mapc (lambda (task-series)
  52. (push task-series final))
  53. (os-getalist e 'taskseries))))
  54. (os-getalist (cdr response) 'rsp 'tasks 'list))
  55. final))
  56. (defun os-rtm-fetch-buglist (last-update)
  57. (unless os-rtm-token
  58. (os-rtm-auth))
  59. (let ((bl
  60. (mapcar 'os-rtm-task-to-bug
  61. (os-rtm-filter-tasks (os-rtm-call "rtm.tasks.getList")))))
  62. `(:title "Tasks"
  63. :url ,os-base-url
  64. :bugs ,bl)))
  65. (defun os-rtm-task-to-bug (task)
  66. "Return TASK as a bug."
  67. (flet ((v (&rest key) (apply 'os-getalist task key)))
  68. (let* ((id (string-to-number (v 'id)))
  69. (title (v 'name))
  70. (status (if (string= (v 'task 'completed) "")
  71. 'open
  72. 'closed))
  73. (priority (v 'task 'priority))
  74. (ctime (os-parse-date (v 'created)))
  75. (mtime (os-parse-date (v 'modified)))
  76. (dtime (os-parse-date (v 'task 'due))))
  77. `(:id ,id
  78. :title ,title
  79. :status ,status
  80. :priority ,priority
  81. :date-creation ,ctime
  82. :date-modification ,mtime
  83. :date-deadline ,dtime))))
  84. (defun os-rtm-request (method url &optional param data sign)
  85. "Send HTTP request at URL using METHOD with DATA."
  86. (unless (string-match "/auth/" url)
  87. (push (cons "format" "json") param))
  88. (when os-rtm-token
  89. (push (cons "auth_token" os-rtm-token) param))
  90. (push `("api_key" . ,os-rtm-api-key) param)
  91. (when sign
  92. (push `("api_sig" . ,(os-rtm-sign param)) param))
  93. (setq url (os-url-param url param))
  94. (let* ((url-request-method method)
  95. (url-request-data data)
  96. (url-request-extra-headers
  97. (when data
  98. '(("Content-Type" . "application/x-www-form-urlencoded"))))
  99. buf)
  100. (message "%s %s %s" method url (prin1-to-string data))
  101. (setq buf (url-retrieve-synchronously url))
  102. (with-current-buffer buf
  103. (goto-char url-http-end-of-headers)
  104. (message "%s" (buffer-substring (point) (point-max)))
  105. (prog1
  106. (cons url-http-response-status (ignore-errors (json-read)))
  107. (kill-buffer)))))
  108. (defun os-rtm-auth ()
  109. "Return the URL to grant access to the user account."
  110. ;; http://www.rememberthemilk.com/services/auth/?api_key=abc123&perms=delete
  111. (let* ((res (os-rtm-call "rtm.auth.getFrob"))
  112. (frob (cdr (assoc 'frob (cdadr res))))
  113. (param `(("api_key" . ,os-rtm-api-key)
  114. ("perms" . "delete")
  115. ("frob" . ,frob)))
  116. url)
  117. ;; add signature
  118. (push `("api_sig" . ,(os-rtm-sign param)) param)
  119. (setq url (os-url-param "http://www.rememberthemilk.com/services/auth/" param))
  120. (browse-url url)
  121. (when (yes-or-no-p "Application accepted? ")
  122. (setq
  123. os-rtm-token
  124. (os-getalist
  125. (cdr (os-rtm-call "rtm.auth.getToken" `("frob" . ,frob)))
  126. 'rsp 'auth 'token)))))
  127. (defun os-rtm-sign (param-alist)
  128. "Return the signature for the PARAM-ALIST request."
  129. (let ((param (copy-tree param-alist))
  130. sign)
  131. ;; sort by key
  132. (setq param (sort param (lambda (a b)
  133. (string< (car a) (car b)))))
  134. ;; sign = md5(shared_secret . k1 . v1 . k2 . v2...)
  135. (md5
  136. (message
  137. (concat
  138. os-rtm-shared-secret
  139. ;; concat key&value
  140. (mapconcat (lambda (x)
  141. (concat (car x) (cdr x)))
  142. param ""))
  143. nil nil 'utf-8))))
  144. ;;; os-rtm.el ends here