forked from dengste/org-caldav
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathorg-caldav.el
1696 lines (1562 loc) · 62.1 KB
/
org-caldav.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; org-caldav.el --- Sync org files with external calendar through CalDAV
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
;; Copyright (C) 2018-2019 David Engster
;; Author: David Engster <[email protected]>
;; Keywords: calendar, caldav
;; Package-Requires: ((org "7"))
;;
;; This file is not part of GNU Emacs.
;;
;; org-caldav.el 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.
;; org-caldav.el 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;; See README.
;;; Code:
(require 'url-dav)
(require 'url-http) ;; b/c of Emacs bug
(unless (require 'ox-icalendar nil t)
(require 'org-icalendar))
(require 'org-id)
(require 'icalendar)
(require 'url-util)
(require 'cl-lib)
(require 'button)
(defvar org-caldav-url "https://my.calendarserver.invalid/caldav"
"Base URL for CalDAV access.
By default, `org-caldav-calendar-id' will be appended to this to
get an URL for calendar events. If this default is not correct,
use '%s' to where the calendar id must be placed.
Set this to symbol \\='google to use Google Calendar, using OAuth2
authentication. In that case, also make sure that
`browse-url-browser-function' is set to a Javascript-capable
browser (like `browse-url-firefox'). Note that you need to have
the OAuth2 library installed, and you will also have to set
`org-caldav-oauth2-client-id' and
`org-caldav-oauth2-client-secret' (see README).
In general, if this variable is a symbol, do OAuth2
authentication with access URIs set in
`org-caldav-oauth2-providers'.")
(defvar org-caldav-calendar-id "mycalendar"
"ID of your calendar.")
(defvar org-caldav-uuid-extension ".ics"
"The file extension to add to uuids in webdav requests.
This is usually .ics, but on some servers (davmail), it is .EML")
(defvar org-caldav-files '("~/org/appointments.org")
"List of files which should end up in calendar.
The file in `org-caldav-inbox' is implicitly included, so you
don't have to add it here.")
(defvar org-caldav-select-tags nil
"List of tags to filter the synced tasks.
If any such tag is found in a buffer, all items that do not carry
one of these tags will not be exported.")
(defvar org-caldav-exclude-tags nil
"List of tags to exclude from the synced tasks.
All items that carry one of these tags will not be exported.")
(defvar org-caldav-inbox "~/org/appointments.org"
"Where to put new entries obtained from calendar.
This can be simply be a filename to an Org file where all new
entries will be put. It can also be an alist, in which case you
can choose between the following options:
- (file \"path/to/file\"), or
- (id \"id of existing org entry\"), or
- (file+headline \"path/to/file\" \"node headline\").")
(defvar org-caldav-sync-direction 'twoway
"Which kind of sync should be done between Org and calendar.
Default is 'twoway, meaning that changes in Org are synced to the
calendar and changes in the calendar are synced back to
Org. Other options are:
'org->cal: Only sync Org to calendar
'cal->org: Only sync calendar to Org")
(defvar org-caldav-calendars nil
"A list of plists which define different calendars.
Use this variable to sync with several different remote
calendars. By setting this, `org-caldav-sync' will run several
times, and you can set the global variables like
`org-caldav-calendar-id' for each run through plist keys.
The available keys are: :url, :calendar-id, :files, :select-tags,
:inbox, :skip-conditions, :sync-inbox, and :sync-direction. They
override the corresponding global org-caldav-* variables. You can
also use any other key, which will then override any org-*
variable.
Example:
'((:calendar-id \"work@whatever\" :files (\"~/org/work.org\")
:inbox \"~/org/fromwork.org\")
(:calendar-id \"stuff@mystuff\"
:files (\"~/org/sports.org\" \"~/org/play.org\")
:inbox \"~/org/fromstuff.org\"))")
(defvar org-caldav-save-directory user-emacs-directory
"Directory where org-caldav saves its sync state.")
(defvar org-caldav-sync-changes-to-org 'title-and-timestamp
"What kind of changes should be synced from Calendar to Org.
Can be one of the following symbols:
title-and-timestamp: Sync title and timestamp (default).
title-only: Sync only the title.
timestamp-only: Sync only the timestamp.
all: Sync everything.
When choosing 'all', you should be aware of the fact that the
iCalendar format is pretty limited in what it can store, so you
might loose information in your Org items (take a look at
`org-icalendar-include-body').")
(defvar org-caldav-delete-org-entries 'ask
"Whether entries deleted in calendar may be deleted in Org.
Can be one of the following symbols:
ask = Ask for before deletion (default)
never = Never delete Org entries
always = Always delete")
(defvar org-caldav-delete-calendar-entries 'always
"Whether entries deleted in Org may be deleted in calendar.
Can be one of the following symbols:
always = Always delete without asking (default)
ask = Ask for before deletion
never = Never delete calendar entries")
(defvar org-caldav-skip-conditions nil
"Conditions for skipping entries during icalendar export.
This must be a list of conditions, which are described in the
doc-string of `org-agenda-skip-if'. Any entry that matches will
not be exported. Note that the normal `org-agenda-skip-function'
has no effect on the icalendar exporter.")
(defvar org-caldav-backup-file
(expand-file-name "org-caldav-backup.org" user-emacs-directory)
"Name of the file where org-caldav should backup entries.
Set this to nil if you don't want any backups.")
(defvar org-caldav-show-sync-results 'with-headings
"Whether to show what was done after syncing.
If this is the symbol 'with-headings, the results will also
include headings from Org entries.")
(defvar org-caldav-retry-attempts 5
"Number of times trying to retrieve/put events.")
(defvar org-caldav-calendar-preamble
"BEGIN:VCALENDAR\nPRODID:\nVERSION:2.0\nCALSCALE:GREGORIAN\n"
"Preamble used for iCalendar events.
You usually should not have to touch this, but it might be
necessary to add timezone information here in case your CalDAV
server does not do that for you, or if you want to use a
different timezone in your Org files.")
(defvar org-caldav-debug-level 1
"Level of debug output in `org-caldav-debug-buffer'.
0 or nil: no debug output. 1: Normal debugging. 2: Excessive
debugging (this will also output event content into the
buffer).")
(defvar org-caldav-debug-buffer "*org-caldav-debug*"
"Name of the debug buffer.")
(defvar org-caldav-resume-aborted 'ask
"Whether aborted sync attempts should be resumed.
Can be one of the following symbols:
ask = Ask for before resuming (default)
never = Never resume
always = Always resume")
(defvar org-caldav-oauth2-providers
'((google "https://accounts.google.com/o/oauth2/v2/auth"
"https://www.googleapis.com/oauth2/v4/token"
"https://www.googleapis.com/auth/calendar"
"https://apidata.googleusercontent.com/caldav/v2/%s/events"))
"List of providers that need OAuth2. Each must be of the form
IDENTIFIER AUTH-URL TOKEN-URL RESOURCE-URL CALENDAR-URL
where IDENTIFIER is a symbol that can be set in `org-caldav-url'
and '%s' in the CALENDAR-URL denotes where
`org-caldav-calendar-id' must be placed to generate a valid
events URL for a calendar.")
(defvar org-caldav-oauth2-client-id nil
"Client ID for OAuth2 authentication.")
(defvar org-caldav-oauth2-client-secret nil
"Client secret for OAuth2 authentication.")
;; Internal variables
(defvar org-caldav-oauth2-available
(condition-case nil (require 'oauth2) (error))
"Whether oauth2 library is available.")
(defvar org-caldav-previous-calendar nil
"The plist from org-caldav-calendars, which holds the last
synced calendar. Used to properly resume an interupted attempt.")
(defvar org-caldav-event-list nil
"The event list database.
This is an alist with elements
(uid md5 etag sequence status).
It will be saved to disk between sessions.")
(defvar org-caldav-sync-result nil
"Result from last synchronization.
Contains an alist with entries
(calendar-id uid status action)
with status = {new,changed,deleted}-in-{org,cal}
and action = {org->cal, cal->org, error:org->cal, error:cal->org}.")
(defvar org-caldav-empty-calendar nil
"Flag if we have an empty calendar in the beginning.")
(defvar org-caldav-ics-buffer nil
"Buffer holding the ICS data.")
(defvar org-caldav-oauth2-tokens nil
"Tokens for OAuth2 authentication.")
(defvar org-caldav-previous-files nil
"Files that were synced during previous run.")
(defcustom org-caldav-location-newline-replacement ", "
"String to replace newlines in the LOCATION field with."
:type 'string)
(defsubst org-caldav-add-event (uid md5 etag sequence status)
"Add event with UID, MD5, ETAG and STATUS."
(setq org-caldav-event-list
(append org-caldav-event-list
(list (list uid md5 etag sequence status)))))
(defsubst org-caldav-search-event (uid)
"Return entry with UID from even list."
(assoc uid org-caldav-event-list))
(defsubst org-caldav-event-md5 (event)
"Get MD5 from EVENT."
(nth 1 event))
(defsubst org-caldav-event-etag (event)
"Get etag from EVENT."
(nth 2 event))
(defsubst org-caldav-event-sequence (event)
"Get sequence number from EVENT."
(nth 3 event))
(defsubst org-caldav-event-status (event)
"Get status from EVENT."
(nth 4 event))
(defsubst org-caldav-event-set-status (event status)
"Set status from EVENT to STATUS."
(setcar (last event) status))
(defsubst org-caldav-event-set-etag (event etag)
"Set etag from EVENT to ETAG."
(setcar (nthcdr 2 event) etag))
(defsubst org-caldav-event-set-md5 (event md5sum)
"Set md5 from EVENT to MD5SUM."
(setcar (cdr event) md5sum))
(defsubst org-caldav-event-set-sequence (event seqnum)
"Set sequence number from EVENT to SEQNUM."
(setcar (nthcdr 3 event) seqnum))
(defsubst org-caldav-use-oauth2 ()
(symbolp org-caldav-url))
(defun org-caldav-filter-events (status)
"Return list of events with STATUS."
(delq nil
(mapcar
(lambda (event)
(when (eq (car (last event)) status)
event))
org-caldav-event-list)))
;; Since not being able to access an URL via DAV is the most reported
;; error, let's be very verbose about checking for DAV availability.
(defun org-caldav-check-dav (url)
"Check if URL accepts DAV requests.
Report an error with further details if that is not the case."
(let* ((buffer (org-caldav-url-retrieve-synchronously url "OPTIONS"))
(header nil)
(options nil))
(when (not buffer)
(error "Retrieving URL %s failed." url))
(with-current-buffer buffer
(when (zerop (buffer-size))
(error "No data received for URL %s (maybe TLS problem)." url))
(goto-char (point-min))
(when (not (re-search-forward "^HTTP[^ ]* \\([0-9]+ .*\\)$"
(point-at-eol) t))
(switch-to-buffer buffer)
(error "No valid HTTP response from URL %s." url))
(let ((response (match-string 1)))
(when (not (string-match "2[0-9][0-9].*" response))
(switch-to-buffer buffer)
(error "Error while checking for OPTIONS at URL %s: %s" url response)))
(mail-narrow-to-head)
(let ((davheader (mail-fetch-field "dav")))
(when (not davheader)
(switch-to-buffer buffer)
(error "The URL %s does not accept DAV requests" url)))))
t)
(defun org-caldav-check-oauth2 (provider)
"Check if we have to do OAuth2 authentication.
If that is the case, also check that everything is installed and
configured correctly, and throw an user error otherwise."
(when (null (assoc provider org-caldav-oauth2-providers))
(user-error (concat "No OAuth2 provider found for %s in "
"`org-caldav-oauth2-providers'")
(symbol-name provider)))
(when (not org-caldav-oauth2-available)
(user-error (concat "Oauth2 library is missing "
"(install from GNU ELPA)")))
(when (or (null org-caldav-oauth2-client-id)
(null org-caldav-oauth2-client-secret))
(user-error (concat "You need to set oauth2 client ID and secret "
"for OAuth2 authentication"))))
(defun org-caldav-retrieve-oauth2-token (provider calendar-id)
"Do OAuth2 authentication for PROVIDER with CALENDAR-ID."
(let ((cached-token
(assoc
(concat (symbol-name provider) "__" calendar-id)
org-caldav-oauth2-tokens)))
(if cached-token
(cdr cached-token)
(let* ((ids (assoc provider org-caldav-oauth2-providers))
(token (oauth2-auth-and-store (nth 1 ids) (nth 2 ids) (nth 3 ids)
org-caldav-oauth2-client-id
org-caldav-oauth2-client-secret)))
(when (null token)
(user-error "OAuth2 authentication failed"))
(setq org-caldav-oauth2-tokens
(append org-caldav-oauth2-tokens
(list (cons (concat (symbol-name provider) "__" calendar-id)
token))))
token))))
(defun org-caldav-url-retrieve-synchronously (url &optional
request-method
request-data
extra-headers)
"Retrieve URL with REQUEST-METHOD, REQUEST-DATA and EXTRA-HEADERS.
This will switch to OAuth2 if necessary."
(if (org-caldav-use-oauth2)
(oauth2-url-retrieve-synchronously
(org-caldav-retrieve-oauth2-token org-caldav-url org-caldav-calendar-id)
url request-method request-data
extra-headers)
(let ((url-request-method request-method)
(url-request-data request-data)
(url-request-extra-headers extra-headers))
(url-retrieve-synchronously url))))
(defun org-caldav-namespace-bug-workaround (buffer)
"Workaraound for Emacs bug #23440 on Emacs version <26.
This is needed for the Radicale CalDAV server which uses DAV as
default namespace."
(when (< emacs-major-version 26)
(with-current-buffer buffer
(save-excursion
(goto-char (point-min))
(when (re-search-forward "<[^>]* \\(xmlns=\"DAV:\"\\)" nil t)
(replace-match "xmlns:DAV=\"DAV:\"" nil nil nil 1)
(goto-char (match-beginning 0))
(while (re-search-forward "</?" nil t)
(insert "DAV:")))))))
(defun org-caldav-url-dav-get-properties (url property)
"Retrieve PROPERTY from URL.
Output is the same as `url-dav-get-properties'. This switches to
OAuth2 if necessary."
(let ((request-data (concat "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n"
"<DAV:propfind xmlns:DAV='DAV:'>\n<DAV:prop>"
"<DAV:" property "/></DAV:prop></DAV:propfind>\n"))
(extra '(("Depth" . "1") ("Content-type" . "text/xml"))))
(let ((resultbuf (org-caldav-url-retrieve-synchronously
url "PROPFIND" request-data extra)))
(org-caldav-namespace-bug-workaround resultbuf)
(url-dav-process-response resultbuf url))))
(defun org-caldav-check-connection ()
"Check connection by doing a PROPFIND on CalDAV URL.
Also sets `org-caldav-empty-calendar' if calendar is empty."
(org-caldav-debug-print 1 (format "Check connection for %s."
(org-caldav-events-url)))
(org-caldav-check-dav (org-caldav-events-url))
(let* ((output (org-caldav-url-dav-get-properties
(org-caldav-events-url) "resourcetype"))
(status (plist-get (cdar output) 'DAV:status)))
;; We accept any 2xx status. Since some CalDAV servers return 404
;; for a newly created and not yet used calendar, we accept it as
;; well.
(unless (or (= (/ status 100) 2)
(= status 404))
(org-caldav-debug-print 1 "Got error status from PROPFIND: " output)
(error "Could not query CalDAV URL %s." (org-caldav-events-url)))
(if (= status 404)
(progn
(org-caldav-debug-print 1 "Got 404 status - assuming calendar is new and empty.")
(setq org-caldav-empty-calendar t))
(when (= (length output) 1)
;; This is an empty calendar; fetching etags might return 404.
(org-caldav-debug-print 1 "This is an empty calendar. Setting flag.")
(setq org-caldav-empty-calendar t)))
t))
;; This defun is partly taken out of url-dav.el, written by Bill Perry.
(defun org-caldav-get-icsfiles-etags-from-properties (properties)
"Return all ics files and etags from PROPERTIES."
(let (prop files)
(while (setq prop (pop properties))
(let ((url (car prop))
(etag (plist-get (cdr prop) 'DAV:getetag)))
(if (string-match (concat ".*/\\(.+\\)\\" org-caldav-uuid-extension "/?$") url)
(setq url (match-string 1 url))
(setq url nil))
(when (string-match "\"\\(.*\\)\"" etag)
(setq etag (match-string 1 etag)))
(when (and url etag)
(push (cons (url-unhex-string url) etag) files))))
files))
(defun org-caldav-get-event-etag-list ()
"Return list of events with associated etag from remote calendar.
Return list with elements (uid . etag)."
(if org-caldav-empty-calendar
nil
(let ((output (org-caldav-url-dav-get-properties
(org-caldav-events-url) "getetag")))
(cond
((> (length output) 1)
;; Everything looks OK - we got a list of "things".
;; Get all ics files and etags you can find in there.
(org-caldav-get-icsfiles-etags-from-properties output))
((or (null output)
(zerop (length output)))
;; This is definitely an error.
(error "Error while getting eventlist from %s." (org-caldav-events-url)))
((and (= (length output) 1)
(stringp (car-safe (car output))))
(let ((status (plist-get (cdar output) 'DAV:status)))
(if (eq status 200)
;; This is an empty directory
'empty
(if status
(error "Error while getting eventlist from %s. Got status code: %d."
(org-caldav-events-url) status)
(error "Error while getting eventlist from %s."
(org-caldav-events-url))))))))))
(defun org-caldav-get-event (uid &optional with-headers)
"Get event with UID from calendar.
Function returns a buffer containing the event, or nil if there's
no such event.
If WITH-HEADERS is non-nil, do not delete headers.
If retrieve fails, do `org-caldav-retry-attempts' retries."
(org-caldav-debug-print 1 (format "Getting event UID %s." uid))
(let ((counter 0)
eventbuffer errormessage)
(while (and (not eventbuffer)
(< counter org-caldav-retry-attempts))
(with-current-buffer
(org-caldav-url-retrieve-synchronously
(concat (org-caldav-events-url) (url-hexify-string uid) org-caldav-uuid-extension))
(goto-char (point-min))
(if (looking-at "HTTP.*2[0-9][0-9]")
(setq eventbuffer (current-buffer))
;; There was an error retrieving the event
(setq errormessage (buffer-substring (point-min) (point-at-eol)))
(setq counter (1+ counter))
(org-caldav-debug-print
1 (format "(Try %d) Error when trying to retrieve UID %s: %s"
counter uid errormessage)))))
(unless eventbuffer
;; Give up
(error "Failed to retrieve UID %s after %d tries with error %s"
uid org-caldav-retry-attempts errormessage))
(with-current-buffer eventbuffer
(unless (search-forward "BEGIN:VCALENDAR" nil t)
(error "Failed to find calendar entry for UID %s (see buffer %s)"
uid (buffer-name eventbuffer)))
(beginning-of-line)
(unless with-headers
(delete-region (point-min) (point)))
(save-excursion
(while (re-search-forward "\^M" nil t)
(replace-match "")))
;; Join lines because of bug in icalendar parsing.
(save-excursion
(while (re-search-forward "^ " nil t)
(delete-char -2)))
(org-caldav-debug-print 2 (format "Content of event UID %s: " uid)
(buffer-string)))
eventbuffer))
(defun org-caldav-put-event (buffer)
"Add event in BUFFER to calendar.
The filename will be derived from the UID."
(let ((event (with-current-buffer buffer (buffer-string))))
(with-temp-buffer
(insert org-caldav-calendar-preamble event "END:VCALENDAR\n")
(goto-char (point-min))
(let* ((uid (org-caldav-get-uid))
(url (concat (org-caldav-events-url) (url-hexify-string uid) org-caldav-uuid-extension)))
(org-caldav-debug-print 1 (format "Putting event UID %s." uid))
(org-caldav-debug-print 2 (format "Content of event UID %s: " uid)
(buffer-string))
(setq org-caldav-empty-calendar nil)
(org-caldav-save-resource
(concat (org-caldav-events-url) uid org-caldav-uuid-extension)
(encode-coding-string (buffer-string) 'utf-8))))))
(defun org-caldav-url-dav-delete-file (url)
"Delete URL.
Will switch to OAuth2 if necessary."
(org-caldav-url-retrieve-synchronously url "DELETE"))
(defun org-caldav-delete-event (uid)
"Delete event UID from calendar.
Returns t on success and nil if an error occurs. The error will
be caught and a message displayed instead."
(org-caldav-debug-print 1 (format "Deleting event UID %s." uid))
(condition-case err
(progn
(org-caldav-url-dav-delete-file
(concat (org-caldav-events-url) uid org-caldav-uuid-extension))
t)
(error
(progn
(message "Could not delete URI %s." uid)
(org-caldav-debug-print 1 "Got error while removing UID:" err)
nil))))
(defun org-caldav-delete-everything (prefix)
"Delete all events from Calendar and removes state file.
Again: This deletes all events in your calendar. So only do this
if you're really sure. This has to be called with a prefix, just
so you don't do it by accident."
(interactive "P")
(if (not prefix)
(message "This function has to be called with a prefix.")
(unless (or org-caldav-empty-calendar
(not (y-or-n-p "This will delete EVERYTHING in your calendar. \
Are you really sure? ")))
(let ((events (org-caldav-get-event-etag-list))
(counter 0)
(url-show-status nil))
(dolist (cur events)
(setq counter (1+ counter))
(message "Deleting event %d of %d" counter (length events))
(org-caldav-delete-event (car cur)))
(setq org-caldav-empty-calendar t))
(when (file-exists-p
(org-caldav-sync-state-filename org-caldav-calendar-id))
(delete-file (org-caldav-sync-state-filename org-caldav-calendar-id)))
(setq org-caldav-event-list nil)
(setq org-caldav-sync-result nil)
(message "Done"))))
(defun org-caldav-events-url ()
"Return URL for events."
(let* ((url
(if (org-caldav-use-oauth2)
(nth 4 (assoc org-caldav-url org-caldav-oauth2-providers))
org-caldav-url))
(eventsurl
(if (string-match ".*%s.*" url)
(format url org-caldav-calendar-id)
(concat url "/" org-caldav-calendar-id "/"))))
(if (string-match ".*/$" eventsurl)
eventsurl
(concat eventsurl "/"))))
(defun org-caldav-update-eventdb-from-org (buf)
"With combined ics file in BUF, update the event database."
(org-caldav-debug-print 1 "=== Updating EventDB from Org")
(with-current-buffer buf
(goto-char (point-min))
(while (org-caldav-narrow-next-event)
(let* ((uid (org-caldav-rewrite-uid-in-event))
(md5 (unless (string-match "^orgsexp-" uid)
(org-caldav-generate-md5-for-org-entry uid)))
(event (org-caldav-search-event uid)))
(cond
((null event)
;; Event does not yet exist in DB, so add it.
(org-caldav-debug-print 1
(format "Org UID %s: New" uid))
(org-caldav-add-event uid md5 nil nil 'new-in-org))
((not (string= md5 (org-caldav-event-md5 event)))
;; Event exists but has changed MD5, so mark it as changed.
(org-caldav-debug-print 1
(format "Org UID %s: Changed" uid))
(org-caldav-event-set-md5 event md5)
(org-caldav-event-set-status event 'changed-in-org))
((eq (org-caldav-event-status event) 'new-in-org)
(org-caldav-debug-print 1
(format "Org UID %s: Error. Double entry." uid))
(push (list org-caldav-calendar-id
uid 'new-in-org 'error:double-entry)
org-caldav-sync-result))
(t
(org-caldav-debug-print 1
(format "Org UID %s: Synced" uid))
(org-caldav-event-set-status event 'in-org)))))
;; Mark events deleted in Org
(dolist (cur (org-caldav-filter-events nil))
(org-caldav-debug-print
1 (format "Cal UID %s: Deleted in Org" (car cur)))
(org-caldav-event-set-status cur 'deleted-in-org))))
(defun org-caldav-update-eventdb-from-cal ()
"Update event database from calendar."
(org-caldav-debug-print 1 "=== Updating EventDB from Cal")
(let ((events (org-caldav-get-event-etag-list))
dbentry)
(dolist (cur events)
;; Search entry in database.
(setq dbentry (org-caldav-search-event (car cur)))
(cond
((not dbentry)
;; Event is not yet in database, so add it.
(org-caldav-debug-print 1
(format "Cal UID %s: New" (car cur)))
(org-caldav-add-event (car cur) nil (cdr cur) nil 'new-in-cal))
((eq (org-caldav-event-status dbentry) 'ignored)
(org-caldav-debug-print 1 (format "Cal UID %s: Ignored." (car cur))))
((or (eq (org-caldav-event-status dbentry) 'changed-in-org)
(eq (org-caldav-event-status dbentry) 'deleted-in-org))
(org-caldav-debug-print 1
(format "Cal UID %s: Ignoring (Org always wins)." (car cur))))
((null (org-caldav-event-etag dbentry))
(org-caldav-debug-print 1
(format "Cal UID %s: No Etag. Mark as change, so putting it again." (car cur)))
(org-caldav-event-set-status dbentry 'changed-in-org))
((not (string= (cdr cur) (org-caldav-event-etag dbentry)))
;; Event's etag changed.
(org-caldav-debug-print 1
(format "Cal UID %s: Changed" (car cur)))
(org-caldav-event-set-status dbentry 'changed-in-cal)
(org-caldav-event-set-etag dbentry (cdr cur)))
((null (org-caldav-event-status dbentry))
;; Event was deleted in Org
(org-caldav-debug-print 1
(format "Cal UID %s: Deleted in Org" (car cur)))
(org-caldav-event-set-status dbentry 'deleted-in-org))
((eq (org-caldav-event-status dbentry) 'in-org)
(org-caldav-debug-print 1
(format "Cal UID %s: Synced" (car cur)))
(org-caldav-event-set-status dbentry 'synced))
((eq (org-caldav-event-status dbentry) 'changed-in-org)
;; Do nothing
)
(t
(error "Unknown status; this is probably a bug."))))
;; Mark events deleted in cal.
(dolist (cur (org-caldav-filter-events 'in-org))
(org-caldav-debug-print 1
(format "Cal UID %s: Deleted in Cal" (car cur)))
(org-caldav-event-set-status cur 'deleted-in-cal))))
(defun org-caldav-generate-md5-for-org-entry (uid)
"Find Org entry with UID and calculate its MD5."
(let ((marker (org-id-find uid t)))
(when (null marker)
(error "Could not find UID %s." uid))
(with-current-buffer (marker-buffer marker)
(goto-char (marker-position marker))
(md5 (buffer-substring-no-properties
(org-entry-beginning-position)
(org-entry-end-position))))))
(defun org-caldav-var-for-key (key)
"Return associated global org-caldav variable for key KEY."
(cl-case key
(:url 'org-caldav-url)
(:calendar-id 'org-caldav-calendar-id)
(:files 'org-caldav-files)
(:select-tags 'org-caldav-select-tags)
(:exclude-tags 'org-caldav-exclude-tags)
(:inbox 'org-caldav-inbox)
(:skip-conditions 'org-caldav-skip-conditions)
(:sync-direction 'org-caldav-sync-direction)
(t (intern
(concat "org-"
(substring (symbol-name key) 1))))))
(defsubst org-caldav-sync-do-cal->org ()
"True if we have to sync from calendar to org."
(member org-caldav-sync-direction '(twoway cal->org)))
(defsubst org-caldav-sync-do-org->cal ()
"True if we have to sync from org to calendar."
(member org-caldav-sync-direction '(twoway org->cal)))
(defun org-caldav-get-org-files-for-sync ()
"Return list of all org files for syncing.
This adds the inbox if necessary."
(let ((inbox (org-caldav-inbox-file org-caldav-inbox)))
(append org-caldav-files
(when (and inbox
(org-caldav-sync-do-org->cal)
(not (member inbox org-caldav-files)))
(list inbox)))))
(defun org-caldav-sync-calendar (&optional calendar resume)
"Sync one calendar, optionally provided through plist CALENDAR.
The format of CALENDAR is described in `org-caldav-calendars'.
If CALENDAR is not provided, the default values will be used.
If RESUME is non-nil, try to resume."
(setq org-caldav-empty-calendar nil)
(setq org-caldav-previous-calendar calendar)
(let (calkeys calvalues oauth-enable)
;; Extrace keys and values from 'calendar' for progv binding.
(dolist (i (number-sequence 0 (1- (length calendar)) 2))
(setq calkeys (append calkeys (list (nth i calendar)))
calvalues (append calvalues (list (nth (1+ i) calendar)))))
(cl-progv (mapcar 'org-caldav-var-for-key calkeys) calvalues
(when (org-caldav-sync-do-org->cal)
(dolist (filename (org-caldav-get-org-files-for-sync))
(when (not (file-exists-p filename))
(if (yes-or-no-p (format "File %s does not exist, create it?" filename))
(write-region "" nil filename)
(user-error "File %s does not exist" filename)))))
;; Check if we need to do OAuth2
(when (org-caldav-use-oauth2)
;; We need to do oauth2. Check if it is available.
(org-caldav-check-oauth2 org-caldav-url)
;; Retrieve token
(org-caldav-retrieve-oauth2-token org-caldav-url org-caldav-calendar-id))
(let ((numretry 0)
success)
(while (null success)
(condition-case err
(progn
(org-caldav-check-connection)
(setq success t))
(error
(if (= numretry (1- org-caldav-retry-attempts))
(org-caldav-check-connection)
(org-caldav-debug-print
1 "Got error while checking connection (will try again):" err)
(cl-incf numretry))))))
(unless resume
(setq org-caldav-event-list nil
org-caldav-previous-files nil)
(org-caldav-load-sync-state)
;; Check if org files were removed.
(when org-caldav-previous-files
(let ((missing (cl-set-difference org-caldav-previous-files
org-caldav-files
:test #'string=)))
(when (and missing
(not (yes-or-no-p
(concat "WARNING: Previously synced file(s) are missing: "
(mapconcat 'identity missing ",")
". Are you sure you want to sync?"))))
(user-error "Sync aborted"))))
;; Remove status in event list
(dolist (cur org-caldav-event-list)
(unless (eq (org-caldav-event-status cur) 'ignored)
(org-caldav-event-set-status cur nil)))
;; Update events for the org->cal direction
(when (org-caldav-sync-do-org->cal)
;; Export Org to icalendar format
(setq org-caldav-ics-buffer (org-caldav-generate-ics))
(org-caldav-update-eventdb-from-org org-caldav-ics-buffer))
;; Update events for the cal->org direction
(when (org-caldav-sync-do-cal->org)
(org-caldav-update-eventdb-from-cal)))
(when (org-caldav-sync-do-org->cal)
(org-caldav-update-events-in-cal org-caldav-ics-buffer))
(when (org-caldav-sync-do-cal->org)
(org-caldav-update-events-in-org))
(org-caldav-save-sync-state)
(setq org-caldav-event-list nil)
(when (org-caldav-sync-do-org->cal)
(with-current-buffer org-caldav-ics-buffer
(set-buffer-modified-p nil)
(kill-buffer))
(delete-file (buffer-file-name org-caldav-ics-buffer))))))
;;;###autoload
(defun org-caldav-sync ()
"Sync Org with calendar."
(interactive)
(unless (or (> emacs-major-version 24)
(and (= emacs-major-version 24)
(> emacs-minor-version 2)))
(user-error "You have to use at least Emacs 24.3"))
(org-caldav-debug-print 1 "========== Started sync.")
(if (and org-caldav-event-list
(not (eq org-caldav-resume-aborted 'never))
(or (eq org-caldav-resume-aborted 'always)
(and (eq org-caldav-resume-aborted 'ask)
(y-or-n-p "Last sync seems to have been aborted. \
Should I try to resume? "))))
(org-caldav-sync-calendar org-caldav-previous-calendar t)
(setq org-caldav-sync-result nil)
(if (null org-caldav-calendars)
(org-caldav-sync-calendar)
(dolist (calendar org-caldav-calendars)
(org-caldav-debug-print 1 "Syncing first calendar entry:" calendar)
(org-caldav-sync-calendar calendar))))
(when org-caldav-show-sync-results
(org-caldav-display-sync-results))
(message "Finished sync."))
(defun org-caldav-update-events-in-cal (icsbuf)
"Update events in calendar.
ICSBUF is the buffer containing the exported iCalendar file."
(org-caldav-debug-print 1 "=== Updating events in calendar")
(with-current-buffer icsbuf
(widen)
(goto-char (point-min))
(let ((events (append (org-caldav-filter-events 'new-in-org)
(org-caldav-filter-events 'changed-in-org)))
(counter 0)
(url-show-status nil)
(event-etag (org-caldav-get-event-etag-list))
uid)
;; Put the events via CalDAV.
(dolist (cur events)
(setq counter (1+ counter))
(if (eq (org-caldav-event-etag cur) 'put)
(org-caldav-debug-print 1
(format "Event UID %s: Was already put previously." (car cur)))
(org-caldav-debug-print 1
(format "Event UID %s: Org --> Cal" (car cur)))
(widen)
(goto-char (point-min))
(while (and (setq uid (org-caldav-get-uid))
(not (string-match (car cur) uid))))
(unless (string-match (car cur) uid)
(error "Could not find UID %s" (car cur)))
(org-caldav-narrow-event-under-point)
(org-caldav-cleanup-ics-description)
(org-caldav-maybe-fix-timezone)
(org-caldav-set-sequence-number cur event-etag)
(message "Putting event %d of %d" counter (length events))
(if (org-caldav-put-event icsbuf)
(org-caldav-event-set-etag cur 'put)
(org-caldav-debug-print 1
(format "Event UID %s: Error while doing Org --> Cal" (car cur)))
(org-caldav-event-set-status cur 'error)
(push (list org-caldav-calendar-id (car cur)
'error 'error:org->cal)
org-caldav-sync-result))))
;; Get Etags
(setq event-etag (org-caldav-get-event-etag-list))
(dolist (cur events)
(let ((etag (assoc (car cur) event-etag)))
(when (and (not (eq (org-caldav-event-status cur) 'error))
etag)
(org-caldav-event-set-etag cur (cdr etag))
(push (list org-caldav-calendar-id (car cur)
(org-caldav-event-status cur) 'org->cal)
org-caldav-sync-result)))))
;; Remove events that were deleted in org
(unless (eq org-caldav-delete-calendar-entries 'never)
(let ((events (org-caldav-filter-events 'deleted-in-org))
(url-show-status nil)
(counter 0))
(dolist (cur events)
(setq counter (1+ counter))
(when (or (eq org-caldav-delete-calendar-entries 'always)
(y-or-n-p (format "Delete event '%s' from calendar?"
(org-caldav-get-calendar-summary-from-uid
(car cur)))))
(message "Deleting event %d from %d" counter (length events))
(org-caldav-delete-event (car cur))
(push (list org-caldav-calendar-id (car cur)
'deleted-in-org 'removed-from-cal)
org-caldav-sync-result)
(setq org-caldav-event-list
(delete cur org-caldav-event-list))))))
;; Remove events that could not be put
(dolist (cur (org-caldav-filter-events 'error))
(setq org-caldav-event-list
(delete cur org-caldav-event-list)))))
(defun org-caldav-set-sequence-number (event event-etag)
"Set sequence number in ics and in eventdb for EVENT.
EVENT-ETAG is the current list of events and etags on the server.
The ics must be in the current buffer."
(save-excursion
(let ((seq (org-caldav-event-sequence event))
retrieve)
(unless (or seq
(not (assoc (car event) event-etag)))
;; We don't have a sequence yet, but event is already in the
;; calendar, hence we have to get the current number first.
(setq retrieve (org-caldav-get-event (car event)))
(when (null retrieve)
;; Retrieving the event failed... so let's just use '1' and
;; hope it works.
(org-caldav-debug-print 1 (format "UID %s: Failed to retrieve item from server." (car event)))
(org-caldav-debug-print 1 (format "UID %s: Use sequence number 1 and hope for the best." (car event)))
(setq seq 0)) ;; incremented below
(unless seq
(with-current-buffer (org-caldav-get-event (car event))
(goto-char (point-min))
(if (re-search-forward "^SEQUENCE:\\s-*\\([0-9]+\\)" nil t)
(progn
(setq seq (string-to-number (match-string 1)))
(org-caldav-debug-print 1 (format "UID %s: Got sequence number %d" (car event) seq)))
(org-caldav-debug-print 1 (format "UID %s: Event does not have sequence number, start with 1." (car event)))
(setq seq 0))))) ;; incremented below
(when seq
(setq seq (1+ seq))
(goto-char (point-min))
(re-search-forward "^SUMMARY:")
(forward-line)
(beginning-of-line)
(insert "SEQUENCE:" (number-to-string seq) "\n")
(org-caldav-event-set-sequence event seq)))))
(defun org-caldav-cleanup-ics-description ()
"Cleanup description for event in current buffer.
This removes timestamps which weren't properly removed by
org-icalendar."
(save-excursion
(goto-char (point-min))
(when (re-search-forward "^DESCRIPTION:.*?\\(\s*-*<[^>]+>\\(–<[^>]+>\\)?\\(\\\\n\\\\n\\)?\\)" nil t)
(replace-match "" nil nil nil 1))))
(defun org-caldav-maybe-fix-timezone ()
"Fix the timezone if it is all uppercase.
This is a bug in older Org versions."
(unless (null org-icalendar-timezone)
(save-excursion
(goto-char (point-min))
(while (search-forward (upcase org-icalendar-timezone) nil t)
(replace-match org-icalendar-timezone t)))))
(defun org-caldav-inbox-file (inbox)
"Return file name associated with INBOX.
For format of INBOX, see `org-caldav-inbox'."
(cond ((stringp inbox)
inbox)
((memq (car inbox) '(file file+headline))
(nth 1 inbox))
((eq (car inbox) 'id)
(org-id-find-id-file (nth 1 inbox)))))
(defun org-caldav-inbox-point-and-level (inbox)
"Return position and level where to add new entries in INBOX.
For format of INBOX, see `org-caldav-inbox'. The values are
returned as a cons (POINT . LEVEL)."
(cond ((or (stringp inbox) (eq (car inbox) 'file))
(cons (point-max) 1))
((eq (car inbox) 'file+headline)
(save-excursion
(let ((org-link-search-inhibit-query t)
level)
;; org-link-search changed signature in v8.3
(with-no-warnings
(if (version< org-version "8.3")
(org-link-search (concat "*" (nth 2 inbox)) nil nil t)
(org-link-search (concat "*" (nth 2 inbox)) nil t)))
(setq level (1+ (org-current-level)))