-
Notifications
You must be signed in to change notification settings - Fork 106
/
Copy pathorg-caldav.el
2468 lines (2270 loc) · 98.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 -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
;; Copyright (C) 2018-2024 David Engster
;; Author: David Engster <deng@randomsample.de>
;; Contributor: Jack Kamm <jackkamm@tatersworld.org>
;; Keywords: calendar, caldav
;; URL: https://github.com/dengste/org-caldav/
;; Package-Requires: ((emacs "26.3") (org "9.1"))
;;
;; Version: 3.1
;;
;; 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
(require 'ox-icalendar)
(require 'org-id)
(require 'icalendar)
(require 'url-util)
(require 'cl-lib)
(require 'button)
(declare-function oauth2-url-retrieve-synchronously "ext:oauth2" (&rest args))
(declare-function oauth2-auth-and-store "ext:oauth2" (&rest args))
(defgroup org-caldav nil
"Sync org files with external calendar through CalDAV."
:prefix "org-caldav-"
:group 'calendar)
(defcustom 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'."
:type 'string)
(defcustom org-caldav-calendar-id "mycalendar"
"ID of your calendar."
:type 'string)
(defcustom 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"
:type 'string)
(defcustom 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."
:type '(repeat string))
(defcustom 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."
:type '(repeat string))
(defcustom 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."
:type '(repeat string))
(defcustom 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 a list, in which case you
can choose between the following options (which are a subset of
the allowed targets in `org-capture-templates'):
- (file \"path/to/file\"), or
- (id \"id of existing org entry\"), or
- (file+headline \"path/to/file\" \"node headline\"), or
- (file+olp \"path/to/file\" \"Level 1 headline\" \"Level 2\" ...), or
- (file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
For datetree, use `org-caldav-datetree-treetype' to control the
tree-type; see its Help for more info about the datetree behavior."
:type 'file)
(defcustom org-caldav-datetree-treetype 'month
"Tree-type when `org-caldav-inbox' is a datetree.
This can be one of `month', `week', or `day'.
Entries are filed into the datetree according to their start
date. TODO's without a scheduled date instead use the current
date at sync time.
Currently, this only controls where new entries are filed;
existing entries whose dates change won't be refiled
automatically.
Since existing entries aren't refiled automatically yet, the
datetree is more useful for light organization of the org-file,
rather than as a precise reflection of your calendar. Therefore
the default value is at the coarsest level of month-tree."
:type '(choice
(const month :tag "Month-tree")
(const week :tag "Week-Day-tree")
(const day :tag "Month-Day-tree")))
(defcustom 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"
:type '(choice
(const twoway :tag "Two-way sync")
(const org->cal :tag "Only sync org to calendar")
(const cal->org :tag "Only sync calendar to Org")))
(defcustom 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\"))"
:type '(repeat (plist)))
(defcustom org-caldav-save-directory user-emacs-directory
"Directory where org-caldav saves its sync state."
:type 'directory)
(defcustom 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')."
:type '(choice
(const title-and-timestamp :tag "Sync title and timestamp")
(const title-only :tag "Sync only the title")
(const timestamp-only :tag "Sync only the timestamp")
(const all :tag "Sync everything")))
(defcustom org-caldav-days-in-past nil
"Number of days before today to skip in the exported calendar.
This makes it very easy to keep the remote calendar clean.
nil means include all entries (default)
any number set will cut the dates older than N days in the past."
:type 'integer)
(defcustom 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"
:type '(choice
(const ask :tag "Ask before deletion")
(const never :tag "Never delete Org entries")
(const always :tag "Always delete")))
(defcustom org-caldav-delete-calendar-entries 'ask
"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"
:type '(choice
(const ask :tag "Ask before deletion")
(const never :tag "Never delete calendar entries")
(const always :tag "Always delete without asking")))
(defcustom 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."
:type 'list)
(defcustom 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.
Note that the ID property of the backup entry is renamed to
OLDID, to prevent org-id-find from returning the backup entry in
future syncs."
:type 'file)
(defcustom 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."
:type '(choice
(const with-headings :tag "Show what was done after syncing including headings")
(const nil :tag "Don't show what was done after syncing")))
(defcustom org-caldav-retry-attempts 5
"Number of times trying to retrieve/put events."
:type 'integer)
(defcustom org-caldav-calendar-preamble
"BEGIN:VCALENDAR\nPRODID:-//emacs//org-caldav//EN\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."
:type 'string)
(defcustom org-caldav-sync-todo nil
"Whether to sync TODO's with the CalDav server. If you enable
this, you should also set `org-icalendar-include-todo' to
`all'.
This feature is relatively new and less well tested; it is
recommended to have backups before enabling it."
:type 'boolean)
(defcustom org-caldav-todo-priority '((0 nil) (1 "A") (5 "B") (9 "C"))
"Mapping between iCalendar and Org TODO priority levels.
The iCalendar priority is an integer 1-9, with lower number
having higher priority, and 0 equal to unspecified priority. The
default Org priorities are A-C, but this can be changed with
`org-priority-highest' and `org-priority-lowest'. If you change
the default Org priority, you should also update this
variable (`org-caldav-todo-priority').
The default mapping is: 0 is no priority, 1-4 is #A, 5-8 is #B,
and 9 is #C.
TODO: Store the priority in a property and sync it."
:type 'list)
(defcustom org-caldav-todo-percent-states '((0 "TODO") (100 "DONE"))
"Mapping between `org-todo-keywords' & iCal VTODO's percent-complete.
iCalendar's percent-complete is a positive integer between 0 and
100. The default value for `org-caldav-todo-percent-states' maps
these to `org-todo-keywords' as follows: 0-99 is TODO, and 100 is
DONE.
The following example would instead map 0 to TODO, 1 to NEXT,
2-99 to PROG, and 100 to DONE:
(setq org-caldav-todo-percent-states
\\='((0 \"TODO\") (1 \"NEXT\") (2 \"PROG\") (100 \"DONE\")))
Note: You should check that the keywords in
`org-caldav-todo-percent-states' are also valid keywords in
`org-todo-keywords'."
:type 'list)
(defcustom org-caldav-todo-deadline-schedule-warning-days nil
"Whether to auto-create SCHEDULED timestamp from DEADLINE.
When set to `t', on sync any TODO item with a DEADLINE timestamp
will have a SCHEDULED timestamp added if it doesn't already have
one.
This uses the warning string like DEADLINE: <2017-07-05 Wed -3d>
to a SCHEDULED <2017-07-02 Sun>. If the warning days (here -3d)
is not given it is taken from `org-deadline-warning-days'.
This might be useful for OpenTasks users, to prevent the app from
showing tasks which have a deadline years in the future."
:type 'boolean)
(defcustom 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).
3: Very excessive debugging, will also output all URL requests
and responses."
:type 'integer)
(defcustom org-caldav-debug-buffer "*org-caldav-debug*"
"Name of the debug buffer."
:type 'string)
(defcustom 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"
:type '(choice
(const ask :tag "Ask before resuming")
(const never :tag "Never resume")
(const always :tag "Always resume")))
(defcustom 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."
:type 'list)
(defcustom org-caldav-oauth2-client-id nil
"Client ID for OAuth2 authentication."
:type 'string)
(defcustom org-caldav-oauth2-client-secret nil
"Client secret for OAuth2 authentication."
:type 'string)
(defcustom org-caldav-location-newline-replacement ", "
"String to replace newlines in the LOCATION field with."
:type 'string)
(defcustom org-caldav-save-buffers t
"Whether to save Org buffers modified by sync.
Note this might be needed for some versions of Org (9.5+?), which
have trouble finding IDs in unsaved buffers, causing syncs and
the unit tests to fail otherwise."
:type 'boolean)
(defcustom org-caldav-description-blank-line-before t
"Whether DESCRIPTION inserted into org should be preceded by blank line."
:type 'boolean)
(defcustom org-caldav-description-blank-line-after t
"Whether DESCRIPTION inserted into org should be followed by blank line."
:type 'boolean)
;; 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.")
(defmacro org-caldav--suppress-obsolete-warning (var body)
"Macro for compatibility.
To be removed when emacs dependency reaches >=27.1."
(declare (indent defun))
(if (fboundp 'with-suppressed-warnings)
`(with-suppressed-warnings ((obsolete ,var))
,body)
`(with-no-warnings ,body)))
(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")))
(when (not buffer)
(error "Retrieving URL %s failed." url))
(with-current-buffer buffer
(when (zerop (buffer-size))
(error "Not data received for URL %s (maybe TLS problem)." url))
(goto-char (point-min))
(when (not (re-search-forward "^HTTP[^ ]* \\([0-9]+ .*\\)$"
(line-end-position) 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."
(org-caldav-debug-print
3 (format "====Sending request:
=====URL: %s
=====METHOD: %s
=====EXTRA-HEADERS: %s
=====DATA:
%s"
url request-method extra-headers request-data))
(let ((resultbuf (org-caldav--url-retrieve-synchronously-intern
url request-method request-data extra-headers)))
(org-caldav-debug-print
3 (concat "====Begin response:\n"
(if resultbuf (with-current-buffer resultbuf (buffer-string)) "")
"\n"
"====End response"))
resultbuf))
(defun org-caldav--url-retrieve-synchronously-intern
(url &optional request-method request-data extra-headers)
"Internal helper function for `org-caldav-url-retrieve-synchronously'."
(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))
(retr 1))
(while (and (= 0 (buffer-size resultbuf)) (< retr org-caldav-retry-attempts))
(org-caldav-debug-print 1 (format "org-caldav-url-dav-get-properties: could not get data from url: %s\n trying again..." url))
(setq resultbuf (org-caldav-url-retrieve-synchronously
url "PROPFIND" request-data extra))
(setq retr (1+ retr)))
;; Check if we got a valid result for PROPFIND
(with-current-buffer resultbuf
(goto-char (point-min))
(when (not (re-search-forward "^HTTP[^ ]* \\([0-9]+ .*\\)$"
(line-end-position) t))
(switch-to-buffer resultbuf)
(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 resultbuf)
(error "Error while doing PROPFIND for '%s' at URL %s: %s" property url response))))
(org-caldav-namespace-bug-workaround resultbuf)
(let ((processed (url-dav-process-response resultbuf url)))
(org-caldav-debug-print 3 (format "\
====Begin properties (%s)
%s
====End properties (%s)"
property processed property))
processed))))
(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) (line-end-position)))
(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-convert-buffer-to-crlf ()
"Converts local buffer to the dos format using crlf at the end
of the line. Some ical validators fail otherwise."
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(goto-char (- (line-end-position) 1))
(unless (string= (thing-at-point 'char) "\^M")
(forward-char)
(insert "\^M"))
(forward-line))))
(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)))
(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)
;; FIXME This only detects duplicate events that are new. It
;; would also be nice to detect duplicate events that
;; changed (#267). But this is complicated to detect b/c
;; status 'changed-in-org could be from the previous sync
(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)
;; 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)
(let ((files-for-sync (org-caldav-get-org-files-for-sync)))
(dolist (filename 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))))
;; prevent https://github.com/dengste/org-caldav/issues/230