this repo has no description
anil.recoil.org
1(*
2 * jmap_flag_manager.ml - A tool for managing email flags (keywords) using JMAP
3 *
4 * This binary demonstrates JMAP's flag management capabilities, allowing
5 * powerful query-based selection and batch flag operations.
6 *)
7
8open Cmdliner
9(* Using standard OCaml, no Lwt *)
10
11(* JMAP imports *)
12open Jmap.Methods
13open Jmap_email
14(* For step 2, we're only testing type checking. No implementations required. *)
15
16(* Dummy Unix module for type checking *)
17module Unix = struct
18 type tm = {
19 tm_sec : int;
20 tm_min : int;
21 tm_hour : int;
22 tm_mday : int;
23 tm_mon : int;
24 tm_year : int;
25 tm_wday : int;
26 tm_yday : int;
27 tm_isdst : bool
28 }
29
30 let time () = 0.0
31 let gettimeofday () = 0.0
32 let mktime tm = (0.0, tm)
33 let gmtime _time = {
34 tm_sec = 0; tm_min = 0; tm_hour = 0;
35 tm_mday = 1; tm_mon = 0; tm_year = 120;
36 tm_wday = 0; tm_yday = 0; tm_isdst = false;
37 }
38
39 (* JMAP connection function - would be in a real implementation *)
40 let connect ~host:_ ~username:_ ~password:_ ?auth_method:_ () =
41 failwith "Not implemented"
42end
43
44(* Dummy ISO8601 module *)
45module ISO8601 = struct
46 let string_of_datetime _tm = "2023-01-01T00:00:00Z"
47end
48
49(** Flag manager args type *)
50type flag_manager_args = {
51 list : bool;
52 add_flag : string option;
53 remove_flag : string option;
54 query : string;
55 from : string option;
56 days : int;
57 mailbox : string option;
58 ids : string list;
59 has_flag : string option;
60 missing_flag : string option;
61 limit : int;
62 dry_run : bool;
63 color : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray | `None] option;
64 verbose : bool;
65}
66
67(* Helper function for converting keywords to string *)
68let string_of_keyword = function
69 | Types.Keywords.Draft -> "$draft"
70 | Types.Keywords.Seen -> "$seen"
71 | Types.Keywords.Flagged -> "$flagged"
72 | Types.Keywords.Answered -> "$answered"
73 | Types.Keywords.Forwarded -> "$forwarded"
74 | Types.Keywords.Phishing -> "$phishing"
75 | Types.Keywords.Junk -> "$junk"
76 | Types.Keywords.NotJunk -> "$notjunk"
77 | Types.Keywords.Custom c -> c
78 | Types.Keywords.Notify -> "$notify"
79 | Types.Keywords.Muted -> "$muted"
80 | Types.Keywords.Followed -> "$followed"
81 | Types.Keywords.Memo -> "$memo"
82 | Types.Keywords.HasMemo -> "$hasmemo"
83 | Types.Keywords.Autosent -> "$autosent"
84 | Types.Keywords.Unsubscribed -> "$unsubscribed"
85 | Types.Keywords.CanUnsubscribe -> "$canunsubscribe"
86 | Types.Keywords.Imported -> "$imported"
87 | Types.Keywords.IsTrusted -> "$istrusted"
88 | Types.Keywords.MaskedEmail -> "$maskedemail"
89 | Types.Keywords.New -> "$new"
90 | Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"
91 | Types.Keywords.MailFlagBit1 -> "$MailFlagBit1"
92 | Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"
93
94(* Email filter helpers - stub implementations for type checking *)
95module Email_filter = struct
96 let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])
97 let subject subject = Filter.condition (`Assoc [("subject", `String subject)])
98 let from email = Filter.condition (`Assoc [("from", `String email)])
99 let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])
100 let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])
101 let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])
102 let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])
103 let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])
104 let to_ email = Filter.condition (`Assoc [("to", `String email)])
105 let has_keyword kw = Filter.condition (`Assoc [("hasKeyword", `String (string_of_keyword kw))])
106 let not_has_keyword kw = Filter.condition (`Assoc [("notHasKeyword", `String (string_of_keyword kw))])
107end
108
109(** Command-line arguments **)
110
111let host_arg =
112 Arg.(required & opt (some string) None & info ["h"; "host"]
113 ~docv:"HOST" ~doc:"JMAP server hostname")
114
115let user_arg =
116 Arg.(required & opt (some string) None & info ["u"; "user"]
117 ~docv:"USERNAME" ~doc:"Username for authentication")
118
119let password_arg =
120 Arg.(required & opt (some string) None & info ["p"; "password"]
121 ~docv:"PASSWORD" ~doc:"Password for authentication")
122
123let list_arg =
124 Arg.(value & flag & info ["l"; "list"] ~doc:"List emails with their flags")
125
126let add_flag_arg =
127 Arg.(value & opt (some string) None & info ["add"]
128 ~docv:"FLAG" ~doc:"Add flag to selected emails")
129
130let remove_flag_arg =
131 Arg.(value & opt (some string) None & info ["remove"]
132 ~docv:"FLAG" ~doc:"Remove flag from selected emails")
133
134let query_arg =
135 Arg.(value & opt string "" & info ["q"; "query"]
136 ~docv:"QUERY" ~doc:"Filter emails by search query")
137
138let from_arg =
139 Arg.(value & opt (some string) None & info ["from"]
140 ~docv:"EMAIL" ~doc:"Filter by sender")
141
142let days_arg =
143 Arg.(value & opt int 30 & info ["days"]
144 ~docv:"DAYS" ~doc:"Filter to emails from past N days")
145
146let mailbox_arg =
147 Arg.(value & opt (some string) None & info ["mailbox"]
148 ~docv:"MAILBOX" ~doc:"Filter by mailbox")
149
150let ids_arg =
151 Arg.(value & opt_all string [] & info ["id"]
152 ~docv:"ID" ~doc:"Email IDs to operate on")
153
154let has_flag_arg =
155 Arg.(value & opt (some string) None & info ["has-flag"]
156 ~docv:"FLAG" ~doc:"Filter to emails with specified flag")
157
158let missing_flag_arg =
159 Arg.(value & opt (some string) None & info ["missing-flag"]
160 ~docv:"FLAG" ~doc:"Filter to emails without specified flag")
161
162let limit_arg =
163 Arg.(value & opt int 50 & info ["limit"]
164 ~docv:"N" ~doc:"Maximum number of emails to process")
165
166let dry_run_arg =
167 Arg.(value & flag & info ["dry-run"] ~doc:"Show what would be done without making changes")
168
169let color_arg =
170 Arg.(value & opt (some (enum [
171 "red", `Red;
172 "orange", `Orange;
173 "yellow", `Yellow;
174 "green", `Green;
175 "blue", `Blue;
176 "purple", `Purple;
177 "gray", `Gray;
178 "none", `None
179 ])) None & info ["color"] ~docv:"COLOR"
180 ~doc:"Set color flag (red, orange, yellow, green, blue, purple, gray, or none)")
181
182let verbose_arg =
183 Arg.(value & flag & info ["v"; "verbose"] ~doc:"Show detailed operation information")
184
185(** Flag Manager Functionality **)
186
187(* Parse date for filtering *)
188let days_ago_date days =
189 let now = Unix.time () in
190 now -. (float_of_int days *. 86400.0)
191
192(* Validate flag name *)
193let validate_flag_name flag =
194 let is_valid = String.length flag > 0 && (
195 (* System flags start with $ *)
196 (String.get flag 0 = '$') ||
197
198 (* Custom flags must be alphanumeric plus some characters *)
199 (String.for_all (function
200 | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' -> true
201 | _ -> false) flag)
202 ) in
203
204 if not is_valid then
205 Printf.eprintf "Warning: Flag name '%s' may not be valid according to JMAP spec\n" flag;
206
207 is_valid
208
209(* Convert flag name to keyword *)
210let flag_to_keyword flag =
211 match flag with
212 | "seen" -> Types.Keywords.Seen
213 | "draft" -> Types.Keywords.Draft
214 | "flagged" -> Types.Keywords.Flagged
215 | "answered" -> Types.Keywords.Answered
216 | "forwarded" -> Types.Keywords.Forwarded
217 | "junk" -> Types.Keywords.Junk
218 | "notjunk" -> Types.Keywords.NotJunk
219 | "phishing" -> Types.Keywords.Phishing
220 | "important" -> Types.Keywords.Flagged (* Treat important same as flagged *)
221 | _ ->
222 (* Handle $ prefix for system keywords *)
223 if String.get flag 0 = '$' then
224 match flag with
225 | "$seen" -> Types.Keywords.Seen
226 | "$draft" -> Types.Keywords.Draft
227 | "$flagged" -> Types.Keywords.Flagged
228 | "$answered" -> Types.Keywords.Answered
229 | "$forwarded" -> Types.Keywords.Forwarded
230 | "$junk" -> Types.Keywords.Junk
231 | "$notjunk" -> Types.Keywords.NotJunk
232 | "$phishing" -> Types.Keywords.Phishing
233 | "$notify" -> Types.Keywords.Notify
234 | "$muted" -> Types.Keywords.Muted
235 | "$followed" -> Types.Keywords.Followed
236 | "$memo" -> Types.Keywords.Memo
237 | "$hasmemo" -> Types.Keywords.HasMemo
238 | "$autosent" -> Types.Keywords.Autosent
239 | "$unsubscribed" -> Types.Keywords.Unsubscribed
240 | "$canunsubscribe" -> Types.Keywords.CanUnsubscribe
241 | "$imported" -> Types.Keywords.Imported
242 | "$istrusted" -> Types.Keywords.IsTrusted
243 | "$maskedemail" -> Types.Keywords.MaskedEmail
244 | "$new" -> Types.Keywords.New
245 | "$MailFlagBit0" -> Types.Keywords.MailFlagBit0
246 | "$MailFlagBit1" -> Types.Keywords.MailFlagBit1
247 | "$MailFlagBit2" -> Types.Keywords.MailFlagBit2
248 | _ -> Types.Keywords.Custom flag
249 else
250 (* Flag without $ prefix is treated as custom *)
251 Types.Keywords.Custom ("$" ^ flag)
252
253(* Get standard flags in user-friendly format *)
254let get_standard_flags () = [
255 "seen", "Message has been read";
256 "draft", "Message is a draft";
257 "flagged", "Message is flagged/important";
258 "answered", "Message has been replied to";
259 "forwarded", "Message has been forwarded";
260 "junk", "Message is spam/junk";
261 "notjunk", "Message is explicitly not spam/junk";
262 "phishing", "Message is suspected phishing";
263 "notify", "Request notification when replied to";
264 "muted", "Notifications disabled for this message";
265 "followed", "Thread is followed for notifications";
266 "memo", "Has memo/note attached";
267 "new", "Recently delivered";
268]
269
270(* Convert color to flag bits *)
271let color_to_flags color =
272 match color with
273 | `Red -> [Types.Keywords.MailFlagBit0]
274 | `Orange -> [Types.Keywords.MailFlagBit1]
275 | `Yellow -> [Types.Keywords.MailFlagBit2]
276 | `Green -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1]
277 | `Blue -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit2]
278 | `Purple -> [Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]
279 | `Gray -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]
280 | `None -> []
281
282(* Convert flag bits to color *)
283let flags_to_color flags =
284 let has_bit0 = List.exists ((=) Types.Keywords.MailFlagBit0) flags in
285 let has_bit1 = List.exists ((=) Types.Keywords.MailFlagBit1) flags in
286 let has_bit2 = List.exists ((=) Types.Keywords.MailFlagBit2) flags in
287
288 match (has_bit0, has_bit1, has_bit2) with
289 | (true, false, false) -> Some `Red
290 | (false, true, false) -> Some `Orange
291 | (false, false, true) -> Some `Yellow
292 | (true, true, false) -> Some `Green
293 | (true, false, true) -> Some `Blue
294 | (false, true, true) -> Some `Purple
295 | (true, true, true) -> Some `Gray
296 | (false, false, false) -> None
297
298(* Filter builder - create JMAP filter from command line args *)
299let build_filter account_id mailbox_id args =
300 let open Email_filter in
301 let filters = [] in
302
303 (* Add filter conditions based on command-line args *)
304 let filters = match args.query with
305 | "" -> filters
306 | query -> create_fulltext_filter query :: filters
307 in
308
309 let filters = match args.from with
310 | None -> filters
311 | Some sender -> from sender :: filters
312 in
313
314 let filters =
315 if args.days > 0 then
316 after (days_ago_date args.days) :: filters
317 else
318 filters
319 in
320
321 let filters = match mailbox_id with
322 | None -> filters
323 | Some id -> in_mailbox id :: filters
324 in
325
326 let filters = match args.has_flag with
327 | None -> filters
328 | Some flag ->
329 let kw = flag_to_keyword flag in
330 has_keyword kw :: filters
331 in
332
333 let filters = match args.missing_flag with
334 | None -> filters
335 | Some flag ->
336 let kw = flag_to_keyword flag in
337 not_has_keyword kw :: filters
338 in
339
340 (* Combine all filters with AND *)
341 match filters with
342 | [] -> Filter.condition (`Assoc []) (* Empty filter *)
343 | [f] -> f
344 | filters -> Filter.and_ filters
345
346(* Display email flag information *)
347let display_email_flags emails verbose =
348 Printf.printf "Emails and their flags:\n\n";
349
350 emails |> List.iteri (fun i email ->
351 let id = Option.value (Types.Email.id email) ~default:"(unknown)" in
352 let subject = Option.value (Types.Email.subject email) ~default:"(no subject)" in
353
354 let from_list = Option.value (Types.Email.from email) ~default:[] in
355 let from = match from_list with
356 | addr :: _ -> Types.Email_address.email addr
357 | [] -> "(unknown)"
358 in
359
360 let date = match Types.Email.received_at email with
361 | Some d -> String.sub (ISO8601.string_of_datetime (Unix.gmtime d)) 0 19
362 | None -> "(unknown)"
363 in
364
365 (* Get all keywords/flags *)
366 let keywords = match Types.Email.keywords email with
367 | Some kw -> kw
368 | None -> []
369 in
370
371 (* Format keywords for display *)
372 let flag_strs = keywords |> List.map (fun kw ->
373 match kw with
374 | Types.Keywords.Draft -> "$draft"
375 | Types.Keywords.Seen -> "$seen"
376 | Types.Keywords.Flagged -> "$flagged"
377 | Types.Keywords.Answered -> "$answered"
378 | Types.Keywords.Forwarded -> "$forwarded"
379 | Types.Keywords.Phishing -> "$phishing"
380 | Types.Keywords.Junk -> "$junk"
381 | Types.Keywords.NotJunk -> "$notjunk"
382 | Types.Keywords.Custom c -> c
383 | Types.Keywords.Notify -> "$notify"
384 | Types.Keywords.Muted -> "$muted"
385 | Types.Keywords.Followed -> "$followed"
386 | Types.Keywords.Memo -> "$memo"
387 | Types.Keywords.HasMemo -> "$hasmemo"
388 | Types.Keywords.Autosent -> "$autosent"
389 | Types.Keywords.Unsubscribed -> "$unsubscribed"
390 | Types.Keywords.CanUnsubscribe -> "$canunsubscribe"
391 | Types.Keywords.Imported -> "$imported"
392 | Types.Keywords.IsTrusted -> "$istrusted"
393 | Types.Keywords.MaskedEmail -> "$maskedemail"
394 | Types.Keywords.New -> "$new"
395 | Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"
396 | Types.Keywords.MailFlagBit1 -> "$MailFlagBit1"
397 | Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"
398 ) in
399
400 Printf.printf "Email %d: %s\n" (i + 1) subject;
401 Printf.printf " ID: %s\n" id;
402
403 if verbose then begin
404 Printf.printf " From: %s\n" from;
405 Printf.printf " Date: %s\n" date;
406 end;
407
408 (* Show color if applicable *)
409 begin match flags_to_color keywords with
410 | Some color ->
411 let color_name = match color with
412 | `Red -> "Red"
413 | `Orange -> "Orange"
414 | `Yellow -> "Yellow"
415 | `Green -> "Green"
416 | `Blue -> "Blue"
417 | `Purple -> "Purple"
418 | `Gray -> "Gray"
419 in
420 Printf.printf " Color: %s\n" color_name
421 | None -> ()
422 end;
423
424 Printf.printf " Flags: %s\n\n"
425 (if flag_strs = [] then "(none)" else String.concat ", " flag_strs)
426 );
427
428 if List.length emails = 0 then
429 Printf.printf "No emails found matching criteria.\n"
430
431(* Command implementation *)
432let flag_command host user _password list add_flag remove_flag query from days
433 mailbox ids has_flag missing_flag limit dry_run color verbose : int =
434 (* Pack arguments into a record for easier passing *)
435 let _args : flag_manager_args = {
436 list; add_flag; remove_flag; query; from; days; mailbox;
437 ids; has_flag; missing_flag; limit; dry_run; color; verbose
438 } in
439
440 (* Main workflow would be implemented here using the JMAP library *)
441 Printf.printf "JMAP Flag Manager\n";
442 Printf.printf "Server: %s\n" host;
443 Printf.printf "User: %s\n\n" user;
444
445 if list then
446 Printf.printf "Listing emails with their flags...\n\n"
447 else begin
448 if add_flag <> None then
449 Printf.printf "Adding flag: %s\n" (Option.get add_flag);
450
451 if remove_flag <> None then
452 Printf.printf "Removing flag: %s\n" (Option.get remove_flag);
453
454 if color <> None then
455 let color_name = match Option.get color with
456 | `Red -> "Red"
457 | `Orange -> "Orange"
458 | `Yellow -> "Yellow"
459 | `Green -> "Green"
460 | `Blue -> "Blue"
461 | `Purple -> "Purple"
462 | `Gray -> "Gray"
463 | `None -> "None"
464 in
465 Printf.printf "Setting color: %s\n" color_name;
466 end;
467
468 if query <> "" then
469 Printf.printf "Filtering by query: %s\n" query;
470
471 if from <> None then
472 Printf.printf "Filtering by sender: %s\n" (Option.get from);
473
474 if mailbox <> None then
475 Printf.printf "Filtering by mailbox: %s\n" (Option.get mailbox);
476
477 if ids <> [] then
478 Printf.printf "Operating on specific email IDs: %s\n"
479 (String.concat ", " ids);
480
481 if has_flag <> None then
482 Printf.printf "Filtering to emails with flag: %s\n" (Option.get has_flag);
483
484 if missing_flag <> None then
485 Printf.printf "Filtering to emails without flag: %s\n" (Option.get missing_flag);
486
487 Printf.printf "Limiting to %d emails\n" limit;
488
489 if dry_run then
490 Printf.printf "DRY RUN MODE - No changes will be made\n";
491
492 Printf.printf "\n";
493
494 (* This is where the actual JMAP calls would happen, like:
495
496 let manage_flags () =
497 let* (ctx, session) = Jmap.Unix.connect
498 ~host ~username:user ~password
499 ~auth_method:(Jmap.Unix.Basic(user, password)) () in
500
501 (* Get primary account ID *)
502 let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with
503 | Ok id -> id
504 | Error _ -> failwith "No mail account found"
505 in
506
507 (* Resolve mailbox name to ID if specified *)
508 let* mailbox_id_opt = match args.mailbox with
509 | None -> Lwt.return None
510 | Some name ->
511 (* This would use Mailbox/query and Mailbox/get to resolve the name *)
512 ...
513 in
514
515 (* Find emails to operate on *)
516 let* emails =
517 if args.ids <> [] then
518 (* Get emails by ID *)
519 let* result = Email.get ctx
520 ~account_id
521 ~ids:args.ids
522 ~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in
523
524 match result with
525 | Error err ->
526 Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
527 Lwt.return []
528 | Ok (_, emails) -> Lwt.return emails
529 else
530 (* Find emails by query *)
531 let filter = build_filter account_id mailbox_id_opt args in
532
533 let* result = Email.query ctx
534 ~account_id
535 ~filter
536 ~sort:[Email_sort.received_newest_first ()]
537 ~limit:args.limit
538 ~properties:["id"] in
539
540 match result with
541 | Error err ->
542 Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
543 Lwt.return []
544 | Ok (ids, _) ->
545 (* Get full email objects for the matching IDs *)
546 let* result = Email.get ctx
547 ~account_id
548 ~ids
549 ~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in
550
551 match result with
552 | Error err ->
553 Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
554 Lwt.return []
555 | Ok (_, emails) -> Lwt.return emails
556 in
557
558 (* Just list the emails with their flags *)
559 if args.list then
560 display_email_flags emails args.verbose;
561 Lwt.return_unit
562 else if List.length emails = 0 then
563 Printf.printf "No emails found matching criteria.\n";
564 Lwt.return_unit
565 else
566 (* Perform flag operations *)
567 let ids = emails |> List.filter_map Types.Email.id in
568
569 if args.dry_run then
570 display_email_flags emails args.verbose;
571 Lwt.return_unit
572 else
573 (* Create patch object *)
574 let make_patch () =
575 let add_keywords = ref [] in
576 let remove_keywords = ref [] in
577
578 (* Handle add flag *)
579 Option.iter (fun flag ->
580 let keyword = flag_to_keyword flag in
581 add_keywords := keyword :: !add_keywords
582 ) args.add_flag;
583
584 (* Handle remove flag *)
585 Option.iter (fun flag ->
586 let keyword = flag_to_keyword flag in
587 remove_keywords := keyword :: !remove_keywords
588 ) args.remove_flag;
589
590 (* Handle color *)
591 Option.iter (fun color ->
592 (* First remove all color bits *)
593 remove_keywords := Types.Keywords.MailFlagBit0 :: !remove_keywords;
594 remove_keywords := Types.Keywords.MailFlagBit1 :: !remove_keywords;
595 remove_keywords := Types.Keywords.MailFlagBit2 :: !remove_keywords;
596
597 (* Then add the right combination for the requested color *)
598 if color <> `None then begin
599 let color_flags = color_to_flags color in
600 add_keywords := color_flags @ !add_keywords
601 end
602 ) args.color;
603
604 Email.make_patch
605 ~add_keywords:!add_keywords
606 ~remove_keywords:!remove_keywords
607 ()
608 in
609
610 let patch = make_patch () in
611
612 let* result = Email.update ctx
613 ~account_id
614 ~ids
615 ~update_each:(fun _ -> patch) in
616
617 match result with
618 | Error err ->
619 Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);
620 Lwt.return_unit
621 | Ok updated ->
622 Printf.printf "Successfully updated %d emails.\n" (List.length updated);
623 Lwt.return_unit
624 *)
625
626 if list then begin
627 (* Simulate having found a few emails *)
628 let count = 3 in
629 Printf.printf "Found %d matching emails:\n\n" count;
630 Printf.printf "Email 1: Meeting Agenda\n";
631 Printf.printf " ID: email123\n";
632 if verbose then begin
633 Printf.printf " From: alice@example.com\n";
634 Printf.printf " Date: 2023-04-15 09:30:00\n";
635 end;
636 Printf.printf " Flags: $seen, $flagged, $answered\n\n";
637
638 Printf.printf "Email 2: Project Update\n";
639 Printf.printf " ID: email124\n";
640 if verbose then begin
641 Printf.printf " From: bob@example.com\n";
642 Printf.printf " Date: 2023-04-16 14:45:00\n";
643 end;
644 Printf.printf " Color: Red\n";
645 Printf.printf " Flags: $seen, $MailFlagBit0\n\n";
646
647 Printf.printf "Email 3: Weekly Newsletter\n";
648 Printf.printf " ID: email125\n";
649 if verbose then begin
650 Printf.printf " From: newsletter@example.com\n";
651 Printf.printf " Date: 2023-04-17 08:15:00\n";
652 end;
653 Printf.printf " Flags: $seen, $notjunk\n\n";
654 end else if add_flag <> None || remove_flag <> None || color <> None then begin
655 Printf.printf "Would modify %d emails:\n" 2;
656 if dry_run then
657 Printf.printf "(Dry run mode - no changes made)\n\n"
658 else
659 Printf.printf "Changes applied successfully\n\n";
660 end;
661
662 (* List standard flags if no other actions specified *)
663 if not list && add_flag = None && remove_flag = None && color = None then begin
664 Printf.printf "Standard flags:\n";
665 get_standard_flags() |> List.iter (fun (flag, desc) ->
666 Printf.printf " $%-12s %s\n" flag desc
667 );
668
669 Printf.printf "\nColor flags:\n";
670 Printf.printf " $MailFlagBit0 Red\n";
671 Printf.printf " $MailFlagBit1 Orange\n";
672 Printf.printf " $MailFlagBit2 Yellow\n";
673 Printf.printf " $MailFlagBit0+1 Green\n";
674 Printf.printf " $MailFlagBit0+2 Blue\n";
675 Printf.printf " $MailFlagBit1+2 Purple\n";
676 Printf.printf " $MailFlagBit0+1+2 Gray\n";
677 end;
678
679 (* Since we're only type checking, we'll exit with success *)
680 0
681
682(* Command definition *)
683let flag_cmd =
684 let doc = "manage email flags using JMAP" in
685 let man = [
686 `S Manpage.s_description;
687 `P "Lists, adds, and removes flags (keywords) from emails using JMAP.";
688 `P "Demonstrates JMAP's flag/keyword management capabilities.";
689 `S Manpage.s_examples;
690 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";
691 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --add flagged --from boss@example.com";
692 `P " $(mname) -h jmap.example.com -u user@example.com -p secret123 --color red --mailbox Inbox --has-flag seen --missing-flag flagged";
693 ] in
694
695 let cmd =
696 Cmd.v
697 (Cmd.info "jmap-flag-manager" ~version:"1.0" ~doc ~man)
698 Term.(const flag_command $ host_arg $ user_arg $ password_arg $
699 list_arg $ add_flag_arg $ remove_flag_arg $ query_arg $
700 from_arg $ days_arg $ mailbox_arg $ ids_arg $ has_flag_arg $
701 missing_flag_arg $ limit_arg $ dry_run_arg $ color_arg $ verbose_arg)
702 in
703 cmd
704
705(* Main entry point *)
706let () = exit (Cmd.eval' flag_cmd)