This repository has no description
Add improved logging and unread/labels options to fastmail-list
- Add proper OCaml Logs-based logging system with configurable levels
- Redact sensitive API tokens for security in logs
- Add -unread flag to filter and only show unread messages
- Add -labels flag to display message keywords/labels
- Add -debug flag to control verbosity level
- Improve CLI help and usage instructions
🤖 Generated with [Claude Code](https://claude.ai/code)
Co-Authored-By: Claude <noreply@anthropic.com>
author
Anil Madhavapeddy
co-author
Claude
date
(Mar 9, 2025, 12:14 PM UTC)
commit
8136a36b
8136a36b99a4e0a0450d642f3a78cc0cba269e5f
parent
b9db5ff4
b9db5ff4b6df0622e55fd8cb257117b5700949c0
+215
-42
+1
-1
bin/dune
+1
-1
bin/dune
+94
-15
bin/fastmail_list.ml
+94
-15
bin/fastmail_list.ml
···
3
3
*
4
4
* This binary connects to the Fastmail JMAP API using an authentication token
5
5
* from the JMAP_API_TOKEN environment variable and lists the most recent 100
6
-
* emails with their subjects and sender details.
6
+
* emails with their subjects, sender details, and labels.
7
7
*
8
8
* Usage:
9
-
* JMAP_API_TOKEN=your_api_token ./fastmail_list
9
+
* JMAP_API_TOKEN=your_api_token ./fastmail_list [options]
10
+
*
11
+
* Options:
12
+
* -unread List only unread messages
13
+
* -labels Show labels/keywords associated with messages
14
+
* -debug LEVEL Set debug level (0-4, where 4 is most verbose)
10
15
*)
11
16
12
17
open Lwt.Syntax
···
15
20
module Mail = Jmap_mail.Types
16
21
17
22
(** Prints the email details *)
18
-
let print_email (email : Mail.email) =
23
+
let print_email ~show_labels (email : Mail.email) =
19
24
let sender =
20
25
match email.from with
21
26
| Some (addr :: _) ->
···
30
35
| None -> "<no subject>"
31
36
in
32
37
let date = email.received_at in
33
-
Printf.printf "%s | %s | %s\n" date sender subject
38
+
39
+
(* Format labels/keywords if requested *)
40
+
let labels_str =
41
+
if show_labels then
42
+
let active_keywords =
43
+
List.filter_map (fun (keyword, active) ->
44
+
if active then Some (Jmap_mail.Json.string_of_keyword keyword) else None
45
+
) email.keywords
46
+
in
47
+
if List.length active_keywords > 0 then
48
+
" [" ^ String.concat ", " active_keywords ^ "]"
49
+
else
50
+
""
51
+
else
52
+
""
53
+
in
54
+
55
+
Printf.printf "%s | %s | %s%s\n" date sender subject labels_str
56
+
57
+
(** Check if an email is unread *)
58
+
let is_unread (email : Mail.email) =
59
+
let is_unread_keyword =
60
+
List.exists (fun (kw, active) ->
61
+
kw = Mail.Unread && active
62
+
) email.keywords
63
+
in
64
+
let is_not_seen =
65
+
not (List.exists (fun (kw, active) ->
66
+
kw = Mail.Seen && active
67
+
) email.keywords)
68
+
in
69
+
is_unread_keyword || is_not_seen
34
70
35
71
(** Main function *)
36
72
let main () =
73
+
(* Parse command-line arguments *)
74
+
let unread_only = ref false in
75
+
let show_labels = ref false in
76
+
let debug_level = ref 0 in
77
+
78
+
let args = [
79
+
("-unread", Arg.Set unread_only, "List only unread messages");
80
+
("-labels", Arg.Set show_labels, "Show labels/keywords associated with messages");
81
+
("-debug", Arg.Int (fun level -> debug_level := level), "Set debug level (0-4, where 4 is most verbose)");
82
+
] in
83
+
84
+
let usage_msg = "Usage: JMAP_API_TOKEN=your_token fastmail_list [options]" in
85
+
Arg.parse args (fun _ -> ()) usage_msg;
86
+
87
+
(* Configure logging *)
88
+
init_logging ~level:!debug_level ~enable_logs:(!debug_level > 0) ~redact_sensitive:true ();
89
+
37
90
match Sys.getenv_opt "JMAP_API_TOKEN" with
38
91
| None ->
39
92
Printf.eprintf "Error: JMAP_API_TOKEN environment variable not set\n";
40
-
Printf.eprintf "Usage: JMAP_API_TOKEN=your_token ./fastmail_list\n";
93
+
Printf.eprintf "Usage: JMAP_API_TOKEN=your_token ./fastmail_list [options]\n";
94
+
Printf.eprintf "Options:\n";
95
+
Printf.eprintf " -unread List only unread messages\n";
96
+
Printf.eprintf " -labels Show labels/keywords associated with messages\n";
97
+
Printf.eprintf " -debug LEVEL Set debug level (0-4, where 4 is most verbose)\n";
41
98
exit 1
42
99
| Some token ->
43
-
Printf.printf "Using API token: %s\n" token;
100
+
(* Only print token info at Info level or higher *)
101
+
Logs.info (fun m -> m "Using API token: %s" (redact_token token));
102
+
44
103
(* Connect to Fastmail JMAP API *)
45
-
(* Check token format and print helpful messages *)
46
104
let formatted_token = token in
47
-
Printf.printf "\nFastmail API Instructions:\n";
48
-
Printf.printf "1. Get a token from: https://app.fastmail.com/settings/tokens\n";
49
-
Printf.printf "2. Create a new token with Mail scope (read/write)\n";
50
-
Printf.printf "3. Copy the full token (example: 3de40-5fg1h2-a1b2c3...)\n";
51
-
Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" opam exec -- dune exec bin/fastmail_list.exe\n\n";
52
-
Printf.printf "Note: This example is working correctly but needs a valid Fastmail token.\n\n";
105
+
106
+
(* Only print instructions at Info level *)
107
+
let level = match Logs.level () with
108
+
| None -> 0
109
+
| Some Logs.Error -> 1
110
+
| Some Logs.Info -> 2
111
+
| Some Logs.Debug -> 3
112
+
| _ -> 2
113
+
in
114
+
if level >= 2 then begin
115
+
Printf.printf "\nFastmail API Instructions:\n";
116
+
Printf.printf "1. Get a token from: https://app.fastmail.com/settings/tokens\n";
117
+
Printf.printf "2. Create a new token with Mail scope (read/write)\n";
118
+
Printf.printf "3. Copy the full token (example: 3de40-5fg1h2-a1b2c3...)\n";
119
+
Printf.printf "4. Run: env JMAP_API_TOKEN=\"your_full_token\" opam exec -- dune exec bin/fastmail_list.exe [options]\n\n";
120
+
Printf.printf "Note: This example is working correctly but needs a valid Fastmail token.\n\n";
121
+
end;
53
122
let* result = login_with_token
54
123
~uri:"https://api.fastmail.com/jmap/session"
55
124
~api_token:formatted_token
···
119
188
| Api.Authentication_error -> "Authentication error");
120
189
Lwt.return 1
121
190
| Ok emails ->
122
-
Printf.printf "Listing the most recent %d emails in your inbox:\n" (List.length emails);
191
+
(* Filter emails if unread-only mode is enabled *)
192
+
let filtered_emails =
193
+
if !unread_only then
194
+
List.filter is_unread emails
195
+
else
196
+
emails
197
+
in
198
+
199
+
Printf.printf "Listing %s %d emails in your inbox:\n"
200
+
(if !unread_only then "unread" else "the most recent")
201
+
(List.length filtered_emails);
123
202
Printf.printf "--------------------------------------------\n";
124
-
List.iter print_email emails;
203
+
List.iter (print_email ~show_labels:!show_labels) filtered_emails;
125
204
Lwt.return 0
126
205
127
206
(** Program entry point *)
+1
-1
lib/dune
+1
-1
lib/dune
+113
-25
lib/jmap.ml
+113
-25
lib/jmap.ml
···
3
3
* https://datatracker.ietf.org/doc/html/rfc8620
4
4
*)
5
5
6
+
(** Whether to redact sensitive information *)
7
+
let should_redact_sensitive = ref true
8
+
9
+
(** Initialize and configure logging for JMAP *)
10
+
let init_logging ?(level=2) ?(enable_logs=true) ?(redact_sensitive=true) () =
11
+
if enable_logs then begin
12
+
Logs.set_reporter (Logs.format_reporter ());
13
+
match level with
14
+
| 0 -> Logs.set_level None
15
+
| 1 -> Logs.set_level (Some Logs.Error)
16
+
| 2 -> Logs.set_level (Some Logs.Info)
17
+
| 3 -> Logs.set_level (Some Logs.Debug)
18
+
| _ -> Logs.set_level (Some Logs.Debug)
19
+
end else
20
+
Logs.set_level None;
21
+
should_redact_sensitive := redact_sensitive
22
+
23
+
(** Redact sensitive data like tokens *)
24
+
let redact_token ?(redact=true) token =
25
+
if redact && !should_redact_sensitive && String.length token > 8 then
26
+
let prefix = String.sub token 0 4 in
27
+
let suffix = String.sub token (String.length token - 4) 4 in
28
+
prefix ^ "..." ^ suffix
29
+
else
30
+
token
31
+
32
+
(** Redact sensitive headers like Authorization *)
33
+
let redact_headers headers =
34
+
List.map (fun (k, v) ->
35
+
if String.lowercase_ascii k = "authorization" then
36
+
if !should_redact_sensitive then
37
+
let parts = String.split_on_char ' ' v in
38
+
match parts with
39
+
| scheme :: token :: _ -> (k, scheme ^ " " ^ redact_token token)
40
+
| _ -> (k, v)
41
+
else (k, v)
42
+
else (k, v)
43
+
) headers
44
+
45
+
(* Initialize logging with defaults *)
46
+
let () = init_logging ()
47
+
6
48
(** Module for managing JMAP capability URIs and other constants *)
7
49
module Capability = struct
8
50
(** Core JMAP capability URI *)
···
448
490
let open Cohttp_lwt_unix in
449
491
let headers = Header.add_list (Header.init ()) headers in
450
492
451
-
(* Debug: print request details *)
452
-
Printf.printf "\n===== HTTP REQUEST =====\n";
453
-
Printf.printf "URI: %s\n" (Uri.to_string uri);
454
-
Printf.printf "METHOD: %s\n" method_;
455
-
Printf.printf "HEADERS:\n";
456
-
Header.iter (fun k v -> Printf.printf " %s: %s\n" k v) headers;
457
-
Printf.printf "BODY:\n%s\n" body;
458
-
Printf.printf "======================\n\n";
493
+
(* Log request details at debug level *)
494
+
let header_list = Cohttp.Header.to_list headers in
495
+
let redacted_headers = redact_headers header_list in
496
+
Logs.debug (fun m ->
497
+
m "\n===== HTTP REQUEST =====\n\
498
+
URI: %s\n\
499
+
METHOD: %s\n\
500
+
HEADERS:\n%s\n\
501
+
BODY:\n%s\n\
502
+
======================\n"
503
+
(Uri.to_string uri)
504
+
method_
505
+
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
506
+
body);
459
507
460
508
Lwt.catch
461
509
(fun () ->
···
468
516
let* body_str = Cohttp_lwt.Body.to_string body in
469
517
let status = Response.status resp |> Code.code_of_status in
470
518
471
-
(* Debug: print response details *)
472
-
Printf.printf "\n===== HTTP RESPONSE =====\n";
473
-
Printf.printf "STATUS: %d\n" status;
474
-
Printf.printf "HEADERS:\n";
475
-
Response.headers resp |> Header.iter (fun k v -> Printf.printf " %s: %s\n" k v);
476
-
Printf.printf "BODY:\n%s\n" body_str;
477
-
Printf.printf "========================\n\n";
519
+
(* Log response details at debug level *)
520
+
let header_list = Cohttp.Header.to_list (Response.headers resp) in
521
+
let redacted_headers = redact_headers header_list in
522
+
Logs.debug (fun m ->
523
+
m "\n===== HTTP RESPONSE =====\n\
524
+
STATUS: %d\n\
525
+
HEADERS:\n%s\n\
526
+
BODY:\n%s\n\
527
+
======================\n"
528
+
status
529
+
(String.concat "\n" (List.map (fun (k, v) -> Printf.sprintf " %s: %s" k v) redacted_headers))
530
+
body_str);
478
531
479
532
if status >= 200 && status < 300 then
480
533
Lwt.return (Ok body_str)
···
482
535
Lwt.return (Error (HTTP_error (status, body_str))))
483
536
(fun e ->
484
537
let error_msg = Printexc.to_string e in
485
-
Printf.printf "\n===== HTTP ERROR =====\n%s\n======================\n\n" error_msg;
538
+
Logs.err (fun m -> m "%s" error_msg);
486
539
Lwt.return (Error (Connection_error error_msg)))
487
540
488
541
(** Make a raw JMAP API request
···
499
552
(* API token (bearer authentication) *)
500
553
"Bearer " ^ config.authentication_token
501
554
in
502
-
Printf.printf "Using authorization header: %s\n" auth_header;
555
+
556
+
(* Log auth header at debug level with redaction *)
557
+
let redacted_header =
558
+
if String.length config.username > 0 then
559
+
"Basic " ^ redact_token (Base64.encode_string (config.username ^ ":" ^ config.authentication_token))
560
+
else
561
+
"Bearer " ^ redact_token config.authentication_token
562
+
in
563
+
Logs.debug (fun m -> m "Using authorization header: %s" redacted_header);
564
+
503
565
let headers = [
504
566
("Content-Type", "application/json");
505
567
("Content-Length", string_of_int (String.length body));
···
509
571
match result with
510
572
| Ok response_body ->
511
573
(match parse_json_string response_body with
512
-
| Ok json -> Lwt.return (parse_response json)
513
-
| Error e -> Lwt.return (Error e))
514
-
| Error e -> Lwt.return (Error e)
574
+
| Ok json ->
575
+
Logs.debug (fun m -> m "Successfully parsed JSON response");
576
+
Lwt.return (parse_response json)
577
+
| Error e ->
578
+
let msg = match e with Parse_error m -> m | _ -> "unknown error" in
579
+
Logs.err (fun m -> m "Failed to parse response: %s" msg);
580
+
Lwt.return (Error e))
581
+
| Error e ->
582
+
(match e with
583
+
| Connection_error msg -> Logs.err (fun m -> m "Connection error: %s" msg)
584
+
| HTTP_error (code, _) -> Logs.err (fun m -> m "HTTP error %d" code)
585
+
| Parse_error msg -> Logs.err (fun m -> m "Parse error: %s" msg)
586
+
| Authentication_error -> Logs.err (fun m -> m "Authentication error"));
587
+
Lwt.return (Error e)
515
588
516
589
(** Parse a JSON object as a Session object *)
517
590
let parse_session_object json =
···
577
650
match (username, authentication_token, api_token) with
578
651
| (Some u, Some t, _) ->
579
652
let auth = "Basic " ^ Base64.encode_string (u ^ ":" ^ t) in
580
-
Printf.printf "Session using Basic auth: %s\n" auth;
653
+
let redacted_auth = "Basic " ^ redact_token (Base64.encode_string (u ^ ":" ^ t)) in
654
+
Logs.info (fun m -> m "Session using Basic auth: %s" redacted_auth);
581
655
[
582
656
("Content-Type", "application/json");
583
657
("Authorization", auth)
584
658
]
585
659
| (_, _, Some token) ->
586
660
let auth = "Bearer " ^ token in
587
-
Printf.printf "Session using Bearer auth: %s\n" auth;
661
+
let redacted_token = redact_token token in
662
+
Logs.info (fun m -> m "Session using Bearer auth: %s" ("Bearer " ^ redacted_token));
588
663
[
589
664
("Content-Type", "application/json");
590
665
("Authorization", auth)
···
596
671
match result with
597
672
| Ok response_body ->
598
673
(match parse_json_string response_body with
599
-
| Ok json -> Lwt.return (parse_session_object json)
600
-
| Error e -> Lwt.return (Error e))
601
-
| Error e -> Lwt.return (Error e)
674
+
| Ok json ->
675
+
Logs.debug (fun m -> m "Successfully parsed session response");
676
+
Lwt.return (parse_session_object json)
677
+
| Error e ->
678
+
let msg = match e with Parse_error m -> m | _ -> "unknown error" in
679
+
Logs.err (fun m -> m "Failed to parse session response: %s" msg);
680
+
Lwt.return (Error e))
681
+
| Error e ->
682
+
let err_msg = match e with
683
+
| Connection_error msg -> "Connection error: " ^ msg
684
+
| HTTP_error (code, _) -> Printf.sprintf "HTTP error %d" code
685
+
| Parse_error msg -> "Parse error: " ^ msg
686
+
| Authentication_error -> "Authentication error"
687
+
in
688
+
Logs.err (fun m -> m "Failed to get session: %s" err_msg);
689
+
Lwt.return (Error e)
602
690
603
691
(** Upload a binary blob to the server
604
692
+6
lib/jmap.mli
+6
lib/jmap.mli
···
3
3
* https://datatracker.ietf.org/doc/html/rfc8620
4
4
*)
5
5
6
+
(** Initialize and configure logging for JMAP *)
7
+
val init_logging : ?level:int -> ?enable_logs:bool -> ?redact_sensitive:bool -> unit -> unit
8
+
9
+
(** Redact sensitive data like tokens *)
10
+
val redact_token : ?redact:bool -> string -> string
11
+
6
12
(** Module for managing JMAP capability URIs and other constants *)
7
13
module Capability : sig
8
14
(** Core JMAP capability URI *)