[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 673026e: packages/excorporate: New package, import version
|
From: |
Thomas Fitzsimmons |
|
Subject: |
[elpa] master 673026e: packages/excorporate: New package, import version 0.7.0 |
|
Date: |
Thu, 25 Feb 2016 02:41:20 +0000 |
branch: master
commit 673026e59ce120808f3bca133c3c43a34a134d23
Author: Thomas Fitzsimmons <address@hidden>
Commit: Thomas Fitzsimmons <address@hidden>
packages/excorporate: New package, import version 0.7.0
* packages/excorporate/README,
packages/excorporate/excorporate-calendar.el,
packages/excorporate/excorporate-calfw.el.txt,
packages/excorporate/excorporate-org.el,
packages/excorporate/excorporate.el: New files.
---
packages/excorporate/README | 20 +
packages/excorporate/excorporate-calendar.el | 46 ++
packages/excorporate/excorporate-calfw.el.txt | 128 ++++
packages/excorporate/excorporate-org.el | 141 +++++
packages/excorporate/excorporate.el | 786 +++++++++++++++++++++++++
5 files changed, 1121 insertions(+), 0 deletions(-)
diff --git a/packages/excorporate/README b/packages/excorporate/README
new file mode 100644
index 0000000..7389a88
--- /dev/null
+++ b/packages/excorporate/README
@@ -0,0 +1,20 @@
+Excorporate provides Exchange integration for Emacs.
+
+To create a connection to a web service:
+
+M-x excorporate
+
+Excorporate will prompt for an email address that it will use to
+automatically discover settings. Then it will prompt you for your
+credentials two or three times depending on the server configuration.
+
+You should see a message indicating that the connection is ready
+either in the minibuffer or in the *Messages* buffer.
+
+Finally, run M-x calendar, and press 'e' to show today's meetings.
+
+If autodiscovery fails, customize `excorporate-configuration' to skip
+autodiscovery.
+
+For further information including connection troubleshooting, see the
+Excorporate Info node at C-h i d m Excorporate.
diff --git a/packages/excorporate/excorporate-calendar.el
b/packages/excorporate/excorporate-calendar.el
new file mode 100644
index 0000000..506ac72
--- /dev/null
+++ b/packages/excorporate/excorporate-calendar.el
@@ -0,0 +1,46 @@
+;;; excorporate-calendar.el --- Exchange for calendar -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Keywords: calendar
+
+;; 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Add a calendar keybinding for Excorporate. Default to the
+;; excorporate-org interface.
+
+;;; Code:
+
+(require 'calendar)
+
+(defcustom excorporate-calendar-show-day-function 'exco-org-show-day
+ "A function to be called by pressing `e' in Calendar."
+ :type 'function
+ :group 'excorporate)
+
+(defun exco-calendar-show-day ()
+ "Show meetings for the selected date."
+ (interactive)
+ (apply excorporate-calendar-show-day-function (calendar-cursor-to-date t)))
+
+;; I arrogantly claim "e" for now, but irresponsibly reserve the right
+;; to change it later.
+(define-key calendar-mode-map "e" #'exco-calendar-show-day)
+
+(provide 'excorporate-calendar)
+
+;;; excorporate-calendar.el ends here
diff --git a/packages/excorporate/excorporate-calfw.el.txt
b/packages/excorporate/excorporate-calfw.el.txt
new file mode 100644
index 0000000..ad31ae9
--- /dev/null
+++ b/packages/excorporate/excorporate-calfw.el.txt
@@ -0,0 +1,128 @@
+;;; excorporate-calfw.el --- Exchange calendar view -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Keywords: calendar
+
+;; 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Use the Calfw calendar framework to display daily meetings.
+
+;; To use this handler, set excorporate-calendar-show-day to
+;; exco-calfw-show-day using `customize-variable'.
+
+;; This Excorporate handler requires the Calfw package, which is not
+;; included in GNU ELPA because not all Calfw contributors have
+;; copyright assignment papers on file with the FSF.
+
+;;; Code:
+
+(require 'calfw)
+(require 'excorporate)
+
+(defvar excorporate-calfw-buffer-name "*Excorporate*"
+ "The buffer into which Calfw output is inserted.")
+
+(defun exco-calfw-initialize-buffer (month day year)
+ "Set up an initial blank Calfw buffer for date MONTH DAY YEAR."
+ (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
+ (display-buffer (current-buffer))
+ (let ((status-source (make-cfw:source :name "Updating..."
+ :data (lambda (_b _e) nil))))
+ (cfw:create-calendar-component-buffer
+ :date (cfw:date month day year) :view 'day
+ :contents-sources (list status-source)
+ :buffer (current-buffer)))))
+
+(defun exco-calfw-add-meeting (subject start end location
+ main-invitees optional-invitees)
+ "Add a scheduled meeting to the event list.
+SUBJECT is a string, the subject of the meeting. START is the
+meeting start time in Emacs internal date time format, and END is
+the end of the meeting in the same format. LOCATION is a string
+representing the location. MAIN-INVITEES and OPTIONAL-INVITEES
+are the requested participants."
+ (let ((start-list (decode-time start))
+ (end-list (decode-time end)))
+ (make-cfw:event :title (concat
+ (format "\n\t%s" subject)
+ (format "\n\tLocation: %s" location)
+ (format "\n\tInvitees: %s"
+ (mapconcat 'identity
+ main-invitees
+ "; "))
+ (when optional-invitees
+ (format "\n\tOptional: %s"
+ (mapconcat 'identity
+ optional-invitees "; "))))
+ :start-date (list (elt start-list 4)
+ (elt start-list 3)
+ (elt start-list 5))
+ :start-time (list (elt start-list 2)
+ (elt start-list 1))
+ :end-date (list (elt end-list 4)
+ (elt end-list 3)
+ (elt end-list 5))
+ :end-time (list (elt end-list 2)
+ (elt end-list 1)))))
+
+(defun exco-calfw-add-meetings (identifier response)
+ "Add the connection IDENTIFIER's meetings from RESPONSE."
+ (let ((event-list (exco-calendar-item-iterate response
+ #'exco-calfw-add-meeting)))
+ (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
+ (declare (special cfw:component))
+ (let* ((new-source (make-cfw:source
+ :name (format "%S (as of %s)"
+ identifier
+ (format-time-string "%F %H:%M"))
+ :data (lambda (_b _e)
+ event-list)))
+ (sources (cfw:cp-get-contents-sources cfw:component))
+ (new-sources (append sources (list new-source))))
+ (cfw:cp-set-contents-sources cfw:component new-sources)))))
+
+(defun exco-calfw-finalize-buffer ()
+ "Finalize the Calfw widget after retrievals have completed."
+ (with-current-buffer (get-buffer-create excorporate-calfw-buffer-name)
+ (declare (special cfw:component))
+ (let ((sources (cfw:cp-get-contents-sources cfw:component))
+ (status-source (make-cfw:source :name "Done."
+ :data (lambda (_b _e) nil))))
+ (cfw:cp-set-contents-sources cfw:component
+ (cons status-source (cdr sources))))
+ (cfw:cp-add-selection-change-hook cfw:component
+ (lambda ()
+ (apply #'exco-calfw-show-day
+ (cfw:cursor-to-nearest-date))))
+ (cfw:refresh-calendar-buffer nil)))
+
+;;;###autoload
+(defun exco-calfw-show-day (month day year)
+ "Show meetings for the date specified by MONTH DAY YEAR."
+ (exco-connection-iterate
+ (lambda ()
+ (exco-calfw-initialize-buffer month day year))
+ (lambda (identifier callback)
+ (exco-get-meetings-for-day identifier month day year
+ callback))
+ #'exco-calfw-add-meetings
+ #'exco-calfw-finalize-buffer))
+
+(provide 'excorporate-calfw)
+
+;;; excorporate-calfw.el ends here
diff --git a/packages/excorporate/excorporate-org.el
b/packages/excorporate/excorporate-org.el
new file mode 100644
index 0000000..8613f8e
--- /dev/null
+++ b/packages/excorporate/excorporate-org.el
@@ -0,0 +1,141 @@
+;;; excorporate-org.el --- Exchange Org Mode view -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Keywords: calendar
+
+;; 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Use the Org Mode to display daily meetings.
+
+;;; Code:
+
+(require 'org)
+(require 'excorporate)
+
+(defvar excorporate-org-buffer-name "*Excorporate*"
+ "The buffer into which Org Mode output is inserted.")
+
+(defun exco-org-initialize-buffer ()
+ "Add initial text to the destination buffer."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ (setq buffer-read-only t)
+ (org-mode)
+ (display-buffer (current-buffer))
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))
+ (goto-char 1)
+ (insert "# Updated...\n"))))
+
+(defun exco-org-format-headline (identifier)
+ "Format an Org headline using IDENTIFIER."
+ (format "* Calendar (%s)\n" identifier))
+
+(defun exco-org-insert-meeting-headline (subject start-time end-time)
+ "Insert and schedule a meeting.
+SUBJECT is the meeting's subject, START-TIME and END-TIME are the
+meeting's start and end times in the same format as is returned
+by `current-time'."
+ (let* ((now (current-time))
+ (keyword (if (time-less-p now end-time)
+ "TODO"
+ "DONE")))
+ (insert (format "** %s %s\n" keyword subject))
+ (org-schedule nil (format-time-string "<%Y-%m-%d %a %H:%M>"
+ start-time))
+ (forward-line -1)
+ (end-of-line)
+ (insert "--" (format-time-string "<%Y-%m-%d %a %H:%M>" end-time))
+ (forward-line)
+ (org-insert-time-stamp (current-time) t t "+ Retrieved " "\n")))
+
+(defun exco-org-insert-invitees (invitees)
+ "Parse and insert a list of invitees, INVITEES."
+ (dolist (invitee invitees)
+ (insert (format " + %s\n" invitee))))
+
+(defun exco-org-insert-headline (identifier month day year)
+ "Insert Org headline for IDENTIFIER on date MONTH DAY YEAR."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ (let ((inhibit-read-only t))
+ (insert (exco-org-format-headline identifier))
+ (org-insert-time-stamp (encode-time 0 0 0 day month year)
+ nil t " + Date " "\n"))))
+
+(defun exco-org-insert-meeting (subject start end location
+ main-invitees optional-invitees)
+ "Insert a scheduled meeting.
+SUBJECT is a string, the subject of the meeting. START is the
+meeting start time in Emacs internal date time format, and END is
+the end of the meeting in the same format. LOCATION is a string
+representing the location. MAIN-INVITEES and OPTIONAL-INVITEES
+are the requested participants."
+ (exco-org-insert-meeting-headline subject start end)
+ (insert (format "+ Duration: %d minutes\n"
+ (round (/ (float-time (time-subtract end start)) 60.0))))
+ (insert (format "+ Location: %s\n" location))
+ (insert "+ Invitees:\n")
+ (exco-org-insert-invitees main-invitees)
+ (when optional-invitees
+ (insert "+ Optional invitees:\n")
+ (exco-org-insert-invitees optional-invitees)))
+
+(defun exco-org-insert-meetings (identifier response)
+ "Insert the connection IDENTIFIER's meetings from RESPONSE."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ (let ((inhibit-read-only t)
+ (name-regexp (concat "\\" (exco-org-format-headline identifier))))
+ (goto-char 1)
+ (end-of-line)
+ (insert (format "%s..." identifier))
+ (goto-char (point-max))
+ (re-search-backward name-regexp nil)
+ (forward-line 2)
+ (org-insert-time-stamp (current-time) t t " + Last checked " "\n")
+ (exco-calendar-item-iterate response #'exco-org-insert-meeting)
+ (re-search-backward name-regexp nil)
+ (if (save-excursion (org-goto-first-child))
+ (org-sort-entries t ?s)
+ (forward-line 3)
+ (insert "`♘")))))
+
+(defun exco-org-finalize-buffer ()
+ "Finalize text in buffer after all connections have responded."
+ (with-current-buffer (get-buffer-create excorporate-org-buffer-name)
+ ;; Sort top-level entries alphabetically.
+ (let ((inhibit-read-only t))
+ (goto-char (point-min))
+ (end-of-line)
+ (insert "done.")
+ (org-sort-entries t ?a))))
+
+;;;###autoload
+(defun exco-org-show-day (month day year)
+ "Show meetings for the date specified by MONTH DAY YEAR."
+ (exco-connection-iterate #'exco-org-initialize-buffer
+ (lambda (identifier callback)
+ (exco-org-insert-headline identifier
+ month day year)
+ (exco-get-meetings-for-day identifier
+ month day year
+ callback))
+ #'exco-org-insert-meetings
+ #'exco-org-finalize-buffer))
+
+(provide 'excorporate-org)
+
+;;; excorporate-org.el ends here
diff --git a/packages/excorporate/excorporate.el
b/packages/excorporate/excorporate.el
new file mode 100644
index 0000000..80f3c33
--- /dev/null
+++ b/packages/excorporate/excorporate.el
@@ -0,0 +1,786 @@
+;;; excorporate.el --- Exchange integration -*- lexical-binding: t
-*-
+
+;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
+
+;; Author: Thomas Fitzsimmons <address@hidden>
+;; Maintainer: Thomas Fitzsimmons <address@hidden>
+;; Created: 2014-09-19
+;; Version: 0.7.0
+;; Keywords: calendar
+;; Homepage: https://www.fitzsim.org/blog/
+;; Package-Requires: ((emacs "24.1") (fsm "0.2") (soap-client "3.0.2")
(url-http-ntlm "2.0.2"))
+
+;; 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, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Excorporate provides Exchange integration for Emacs.
+
+;; To create a connection to a web service:
+
+;; M-x excorporate
+
+;; Excorporate will prompt for an email address that it will use to
+;; automatically discover settings. Then it will connect to two or
+;; three separate hosts: the autodiscovery host, the web service host
+;; or load balancer, and the actual server if there is a load
+;; balancer. Therefore you may be prompted for your credentials two
+;; or three times.
+
+;; You should see a message indicating that the connection is ready
+;; either in the minibuffer or failing that in the *Messages* buffer.
+
+;; Finally, run M-x calendar, and press 'e' to show today's meetings.
+
+;; Please try autodiscovery first and report issues not yet listed
+;; below. When autodiscovery works it is very convenient; the goal is
+;; to make it work for as many users as possible.
+
+;; If autodiscovery fails, customize `excorporate-configuration' to
+;; skip autodiscovery.
+
+;; Autodiscovery will fail if:
+
+;; - Excorporate is accessing the server through a proxy (Emacs
+;; bug#10).
+
+;; - The server is not configured to support autodiscovery.
+
+;; - The email address is at a different domain than the server, e.g.,
+;; address@hidden, autodiscover.domain2.com.
+
+;; - Authentication is Kerberos/GSSAPI.
+
+;; Excorporate does know about the special case where the mail address
+;; is at a subdomain, e.g., address@hidden, and the server is at
+;; the main domain, e.g., autodiscover.domain.com. Autodiscovery will
+;; work in that case.
+
+;; Excorporate must be loaded before any other package that requires
+;; `soap-client'. The version of `soap-client' that Excorporate
+;; bundles is backward compatible.
+
+;; Acknowledgments:
+
+;; Alexandru Harsanyi <address@hidden> provided help and
+;; guidance on how to extend soap-client.el's WSDL and XSD handling,
+;; enabling support for the full Exchange Web Services API.
+
+;; Alex Luccisano <address@hidden> tested early versions of
+;; this library against a corporate installation of Exchange.
+
+;; Jon Miller <address@hidden> tested against Exchange 2013. He
+;; also tracked down and reported a bad interaction with other
+;; packages that require soap-client.
+
+;; Nicolas Lamirault <address@hidden> tested the
+;; autodiscovery feature.
+
+;; Trey Jackson <address@hidden> confirmed autodiscovery worked
+;; for him.
+
+;; Joakim Verona <address@hidden> tested autodiscovery in a
+;; Kerberos/GSSAPI environment.
+
+;; Wilfred Hughes <address@hidden> tested on Exchange 2007 and
+;; suggested documentation improvements.
+
+;;; Code:
+
+;; Implementation-visible functions and variables.
+
+;; Add NTLM authorization scheme.
+(require 'url-http-ntlm)
+(require 'soap-client)
+(require 'fsm)
+(require 'excorporate-calendar)
+
+(defconst exco--autodiscovery-templates
+ '("https://%s/autodiscover/autodiscover.svc";
+ "https://autodiscover.%s/autodiscover/autodiscover.svc";)
+ "Autodiscovery URL templates.
+URL templates to be formatted with a domain name, then searched
+for autodiscovery files.")
+
+(defvar exco--connections nil
+ "A hash table of finite state machines.
+The key is the identifier passed to `exco-connect'. Each finite
+state machine represents a service connection.")
+
+(defvar exco--connection-identifiers nil
+ "An ordered list of connection identifiers.")
+
+(defun exco--parse-xml-in-current-buffer ()
+ "Decode and parse the XML contents of the current buffer."
+ (let ((mime-part (mm-dissect-buffer t t)))
+ (unless mime-part
+ (error "Failed to decode response from server"))
+ (unless (equal (car (mm-handle-type mime-part)) "text/xml")
+ (error "Server response is not an XML document"))
+ (with-temp-buffer
+ (mm-insert-part mime-part)
+ (prog1
+ (car (xml-parse-region (point-min) (point-max)))
+ (kill-buffer)
+ (mm-destroy-part mime-part)))))
+
+(defun exco--bind-wsdl (wsdl service-url port-name target-namespace
+ binding-name)
+ "Create a WSDL binding.
+Create a binding port for WSDL from SERVICE-URL, PORT-NAME,
+TARGET-NAMESPACE and BINDING-NAME."
+ (let* ((namespace (soap-wsdl-find-namespace target-namespace wsdl))
+ (port (make-soap-port
+ :name port-name
+ :binding (cons target-namespace binding-name)
+ :service-url service-url)))
+ (soap-namespace-put port namespace)
+ (push port (soap-wsdl-ports wsdl))
+ (soap-resolve-references port wsdl)
+ wsdl))
+
+(defun exco--handle-url-error (url status)
+ "Handle an error that occurred when retrieving URL.
+The details of the error are in STATUS, in the same format as the
+argument to a `url-retrieve' callback. Return non-nil to retry,
+nil to continue."
+ (if (eq (cl-third (plist-get status :error)) 500)
+ ;; The server reported an internal server error. Try to recover
+ ;; by re-requesting the target URL and its most recent redirect.
+ ;; I'm not sure what conditions cause the server to get into
+ ;; this state -- it might be because the server has stale
+ ;; knowledge of old keepalive connections -- but this should
+ ;; recover it. We need to disable ntlm in
+ ;; url-registered-auth-schemes so that it doesn't prevent
+ ;; setting keepalives to nil.
+ (let ((url-registered-auth-schemes nil)
+ (url-http-attempt-keepalives nil)
+ (redirect (plist-get status :redirect)))
+ (fsm-debug-output "exco--fsm received 500 error for %s" url)
+ (url-debug 'excorporate "Attempting 500 recovery")
+ (ignore-errors
+ ;; Emacs's url-retrieve does not respect the values of
+ ;; url-http-attempt-keepalives and
+ ;; url-registered-auth-schemes in asynchronous contexts.
+ ;; Unless url.el is eventually changed to do so, the
+ ;; following requests must be synchronous so that they run
+ ;; entirely within url-http-attempt-keepalives's dynamic
+ ;; extent. These calls block the main event loop,
+ ;; unfortunately, but only in this rare error recovery
+ ;; scenario.
+ (url-retrieve-synchronously url)
+ (when redirect (url-retrieve-synchronously redirect)))
+ (url-debug 'excorporate "Done 500 recovery attempt")
+ ;; Retry.
+ t)
+ ;; We received some other error, which just
+ ;; means we should try the next URL.
+ (fsm-debug-output "exco--fsm didn't find %s" url)
+ ;; Don't retry.
+ nil))
+
+(defun exco--retrieve-next-import (fsm state-data return-for next-state)
+ "Retrieve the next XML schema import.
+FSM is the finite state machine, STATE-DATA is FSM's state data,
+and RETURN-FOR is one of :enter or :event to indicate what return
+type the calling function expects. NEXT-STATE is the next state
+the FSM should transition to on success."
+ (let* ((url (plist-get state-data :service-url))
+ (xml (plist-get state-data :service-xml))
+ (wsdl (plist-get state-data :service-wsdl))
+ (imports (soap-wsdl-xmlschema-imports wsdl))
+ (next-state (if imports :parsing-service-wsdl next-state)))
+ (when imports
+ (let ((import-url (url-expand-file-name (pop imports) url)))
+ (let ((url-request-method "GET")
+ (url-package-name "soap-client.el")
+ (url-package-version "1.0")
+ (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
+ (url-http-attempt-keepalives t))
+ (url-retrieve
+ import-url
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (url-debug 'excorporate "Processing import %s" status)
+ (if (eq (car status) :error)
+ ;; There is an error. It may be recoverable
+ ;; if it's HTTP 500 (internal server error).
+ (if (and (exco--handle-url-error import-url status)
+ ;; Only retry once.
+ (not (plist-get state-data :retrying)))
+ ;; We should retry. Don't save the
+ ;; popped urls list to state-data, so
+ ;; that this :try-next-url will
+ ;; re-attempt to retrieve the same car as
+ ;; before. Set the retry flag.
+ (progn
+ (plist-put state-data :retrying t))
+ ;; Save the popped urls list so that the next url
+ ;; is attempted, and clear the retry flag.
+ (plist-put state-data :retrying nil)
+ (setf (soap-wsdl-xmlschema-imports wsdl) imports)
+ (plist-put state-data :failure-message
+ (format "Failed to retrieve %s"
+ import-url))
+ (fsm-send fsm :unrecoverable-error))
+ ;; Success, parse WSDL.
+ (plist-put state-data :retrying nil)
+ (setf (soap-wsdl-xmlschema-imports wsdl) imports)
+ (soap-with-local-xmlns xml
+ (soap-wsdl-add-namespace
+ (soap-parse-schema (soap-parse-server-response) wsdl)
+ wsdl))
+ (plist-put state-data :service-wsdl wsdl)))
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer))))
+ (fsm-send fsm t))))))
+ (if (eq return-for :enter)
+ (list state-data nil)
+ (list next-state state-data nil))))
+
+(define-state-machine exco--fsm :start
+ ((identifier)
+ "Start an Excorporate finite state machine."
+ (if (stringp identifier)
+ (let ((domain (cadr (split-string identifier "@"))))
+ (unless (and domain (not (equal domain "")))
+ (error "Invalid domain for address %s" identifier))
+ (list :retrieving-autodiscovery-xml
+ (list
+ ;; State machine data.
+ ;; Unique finite state machine identifier. Either mail-address
+ ;; or (mail-address . service-url). The latter allows multiple
+ ;; state machines to operate on the same service URL. Login
+ ;; credentials are handled separately by auth-source and url,
+ ;; so these should be the only two identifier types needed here.
+ :identifier identifier
+ ;; User data.
+ :mail-address identifier
+ ;; Error recovery data.
+ :retrying nil
+ ;; Autodiscovery data.
+ :autodiscovery-urls
+ (append (mapcar (lambda (template)
+ (format template domain))
+ exco--autodiscovery-templates)
+ ;; Handle the address@hidden =>
+ ;; autodiscover.domain.com case reported by a
+ ;; user. Only try one extra level.
+ (let ((domain-parts (split-string domain "\\.")))
+ (when (> (length domain-parts) 2)
+ (mapcar (lambda (template)
+ (format template
+ (mapconcat
+ 'identity
+ (cdr domain-parts) ".")))
+ exco--autodiscovery-templates))))
+ ;; Service data.
+ :service-url nil
+ :service-xml nil
+ :service-wsdl nil
+ ;; State data.
+ :next-state-after-success nil
+ :failure-message nil
+ :server-version nil)
+ ;; No timeout.
+ nil))
+ ;; Go directly to :retrieving-service-xml, skipping autodiscovery.
+ (list :retrieving-service-xml
+ (list
+ :identifier identifier
+ :mail-address (car identifier)
+ :retrying nil
+ :autodiscovery-urls nil
+ ;; Use service-url field from identifier.
+ :service-url (cdr identifier)
+ :service-xml nil
+ :service-wsdl nil
+ :next-state-after-success nil
+ :failure-message nil
+ :server-version nil)
+ ;; No timeout.
+ nil))))
+
+(define-state exco--fsm :retrieving-autodiscovery-xml
+ (fsm state-data event _callback)
+ (cl-case event
+ (:try-next-url
+ (let ((urls (plist-get state-data :autodiscovery-urls)))
+ (if urls
+ (let ((url (pop urls)))
+ (fsm-debug-output "exco--fsm will probe %s" url)
+ (condition-case nil
+ (url-retrieve
+ url
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (progn
+ (url-debug 'excorporate
+ "Processing status: %s" status)
+ (if (eq (car status) :error)
+ (progn
+ (if (and
+ (exco--handle-url-error url status)
+ ;; Only retry once.
+ (not (plist-get state-data :retrying)))
+ ;; We should retry. Don't save the popped
+ ;; urls list to state-data, so that this
+ ;; :try-next-url will re-attempt to
+ ;; retrieve the same car as before. Set
+ ;; the retry flag.
+ (plist-put state-data :retrying t)
+ ;; Save the popped urls list so that the
+ ;; next url is attempted, and clear the
+ ;; retry flag.
+ (plist-put state-data :retrying nil)
+ (plist-put state-data
+ :autodiscovery-urls urls))
+ ;; Try next or retry.
+ (fsm-send fsm :try-next-url))
+ ;; Success, save URL and parse returned XML.
+ (message
+ "Excorporate: Found autodiscovery URL for %S: %s"
+ (plist-get state-data :identifier) url)
+ (plist-put state-data :retrying nil)
+ (plist-put state-data :service-url url)
+ (plist-put state-data :service-xml
+ (exco--parse-xml-in-current-buffer))
+ (fsm-send fsm :success))
+ (url-debug 'excorporate "Done processing status"))
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer))))))
+ (error
+ (fsm-debug-output "exco--fsm connection refused for %s" url)
+ (plist-put state-data :retrying nil)
+ (plist-put state-data :autodiscovery-urls urls)
+ (fsm-send fsm :try-next-url)))
+ (list :retrieving-autodiscovery-xml state-data nil))
+ (plist-put state-data :failure-message
+ "Autodiscovery ran out of URLs to try")
+ (list :shutting-down-on-error state-data nil))))
+ (:success
+ (plist-put state-data :next-state-after-success :retrieving-service-xml)
+ (list :parsing-service-wsdl state-data nil))))
+
+(define-enter-state exco--fsm :shutting-down-on-error
+ (_fsm state-data)
+ (let ((failure-message (plist-get state-data :failure-message)))
+ (exco-disconnect (plist-get state-data :identifier))
+ (message "Excorporate: %s" failure-message)
+ (url-debug 'excorporate "Failed: %s" failure-message)
+ (fsm-debug-output "exco--fsm failed: %s" failure-message))
+ (list state-data nil))
+
+(define-state exco--fsm :shutting-down-on-error
+ (_fsm state-data _event _callback)
+ (list :shutting-down-on-error state-data nil))
+
+(define-enter-state exco--fsm :retrieving-service-xml
+ (fsm state-data)
+ (when (stringp (plist-get state-data :identifier))
+ (let* ((xml (plist-get state-data :service-xml))
+ (unbound-wsdl (plist-get state-data :service-wsdl))
+ (wsdl
+ (progn
+ ;; Skip soap-parse-wsdl-phase-fetch-schema to avoid
+ ;; synchronous URL fetches.
+ (soap-parse-wsdl-phase-finish-parsing xml unbound-wsdl)
+ (exco--bind-wsdl
+ (soap-wsdl-resolve-references unbound-wsdl)
+ (plist-get state-data :service-url)
+ "AutodiscoverServicePort"
+ "http://schemas.microsoft.com/exchange/2010/Autodiscover";
+ "DefaultBinding_Autodiscover"))))
+ (soap-invoke-async
+ (lambda (response)
+ (let ((result-url
+ (exco-extract-value '(Response
+ UserResponses
+ UserResponse
+ UserSettings
+ UserSetting
+ Value)
+ response)))
+ (if result-url
+ (progn
+ (plist-put state-data :service-url result-url)
+ (message "Excorporate: Found service URL for %S: %s"
+ (plist-get state-data :identifier)
+ (plist-get state-data :service-url)))
+ ;; No result. Check for error.
+ (let ((error-message
+ (exco-extract-value '(Response
+ UserResponses
+ UserResponse
+ ErrorMessage)
+ response)))
+ (if error-message
+ (message "Excorporate: %s" error-message)
+ (message "Excorporate: Failed to find service URL"))))
+ (fsm-send fsm :retrieve-xml)))
+ nil
+ wsdl
+ "AutodiscoverServicePort"
+ "GetUserSettings"
+ `((RequestedServerVersion . "Exchange2010")
+ (Request
+ (Users
+ (User
+ (Mailbox . ,(plist-get state-data :mail-address))))
+ (RequestedSettings
+ (Setting . "InternalEwsUrl")))))))
+ (list state-data nil))
+
+(define-state exco--fsm :retrieving-service-xml
+ (fsm state-data event _callback)
+ (cl-case event
+ (:unrecoverable-error
+ (list :shutting-down-on-error state-data nil))
+ (:retrieve-xml
+ (let ((service-url (plist-get state-data :service-url)))
+ (url-retrieve (concat service-url "?wsdl")
+ (lambda (status)
+ (let ((data-buffer (current-buffer)))
+ (unwind-protect
+ (if (eq (car status) :error)
+ (progn
+ (plist-put state-data :failure-message
+ (format "Failed to retrieve %s"
+ service-url))
+ (fsm-send fsm :unrecoverable-error))
+ (plist-put state-data
+ :service-xml
+ (exco--parse-xml-in-current-buffer))
+ (fsm-send fsm :success))
+ (and (buffer-live-p data-buffer)
+ (kill-buffer data-buffer)))))))
+ (list :retrieving-service-xml state-data nil))
+ (:success
+ (plist-put state-data :next-state-after-success :retrieving-data)
+ (list :parsing-service-wsdl state-data nil))))
+
+(define-enter-state exco--fsm :parsing-service-wsdl
+ (fsm state-data)
+ (let* ((url (plist-get state-data :service-url))
+ (xml (plist-get state-data :service-xml))
+ (next-state (plist-get state-data :next-state-after-success))
+ (wsdl (soap-make-wsdl url)))
+ (soap-parse-wsdl-phase-validate-node xml)
+ ;; Skip soap-parse-wsdl-phase-fetch-imports to avoid synchronous
+ ;; fetches of import URLs.
+ (soap-parse-wsdl-phase-parse-schema xml wsdl)
+ (plist-put state-data :service-wsdl wsdl)
+ (exco--retrieve-next-import fsm state-data :enter next-state)))
+
+(define-state exco--fsm :parsing-service-wsdl
+ (fsm state-data event _callback)
+ (if (eq event :unrecoverable-error)
+ (list :shutting-down-on-error state-data nil)
+ (let ((next-state (plist-get state-data :next-state-after-success)))
+ (exco--retrieve-next-import fsm state-data :event next-state))))
+
+(defun exco--get-server-version (wsdl)
+ "Extract server version from WSDL."
+ (catch 'found
+ (dolist (attribute
+ (soap-xs-type-attributes
+ (soap-xs-element-type
+ (soap-wsdl-get
+ '("http://schemas.microsoft.com/exchange/services/2006/types";
+ . "RequestServerVersion")
+ wsdl 'soap-xs-element-p))))
+ (when (equal (soap-xs-attribute-name attribute) "Version")
+ (throw 'found (soap-xs-attribute-default attribute))))
+ (warn "Excorporate: Failed to determine server version")
+ nil))
+
+(define-enter-state exco--fsm :retrieving-data
+ (_fsm state-data)
+ (let ((wsdl (plist-get state-data :service-wsdl))
+ (identifier (plist-get state-data :identifier)))
+ ;; Skip soap-parse-wsdl-phase-fetch-schema to avoid synchronous
+ ;; URL fetches.
+ (soap-parse-wsdl-phase-finish-parsing (plist-get state-data :service-xml)
+ wsdl)
+ (exco--bind-wsdl
+ (soap-wsdl-resolve-references wsdl)
+ (plist-get state-data :service-url)
+ "ExchangeServicePort"
+ "http://schemas.microsoft.com/exchange/services/2006/messages";
+ "ExchangeServiceBinding")
+ (plist-put state-data :server-version (exco--get-server-version wsdl))
+ (fsm-debug-output "exco--fsm %s server version is %s"
+ identifier (exco-server-version identifier))
+ (message "Excorporate: Connection %S is ready" identifier))
+ (list state-data nil))
+
+(define-state exco--fsm :retrieving-data
+ (_fsm state-data event _callback)
+ (let* ((identifier (plist-get state-data :identifier))
+ (wsdl (plist-get state-data :service-wsdl))
+ (name (pop event))
+ (arguments (pop event))
+ (callback (pop event)))
+ (apply #'soap-invoke-async
+ (lambda (response)
+ (funcall callback identifier response))
+ nil
+ wsdl
+ "ExchangeServicePort"
+ name
+ arguments))
+ (list :retrieving-data state-data nil))
+
+(defun exco--ensure-connection ()
+ "Ensure at least one connection exists or throw an error."
+ (unless exco--connection-identifiers
+ (error "Excorporate: No connections exist. Run M-x excorporate")))
+
+(defmacro exco--with-fsm (identifier &rest body)
+ "With `fsm' set to IDENTIFIER, run BODY.
+Run BODY with `fsm' set to the finite state machine specified by
+IDENTIFIER."
+ (declare (indent 1) (debug t))
+ `(progn
+ (exco--ensure-connection)
+ (let ((fsm (gethash ,identifier exco--connections)))
+ (unless fsm
+ (error "Excorporate: Connection %S does not exist" ,identifier))
+ ,@body)))
+
+;; Developer-visible functions and variables.
+
+(defun exco-api-version ()
+ "Return the Excorporate API version.
+Return a non-negative integer representing the current
+Excorporate application programming interface version. Version 0
+is subject to change."
+ 0)
+
+(defun exco-connect (identifier)
+ "Connect or reconnect to a web service.
+IDENTIFIER is the mail address to use for autodiscovery or a
+pair (mail-address . service-url)."
+ (if (stringp identifier)
+ (message "Excorporate: Starting autodiscovery for %S"
+ identifier))
+ (let ((fsm (start-exco--fsm identifier)))
+ (unless exco--connections
+ (setq exco--connections (make-hash-table :test 'equal)))
+ (when (gethash identifier exco--connections)
+ (exco-disconnect identifier))
+ (puthash identifier fsm exco--connections)
+ (push identifier exco--connection-identifiers)
+ (if (stringp identifier)
+ (fsm-send fsm :try-next-url)
+ (fsm-send fsm :retrieve-xml))
+ nil))
+
+(defun exco-operate (identifier name arguments callback)
+ "Execute a service operation asynchronously.
+IDENTIFIER is the connection identifier. Execute operation NAME
+with ARGUMENTS then call CALLBACK with two arguments, IDENTIFIER
+and the server's response."
+ (exco--with-fsm identifier
+ (fsm-send fsm (list name arguments callback)))
+ nil)
+
+(defun exco-server-version (identifier)
+ "Return the server version for connection IDENTIFIER, as a string.
+Examples are \"Exchange2010\", \"Exchange2010_SP1\",
+\"Exchange2013\"."
+ (exco--with-fsm identifier
+ (plist-get (fsm-get-state-data fsm) :server-version)))
+
+(defun exco-disconnect (identifier)
+ "Disconnect from a web service.
+IDENTIFIER is the mail address used to look up the connection."
+ (exco--with-fsm identifier
+ (setq exco--connection-identifiers
+ (delete identifier exco--connection-identifiers))
+ (remhash identifier exco--connections))
+ nil)
+
+(defun exco-extract-value (path result)
+ "Extract the value at PATH from RESULT.
+PATH is an ordered list of node names."
+ (let ((values (nreverse (car result))))
+ (dolist (path-element path)
+ (setq values (assoc path-element values)))
+ (cdr values)))
+
+(defun exco-calendar-item-iterate (response callback)
+ "Iterate through calendar items in RESPONSE, calling CALLBACK on each.
+Returns a list of results from callback. CALLBACK takes arguments:
+SUBJECT, a string, the subject of the meeting.
+START, the start date and time in Emacs internal representation.
+END, the start date and time in Emacs internal representation.
+LOCATION, the location of the meeting.
+MAIN-INVITEES, a list of strings representing required participants.
+OPTIONAL-INVITEES, a list of strings representing optional participants."
+ (let ((result-list '()))
+ (dolist (calendar-item (exco-extract-value '(ResponseMessages
+ FindItemResponseMessage
+ RootFolder
+ Items)
+ response))
+ (let* ((subject (cdr (assoc 'Subject calendar-item)))
+ (start (cdr (assoc 'Start calendar-item)))
+ (start-internal (apply #'encode-time
+ (soap-decode-date-time
+ start 'dateTime)))
+ (end (cdr (assoc 'End calendar-item)))
+ (end-internal (apply #'encode-time
+ (soap-decode-date-time
+ end 'dateTime)))
+ (location (cdr (assoc 'Location calendar-item)))
+ (to-invitees (cdr (assoc 'DisplayTo calendar-item)))
+ (main-invitees (mapcar 'org-trim (split-string to-invitees ";")))
+ (cc-invitees (cdr (assoc 'DisplayCc calendar-item)))
+ (optional-invitees (when cc-invitees
+ (mapcar 'org-trim
+ (split-string cc-invitees ";")))))
+ (push (funcall callback subject start-internal end-internal
+ location main-invitees optional-invitees)
+ result-list)))
+ (nreverse result-list)))
+
+;; Date-time utility functions.
+(defun exco-extend-timezone (date-time-string)
+ "Add a colon to the timezone in DATE-TIME-STRING.
+DATE-TIME-STRING must be formatted as if returned by
+`format-time-string' with FORMAT-STRING \"%FT%T%z\". Web
+services require the ISO8601 extended format of timezone, which
+includes the colon."
+ (concat
+ (substring date-time-string 0 22) ":" (substring date-time-string 22)))
+
+(defun exco-format-date-time (time-internal)
+ "Convert TIME-INTERNAL to an XSD compatible date-time string."
+ (exco-extend-timezone
+ (format-time-string "%FT%T%z" time-internal)))
+
+;; Use month day year order to be compatible with
+;; calendar-cursor-to-date. I wish I could instead use the ISO 8601
+;; ordering, year month day.
+(defun exco-get-meetings-for-day (identifier month day year callback)
+ "Return the meetings for the specified day.
+IDENTIFIER is the connection identifier. MONTH, DAY and YEAR are
+the meeting month, day and year. Call CALLBACK with two
+arguments, IDENTIFIER and the server's response."
+ (let* ((start-of-day-time-internal
+ (apply #'encode-time `(0 0 0 ,day ,month ,year)))
+ (start-of-day-date-time
+ (exco-format-date-time start-of-day-time-internal))
+ (start-of-next-day-date-time
+ (exco-extend-timezone
+ (format-time-string "%FT00:00:00%z"
+ (time-add start-of-day-time-internal
+ (seconds-to-time 86400))))))
+ (exco-operate
+ identifier
+ "FindItem"
+ `(;; Main arguments.
+ ((Traversal . "Shallow")
+ (ItemShape
+ (BaseShape . "AllProperties"))
+ ;; To aid productivity, excorporate-calfw automatically prunes your
+ ;; meetings to a maximum of 100 per day.
+ (CalendarView (MaxEntriesReturned . "100")
+ (StartDate . ,start-of-day-date-time)
+ (EndDate . ,start-of-next-day-date-time))
+ (ParentFolderIds
+ (DistinguishedFolderId (Id . "calendar"))))
+ ;; Empty arguments.
+ ,@(let ((server-major-version
+ (string-to-number
+ (substring (exco-server-version identifier) 8 12))))
+ (cond
+ ((<= server-major-version 2007)
+ '(nil nil nil nil))
+ ((< server-major-version 2013)
+ '(nil nil nil nil nil))
+ (t
+ '(nil nil nil nil nil nil)))))
+ callback)))
+
+(defun exco-connection-iterate (initialize-function
+ per-connection-function
+ per-connection-callback
+ finalize-function)
+ "Iterate Excorporate connections.
+Call INITIALIZE-FUNCTION once before iterating.
+Call PER-CONNECTION-FUNCTION for each connection.
+Pass PER-CONNECTION-CALLBACK to PER-CONNECTION-FUNCTION.
+Call FINALIZE-FUNCTION after all operations have responded."
+ (exco--ensure-connection)
+ (funcall initialize-function)
+ (let ((responses 0)
+ (connection-count (length exco--connection-identifiers)))
+ (dolist (identifier exco--connection-identifiers)
+ (funcall per-connection-function identifier
+ (lambda (&rest arguments)
+ (setq responses (1+ responses))
+ (apply per-connection-callback arguments)
+ (when (equal responses connection-count)
+ (funcall finalize-function)))))))
+
+;; User-visible functions and variables.
+(defgroup excorporate nil
+ "Exchange support."
+ :version "25.1"
+ :group 'comm
+ :group 'calendar)
+
+;; Name the excorporate-configuration variable vaguely. It is currently a
+;; MAIL-ADDRESS string, a pair (MAIL-ADDRESS . SERVICE-URL), or nil. In the
+;; future it could allow a list of strings and pairs.
+(defcustom excorporate-configuration nil
+ "Excorporate configuration.
+The mail address to use for autodiscovery."
+ :type '(choice
+ (const
+ :tag "Prompt for Exchange mail address to use for autodiscovery" nil)
+ (string :tag "Exchange mail address to use for autodiscovery")
+ (cons :tag "Skip autodiscovery"
+ (string :tag "Exchange mail address (e.g., address@hidden)")
+ (string :tag "Exchange Web Services URL\
+ (e.g., https://mail.gnu.org/ews/exchange.asmx)"))))
+
+;;;###autoload
+(defun excorporate ()
+ "Start Excorporate.
+Prompt for a mail address to use for autodiscovery, with an
+initial suggestion of `user-mail-address'. However, if
+`excorporate-configuration' is non-nil, `excorporate' will use
+that without prompting."
+ (interactive)
+ (cond
+ ((eq excorporate-configuration nil)
+ (exco-connect (completing-read "Exchange mail address: "
+ (list user-mail-address)
+ nil nil user-mail-address)))
+ ((stringp excorporate-configuration)
+ (exco-connect excorporate-configuration))
+ ((null (consp (cdr excorporate-configuration)))
+ (exco-connect excorporate-configuration))
+ (t
+ (error "Excorporate: Invalid configuration"))))
+
+(provide 'excorporate)
+
+;;; excorporate.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] master 673026e: packages/excorporate: New package, import version 0.7.0,
Thomas Fitzsimmons <=