1 ;;; excorporate.el --- Exchange integration -*- lexical-binding: t -*-
3 ;; Copyright (C) 2014-2016 Free Software Foundation, Inc.
5 ;; Author: Thomas Fitzsimmons <fitzsim@fitzsim.org>
6 ;; Maintainer: Thomas Fitzsimmons <fitzsim@fitzsim.org>
10 ;; Homepage: https://www.fitzsim.org/blog/
11 ;; Package-Requires: ((emacs "24.1") (fsm "0.2") (soap-client "3.1.1") (url-http-ntlm "2.0.2"))
13 ;; This program is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
28 ;; Excorporate provides Exchange integration for Emacs.
30 ;; To create a connection to a web service:
34 ;; Excorporate will prompt for an email address that it will use to
35 ;; automatically discover settings. Then it will connect to two or
36 ;; three separate hosts: the autodiscovery host, the web service host
37 ;; or load balancer, and the actual server if there is a load
38 ;; balancer. Therefore you may be prompted for your credentials two
41 ;; You should see a message indicating that the connection is ready
42 ;; either in the minibuffer or failing that in the *Messages* buffer.
44 ;; Finally, run M-x calendar, and press 'e' to show today's meetings.
46 ;; Please try autodiscovery first and report issues not yet listed
47 ;; below. When autodiscovery works it is very convenient; the goal is
48 ;; to make it work for as many users as possible.
50 ;; If autodiscovery fails, customize `excorporate-configuration' to
51 ;; skip autodiscovery.
53 ;; Autodiscovery will fail if:
55 ;; - Excorporate is accessing the server through a proxy (Emacs
58 ;; - The server is not configured to support autodiscovery.
60 ;; - The email address is at a different domain than the server, e.g.,
61 ;; user@domain1.com, autodiscover.domain2.com.
63 ;; - Authentication is Kerberos/GSSAPI.
65 ;; Excorporate does know about the special case where the mail address
66 ;; is at a subdomain, e.g., user@sub.domain.com, and the server is at
67 ;; the main domain, e.g., autodiscover.domain.com. Autodiscovery will
70 ;; Excorporate must be loaded before any other package that requires
71 ;; `soap-client'. The version of `soap-client' that Excorporate
72 ;; bundles is backward compatible.
76 ;; Alexandru Harsanyi <AlexHarsanyi@gmail.com> provided help and
77 ;; guidance on how to extend soap-client.el's WSDL and XSD handling,
78 ;; enabling support for the full Exchange Web Services API.
80 ;; Alex Luccisano <casual.lexicon@gmail.com> tested early versions of
81 ;; this library against a corporate installation of Exchange.
83 ;; Jon Miller <jonebird@gmail.com> tested against Exchange 2013. He
84 ;; also tracked down and reported a bad interaction with other
85 ;; packages that require soap-client.
87 ;; Nicolas Lamirault <nicolas.lamirault@gmail.com> tested the
88 ;; autodiscovery feature.
90 ;; Trey Jackson <bigfaceworm@gmail.com> confirmed autodiscovery worked
93 ;; Joakim Verona <joakim@verona.se> tested autodiscovery in a
94 ;; Kerberos/GSSAPI environment.
96 ;; Wilfred Hughes <me@wilfred.me.uk> tested on Exchange 2007 and
97 ;; suggested documentation improvements.
99 ;; Erik Hetzner <egh@e6h.org> tested on Office 365 and helped debug
100 ;; Office 365 support.
104 ;; Implementation-visible functions and variables.
106 ;; Add NTLM authorization scheme.
107 (require 'url-http-ntlm)
108 (require 'soap-client)
110 (require 'excorporate-calendar)
112 (defconst exco--autodiscovery-templates
113 '("https://%s/autodiscover/autodiscover.svc"
114 "https://autodiscover.%s/autodiscover/autodiscover.svc")
115 "Autodiscovery URL templates.
116 URL templates to be formatted with a domain name, then searched
117 for autodiscovery files.")
119 (defvar exco--connections nil
120 "A hash table of finite state machines.
121 The key is the identifier passed to `exco-connect'. Each finite
122 state machine represents a service connection.")
124 (defvar exco--connection-identifiers nil
125 "An ordered list of connection identifiers.")
127 (defun exco--parse-xml-in-current-buffer ()
128 "Decode and parse the XML contents of the current buffer."
129 (let ((mime-part (mm-dissect-buffer t t)))
131 (error "Failed to decode response from server"))
132 (unless (equal (car (mm-handle-type mime-part)) "text/xml")
133 (error "Server response is not an XML document"))
135 (mm-insert-part mime-part)
137 (car (xml-parse-region (point-min) (point-max)))
139 (mm-destroy-part mime-part)))))
141 (defun exco--bind-wsdl (wsdl service-url port-name target-namespace
143 "Create a WSDL binding.
144 Create a binding port for WSDL from SERVICE-URL, PORT-NAME,
145 TARGET-NAMESPACE and BINDING-NAME."
146 (let* ((namespace (soap-wsdl-find-namespace target-namespace wsdl))
147 (port (make-soap-port
149 :binding (cons target-namespace binding-name)
150 :service-url service-url)))
151 (soap-namespace-put port namespace)
152 (push port (soap-wsdl-ports wsdl))
153 (soap-resolve-references port wsdl)
156 (defun exco--handle-url-error (url status)
157 "Handle an error that occurred when retrieving URL.
158 The details of the error are in STATUS, in the same format as the
159 argument to a `url-retrieve' callback. Return non-nil to retry,
161 (if (eq (cl-third (plist-get status :error)) 500)
162 ;; The server reported an internal server error. Try to recover
163 ;; by re-requesting the target URL and its most recent redirect.
164 ;; I'm not sure what conditions cause the server to get into
165 ;; this state -- it might be because the server has stale
166 ;; knowledge of old keepalive connections -- but this should
167 ;; recover it. We need to disable ntlm in
168 ;; url-registered-auth-schemes so that it doesn't prevent
169 ;; setting keepalives to nil.
170 (let ((url-registered-auth-schemes nil)
171 (url-http-attempt-keepalives nil)
172 (redirect (plist-get status :redirect)))
173 (fsm-debug-output "exco--fsm received 500 error for %s" url)
174 (url-debug 'excorporate "Attempting 500 recovery")
176 ;; Emacs's url-retrieve does not respect the values of
177 ;; url-http-attempt-keepalives and
178 ;; url-registered-auth-schemes in asynchronous contexts.
179 ;; Unless url.el is eventually changed to do so, the
180 ;; following requests must be synchronous so that they run
181 ;; entirely within url-http-attempt-keepalives's dynamic
182 ;; extent. These calls block the main event loop,
183 ;; unfortunately, but only in this rare error recovery
185 (url-retrieve-synchronously url)
186 (when redirect (url-retrieve-synchronously redirect)))
187 (url-debug 'excorporate "Done 500 recovery attempt")
190 ;; We received some other error, which just
191 ;; means we should try the next URL.
192 (fsm-debug-output "exco--fsm didn't find %s" url)
196 (defun exco--retrieve-next-import (fsm state-data return-for next-state)
197 "Retrieve the next XML schema import.
198 FSM is the finite state machine, STATE-DATA is FSM's state data,
199 and RETURN-FOR is one of :enter or :event to indicate what return
200 type the calling function expects. NEXT-STATE is the next state
201 the FSM should transition to on success."
202 (let* ((url (plist-get state-data :service-url))
203 (xml (plist-get state-data :service-xml))
204 (wsdl (plist-get state-data :service-wsdl))
205 (imports (soap-wsdl-xmlschema-imports wsdl))
206 (next-state (if imports :parsing-service-wsdl next-state)))
208 (let ((import-url (url-expand-file-name (pop imports) url)))
209 (let ((url-request-method "GET")
210 (url-package-name "soap-client.el")
211 (url-package-version "1.0")
212 (url-mime-charset-string "utf-8;q=1, iso-8859-1;q=0.5")
213 (url-http-attempt-keepalives t))
217 (let ((data-buffer (current-buffer)))
220 (url-debug 'excorporate "Processing import %s" status)
221 (if (eq (car status) :error)
222 ;; There is an error. It may be recoverable
223 ;; if it's HTTP 500 (internal server error).
224 (if (and (exco--handle-url-error import-url status)
226 (not (plist-get state-data :retrying)))
227 ;; We should retry. Don't save the
228 ;; popped urls list to state-data, so
229 ;; that this :try-next-url will
230 ;; re-attempt to retrieve the same car as
231 ;; before. Set the retry flag.
233 (plist-put state-data :retrying t))
234 ;; Save the popped urls list so that the next url
235 ;; is attempted, and clear the retry flag.
236 (plist-put state-data :retrying nil)
237 (setf (soap-wsdl-xmlschema-imports wsdl) imports)
238 (plist-put state-data :failure-message
239 (format "Failed to retrieve %s"
241 (fsm-send fsm :unrecoverable-error))
242 ;; Success, parse WSDL.
243 (plist-put state-data :retrying nil)
244 (setf (soap-wsdl-xmlschema-imports wsdl) imports)
245 (soap-with-local-xmlns xml
246 (soap-wsdl-add-namespace
247 (soap-parse-schema (soap-parse-server-response) wsdl)
249 (plist-put state-data :service-wsdl wsdl)))
250 (and (buffer-live-p data-buffer)
251 (kill-buffer data-buffer))))
252 (fsm-send fsm t))))))
253 (if (eq return-for :enter)
254 (list state-data nil)
255 (list next-state state-data nil))))
257 (define-state-machine exco--fsm :start
259 "Start an Excorporate finite state machine."
260 (if (stringp identifier)
261 (let ((domain (cadr (split-string identifier "@"))))
262 (unless (and domain (not (equal domain "")))
263 (error "Invalid domain for address %s" identifier))
264 (list :retrieving-autodiscovery-xml
266 ;; State machine data.
267 ;; Unique finite state machine identifier. Either mail-address
268 ;; or (mail-address . service-url). The latter allows multiple
269 ;; state machines to operate on the same service URL. Login
270 ;; credentials are handled separately by auth-source and url,
271 ;; so these should be the only two identifier types needed here.
272 :identifier identifier
274 :mail-address identifier
275 ;; Error recovery data.
277 ;; Autodiscovery data.
279 (append (mapcar (lambda (template)
280 (format template domain))
281 exco--autodiscovery-templates)
282 ;; Handle the user@sub.domain.com =>
283 ;; autodiscover.domain.com case reported by a
284 ;; user. Only try one extra level.
285 (let ((domain-parts (split-string domain "\\.")))
286 (when (> (length domain-parts) 2)
287 (mapcar (lambda (template)
291 (cdr domain-parts) ".")))
292 exco--autodiscovery-templates))))
298 :next-state-after-success nil
303 ;; Go directly to :retrieving-service-xml, skipping autodiscovery.
304 (list :retrieving-service-xml
306 :identifier identifier
307 :mail-address (car identifier)
309 :autodiscovery-urls nil
310 ;; Use service-url field from identifier.
311 :service-url (cdr identifier)
314 :next-state-after-success nil
320 (define-state exco--fsm :retrieving-autodiscovery-xml
321 (fsm state-data event _callback)
324 (let ((urls (plist-get state-data :autodiscovery-urls)))
326 (let ((url (pop urls)))
327 (fsm-debug-output "exco--fsm will probe %s" url)
332 (let ((data-buffer (current-buffer)))
335 (url-debug 'excorporate
336 "Processing status: %s" status)
337 (if (eq (car status) :error)
340 (exco--handle-url-error url status)
342 (not (plist-get state-data :retrying)))
343 ;; We should retry. Don't save the popped
344 ;; urls list to state-data, so that this
345 ;; :try-next-url will re-attempt to
346 ;; retrieve the same car as before. Set
348 (plist-put state-data :retrying t)
349 ;; Save the popped urls list so that the
350 ;; next url is attempted, and clear the
352 (plist-put state-data :retrying nil)
353 (plist-put state-data
354 :autodiscovery-urls urls))
355 ;; Try next or retry.
356 (fsm-send fsm :try-next-url))
357 ;; Success, save URL and parse returned XML.
359 "Excorporate: Found autodiscovery URL for %S: %s"
360 (plist-get state-data :identifier) url)
361 (plist-put state-data :retrying nil)
362 (plist-put state-data :service-url url)
363 (plist-put state-data :service-xml
364 (exco--parse-xml-in-current-buffer))
365 (fsm-send fsm :success))
366 (url-debug 'excorporate "Done processing status"))
367 (and (buffer-live-p data-buffer)
368 (kill-buffer data-buffer))))))
370 (fsm-debug-output "exco--fsm connection refused for %s" url)
371 (plist-put state-data :retrying nil)
372 (plist-put state-data :autodiscovery-urls urls)
373 (fsm-send fsm :try-next-url)))
374 (list :retrieving-autodiscovery-xml state-data nil))
375 (plist-put state-data :failure-message
376 "Autodiscovery ran out of URLs to try")
377 (list :shutting-down-on-error state-data nil))))
379 (plist-put state-data :next-state-after-success :retrieving-service-xml)
380 (list :parsing-service-wsdl state-data nil))))
382 (define-enter-state exco--fsm :shutting-down-on-error
384 (let ((failure-message (plist-get state-data :failure-message)))
385 (exco-disconnect (plist-get state-data :identifier))
386 (message "Excorporate: %s" failure-message)
387 (url-debug 'excorporate "Failed: %s" failure-message)
388 (fsm-debug-output "exco--fsm failed: %s" failure-message))
389 (list state-data nil))
391 (define-state exco--fsm :shutting-down-on-error
392 (_fsm state-data _event _callback)
393 (list :shutting-down-on-error state-data nil))
395 (define-enter-state exco--fsm :retrieving-service-xml
397 (when (stringp (plist-get state-data :identifier))
398 (let* ((xml (plist-get state-data :service-xml))
399 (unbound-wsdl (plist-get state-data :service-wsdl))
402 ;; Skip soap-parse-wsdl-phase-fetch-schema to avoid
403 ;; synchronous URL fetches.
404 (soap-parse-wsdl-phase-finish-parsing xml unbound-wsdl)
406 (soap-wsdl-resolve-references unbound-wsdl)
407 (plist-get state-data :service-url)
408 "AutodiscoverServicePort"
409 "http://schemas.microsoft.com/exchange/2010/Autodiscover"
410 "DefaultBinding_Autodiscover"))))
414 (exco-extract-value '(Response
423 (plist-put state-data :service-url result-url)
424 (message "Excorporate: Found service URL for %S: %s"
425 (plist-get state-data :identifier)
426 (plist-get state-data :service-url)))
427 ;; No result. Check for error.
429 (exco-extract-value '(Response
435 (message "Excorporate: %s" error-message)
436 (message "Excorporate: Failed to find service URL"))))
437 (fsm-send fsm :retrieve-xml)))
440 "AutodiscoverServicePort"
442 `((RequestedServerVersion . "Exchange2010")
446 (Mailbox . ,(plist-get state-data :mail-address))))
448 (Setting . "InternalEwsUrl")))))))
449 (list state-data nil))
451 (define-state exco--fsm :retrieving-service-xml
452 (fsm state-data event _callback)
454 (:unrecoverable-error
455 (list :shutting-down-on-error state-data nil))
457 (let* ((service-url (plist-get state-data :service-url))
458 (wsdl-url (replace-regexp-in-string "/[^/]*$" "/Services.wsdl"
460 (url-retrieve wsdl-url
462 (let ((data-buffer (current-buffer)))
464 (if (eq (car status) :error)
466 (plist-put state-data :failure-message
467 (format "Failed to retrieve %s"
469 (fsm-send fsm :unrecoverable-error))
470 (plist-put state-data
472 (exco--parse-xml-in-current-buffer))
473 (fsm-send fsm :success))
474 (and (buffer-live-p data-buffer)
475 (kill-buffer data-buffer)))))))
476 (list :retrieving-service-xml state-data nil))
478 (plist-put state-data :next-state-after-success :retrieving-data)
479 (list :parsing-service-wsdl state-data nil))))
481 (define-enter-state exco--fsm :parsing-service-wsdl
483 (let* ((url (plist-get state-data :service-url))
484 (xml (plist-get state-data :service-xml))
485 (next-state (plist-get state-data :next-state-after-success))
486 (wsdl (soap-make-wsdl url)))
487 (soap-parse-wsdl-phase-validate-node xml)
488 ;; Skip soap-parse-wsdl-phase-fetch-imports to avoid synchronous
489 ;; fetches of import URLs.
490 (soap-parse-wsdl-phase-parse-schema xml wsdl)
491 (plist-put state-data :service-wsdl wsdl)
492 (exco--retrieve-next-import fsm state-data :enter next-state)))
494 (define-state exco--fsm :parsing-service-wsdl
495 (fsm state-data event _callback)
496 (if (eq event :unrecoverable-error)
497 (list :shutting-down-on-error state-data nil)
498 (let ((next-state (plist-get state-data :next-state-after-success)))
499 (exco--retrieve-next-import fsm state-data :event next-state))))
501 (defun exco--get-server-version (wsdl)
502 "Extract server version from WSDL."
503 (let ((warning-message "Excorporate: Failed to determine server version")
504 (namespace "http://schemas.microsoft.com/exchange/services/2006/types")
505 (name "RequestServerVersion")
511 (soap-xs-type-attributes
512 (soap-xs-element-type (soap-wsdl-get
513 `(,namespace . ,name)
514 wsdl 'soap-xs-element-p))))
515 (when (equal (soap-xs-attribute-name attribute) "Version")
516 (throw 'found (car (soap-xs-simple-type-enumeration
517 (soap-xs-attribute-type attribute))))))
518 (warn warning-message)
522 (warn warning-message)
525 (define-enter-state exco--fsm :retrieving-data
527 (let ((wsdl (plist-get state-data :service-wsdl))
528 (identifier (plist-get state-data :identifier)))
529 ;; Skip soap-parse-wsdl-phase-fetch-schema to avoid synchronous
531 (soap-parse-wsdl-phase-finish-parsing (plist-get state-data :service-xml)
534 (soap-wsdl-resolve-references wsdl)
535 (plist-get state-data :service-url)
536 "ExchangeServicePort"
537 "http://schemas.microsoft.com/exchange/services/2006/messages"
538 "ExchangeServiceBinding")
539 (plist-put state-data :server-version (exco--get-server-version wsdl))
540 (fsm-debug-output "exco--fsm %s server version is %s"
541 identifier (exco-server-version identifier))
542 (message "Excorporate: Connection %S is ready" identifier))
543 (list state-data nil))
545 (define-state exco--fsm :retrieving-data
546 (_fsm state-data event _callback)
547 (let* ((identifier (plist-get state-data :identifier))
548 (wsdl (plist-get state-data :service-wsdl))
550 (arguments (pop event))
551 (callback (pop event)))
552 (apply #'soap-invoke-async
554 (funcall callback identifier response))
557 "ExchangeServicePort"
560 (list :retrieving-data state-data nil))
562 (defun exco--ensure-connection ()
563 "Ensure at least one connection exists or throw an error."
564 (unless exco--connection-identifiers
565 (error "Excorporate: No connections exist. Run M-x excorporate")))
567 (defmacro exco--with-fsm (identifier &rest body)
568 "With `fsm' set to IDENTIFIER, run BODY.
569 Run BODY with `fsm' set to the finite state machine specified by
571 (declare (indent 1) (debug t))
573 (exco--ensure-connection)
574 (let ((fsm (gethash ,identifier exco--connections)))
576 (error "Excorporate: Connection %S does not exist" ,identifier))
579 ;; Developer-visible functions and variables.
581 (defun exco-api-version ()
582 "Return the Excorporate API version.
583 Return a non-negative integer representing the current
584 Excorporate application programming interface version. Version 0
585 is subject to change."
588 (defun exco-connect (identifier)
589 "Connect or reconnect to a web service.
590 IDENTIFIER is the mail address to use for autodiscovery or a
591 pair (mail-address . service-url)."
592 (if (stringp identifier)
593 (message "Excorporate: Starting autodiscovery for %S"
595 (let ((fsm (start-exco--fsm identifier)))
596 (unless exco--connections
597 (setq exco--connections (make-hash-table :test 'equal)))
598 (when (gethash identifier exco--connections)
599 (exco-disconnect identifier))
600 (puthash identifier fsm exco--connections)
601 (push identifier exco--connection-identifiers)
602 (if (stringp identifier)
603 (fsm-send fsm :try-next-url)
604 (fsm-send fsm :retrieve-xml))
607 (defun exco-operate (identifier name arguments callback)
608 "Execute a service operation asynchronously.
609 IDENTIFIER is the connection identifier. Execute operation NAME
610 with ARGUMENTS then call CALLBACK with two arguments, IDENTIFIER
611 and the server's response."
612 (exco--with-fsm identifier
613 (fsm-send fsm (list name arguments callback)))
616 (defun exco-server-version (identifier)
617 "Return the server version for connection IDENTIFIER, as a string.
618 Examples are \"Exchange2010\", \"Exchange2010_SP1\",
620 (exco--with-fsm identifier
621 (plist-get (fsm-get-state-data fsm) :server-version)))
623 (defun exco-disconnect (identifier)
624 "Disconnect from a web service.
625 IDENTIFIER is the mail address used to look up the connection."
626 (exco--with-fsm identifier
627 (setq exco--connection-identifiers
628 (delete identifier exco--connection-identifiers))
629 (remhash identifier exco--connections))
632 (defun exco-extract-value (path result)
633 "Extract the value at PATH from RESULT.
634 PATH is an ordered list of node names."
635 (let ((values (nreverse (car result))))
636 (dolist (path-element path)
637 (setq values (assoc path-element values)))
640 (defun exco-calendar-item-iterate (response callback)
641 "Iterate through calendar items in RESPONSE, calling CALLBACK on each.
642 Returns a list of results from callback. CALLBACK takes arguments:
643 SUBJECT, a string, the subject of the meeting.
644 START, the start date and time in Emacs internal representation.
645 END, the start date and time in Emacs internal representation.
646 LOCATION, the location of the meeting.
647 MAIN-INVITEES, a list of strings representing required participants.
648 OPTIONAL-INVITEES, a list of strings representing optional participants."
649 (let ((result-list '()))
650 (dolist (calendar-item (exco-extract-value '(ResponseMessages
651 FindItemResponseMessage
655 (let* ((subject (cdr (assoc 'Subject calendar-item)))
656 (start (cdr (assoc 'Start calendar-item)))
657 (start-internal (apply #'encode-time
658 (soap-decode-date-time
660 (end (cdr (assoc 'End calendar-item)))
661 (end-internal (apply #'encode-time
662 (soap-decode-date-time
664 (location (cdr (assoc 'Location calendar-item)))
665 (to-invitees (cdr (assoc 'DisplayTo calendar-item)))
666 (main-invitees (when to-invitees
668 (split-string to-invitees ";"))))
669 (cc-invitees (cdr (assoc 'DisplayCc calendar-item)))
670 (optional-invitees (when cc-invitees
672 (split-string cc-invitees ";")))))
673 (push (funcall callback subject start-internal end-internal
674 location main-invitees optional-invitees)
676 (nreverse result-list)))
678 ;; Date-time utility functions.
679 (defun exco-extend-timezone (date-time-string)
680 "Add a colon to the timezone in DATE-TIME-STRING.
681 DATE-TIME-STRING must be formatted as if returned by
682 `format-time-string' with FORMAT-STRING \"%FT%T%z\". Web
683 services require the ISO8601 extended format of timezone, which
686 (substring date-time-string 0 22) ":" (substring date-time-string 22)))
688 (defun exco-format-date-time (time-internal)
689 "Convert TIME-INTERNAL to an XSD compatible date-time string."
690 (exco-extend-timezone
691 (format-time-string "%FT%T%z" time-internal)))
693 ;; Use month day year order to be compatible with
694 ;; calendar-cursor-to-date. I wish I could instead use the ISO 8601
695 ;; ordering, year month day.
696 (defun exco-get-meetings-for-day (identifier month day year callback)
697 "Return the meetings for the specified day.
698 IDENTIFIER is the connection identifier. MONTH, DAY and YEAR are
699 the meeting month, day and year. Call CALLBACK with two
700 arguments, IDENTIFIER and the server's response."
701 (let* ((start-of-day-time-internal
702 (apply #'encode-time `(0 0 0 ,day ,month ,year)))
703 (start-of-day-date-time
704 (exco-format-date-time start-of-day-time-internal))
705 (start-of-next-day-date-time
706 (exco-extend-timezone
707 (format-time-string "%FT00:00:00%z"
708 (time-add start-of-day-time-internal
709 (seconds-to-time 86400))))))
714 (;; RequestVersion is usually overridden by a fixed value in
715 ;; the WSDL (the RequestServerVersion element); provide the
716 ;; maximally-compatible Exchange2007 if the fixed value isn't
718 (RequestVersion (Version . "Exchange2007"))
719 (Traversal . "Shallow")
721 (BaseShape . "AllProperties"))
722 ;; To aid productivity, excorporate-calfw automatically prunes your
723 ;; meetings to a maximum of 100 per day.
724 (CalendarView (MaxEntriesReturned . "100")
725 (StartDate . ,start-of-day-date-time)
726 (EndDate . ,start-of-next-day-date-time))
728 (DistinguishedFolderId (Id . "calendar"))))
730 ,@(let* ((wsdl (exco--with-fsm identifier
731 (plist-get (fsm-get-state-data fsm)
733 (arity (soap-operation-arity wsdl
734 "ExchangeServicePort"
736 (make-list (- arity 1) nil)))
739 (defun exco-connection-iterate (initialize-function
740 per-connection-function
741 per-connection-callback
743 "Iterate Excorporate connections.
744 Call INITIALIZE-FUNCTION once before iterating.
745 Call PER-CONNECTION-FUNCTION for each connection.
746 Pass PER-CONNECTION-CALLBACK to PER-CONNECTION-FUNCTION.
747 Call FINALIZE-FUNCTION after all operations have responded."
748 (exco--ensure-connection)
749 (funcall initialize-function)
751 (connection-count (length exco--connection-identifiers)))
752 (dolist (identifier exco--connection-identifiers)
753 (funcall per-connection-function identifier
754 (lambda (&rest arguments)
755 (setq responses (1+ responses))
756 (apply per-connection-callback arguments)
757 (when (equal responses connection-count)
758 (funcall finalize-function)))))))
760 ;; User-visible functions and variables.
761 (defgroup excorporate nil
767 ;; Name the excorporate-configuration variable vaguely. It is currently a
768 ;; MAIL-ADDRESS string, a pair (MAIL-ADDRESS . SERVICE-URL), or nil. In the
769 ;; future it could allow a list of strings and pairs.
770 (defcustom excorporate-configuration nil
771 "Excorporate configuration.
772 The mail address to use for autodiscovery."
775 :tag "Prompt for Exchange mail address to use for autodiscovery" nil)
776 (string :tag "Exchange mail address to use for autodiscovery")
777 (cons :tag "Skip autodiscovery"
778 (string :tag "Exchange mail address (e.g., hacker@gnu.org)")
779 (string :tag "Exchange Web Services URL\
780 (e.g., https://mail.gnu.org/ews/exchange.asmx)"))))
783 (defun excorporate ()
785 Prompt for a mail address to use for autodiscovery, with an
786 initial suggestion of `user-mail-address'. However, if
787 `excorporate-configuration' is non-nil, `excorporate' will use
788 that without prompting."
791 ((eq excorporate-configuration nil)
792 (exco-connect (completing-read "Exchange mail address: "
793 (list user-mail-address)
794 nil nil user-mail-address)))
795 ((stringp excorporate-configuration)
796 (exco-connect excorporate-configuration))
797 ((null (consp (cdr excorporate-configuration)))
798 (exco-connect excorporate-configuration))
800 (error "Excorporate: Invalid configuration"))))
802 (provide 'excorporate)
804 ;;; excorporate.el ends here