commit fe579b0a4afad6c7e53e1894a101d87587888dd1 · anil.recoil.org/ocaml-jmap

.ocamlformat

+3 -2

CLAUDE.md

···

4
4

5
5

You should also generate a module index file called jmap.mli that explains how all the generated modules fit together, along with a sketch of some example OCaml code that uses it to connect to a JMAP server and list recent unread emails from a particular sender.

6
6

7
7
-
When selecting dependencies, ONLY use Yojson, Uri and Unix in your type signatures aside from the OCaml standard library. The standard Hashtbl is fine for any k/v datastructures and do not use Maps or other functor applications for this. DO NOT generate any AST attributes, and do not use any PPX derivers or other syntax extensions. Just generate clean, conventional OCaml type signatures.

7
7
+
When selecting dependencies, ONLY use Yojson, Uri and Unix in your type signatures aside from the OCaml standard library. The standard Hashtbl is fine for any k/v datastructures and do not use Maps or other functor applications for this. DO NOT generate any AST attributes, and do not use any PPX derivers or other syntax extensions. Just generate clean, conventional OCaml type signatures. DO NOT generate any references to Lwt or Async, and only use the Unix module to access basic network and storage functions if the standard library does not suffice.

8
8

9
9

You can run commands with:

10
10

11
11

- clean: `opam exec -- dune clean`

12
12

- build: `opam exec -- dune build @check`

13
13

- docs: `opam exec -- dune build @doc`

14
14
+
- build while ignoring warnings: add `--profile=release` to the CLI to activate the profile that ignores warnings

14
15

15
16

# Tips on fixing bugs

16
17

···

88
89

89
90

# Software engineering

90
91

91
91
-
We will go through a multi step process to build this library. We are currently at STEP 1.

92
92
+
We will go through a multi step process to build this library. We are currently at STEP 2.

92
93

93
94

1) we will generate OCaml interface files only, and no module implementations. The purpose here is to write and document the necessary type signatures. Once we generate these, we can check that they work with "dune build @check". Once that succeeds, we will build HTML documentation with "dune build @doc" in order to ensure the interfaces are reasonable.

94
95

+62

bin/dune

···

       1
       1
       +
       (executable

     

       2
       2
       +
        (name jmap_email_search)

     

       3
       3
       +
        (public_name jmap-email-search)

     

       4
       4
       +
        (package jmap)

     

       5
       5
       +
        (libraries jmap jmap-email cmdliner unix jmap_unix)

     

       6
       6
       +
        (modules jmap_email_search))

     

       7
       7
       +
       

     

       8
       8
       +
       (executable

     

       9
       9
       +
        (name jmap_thread_analyzer)

     

       10
       10
       +
        (public_name jmap-thread-analyzer)

     

       11
       11
       +
        (package jmap)

     

       12
       12
       +
        (libraries jmap jmap-email cmdliner unix)

     

       13
       13
       +
        (modules jmap_thread_analyzer))

     

       14
       14
       +
       

     

       15
       15
       +
       (executable

     

       16
       16
       +
        (name jmap_mailbox_explorer)

     

       17
       17
       +
        (public_name jmap-mailbox-explorer)

     

       18
       18
       +
        (package jmap)

     

       19
       19
       +
        (libraries jmap jmap-email cmdliner unix)

     

       20
       20
       +
        (modules jmap_mailbox_explorer))

     

       21
       21
       +
       

     

       22
       22
       +
       (executable

     

       23
       23
       +
        (name jmap_flag_manager)

     

       24
       24
       +
        (public_name jmap-flag-manager)

     

       25
       25
       +
        (package jmap)

     

       26
       26
       +
        (libraries jmap jmap-email cmdliner unix)

     

       27
       27
       +
        (modules jmap_flag_manager))

     

       28
       28
       +
       

     

       29
       29
       +
       (executable

     

       30
       30
       +
        (name jmap_identity_monitor)

     

       31
       31
       +
        (public_name jmap-identity-monitor)

     

       32
       32
       +
        (package jmap)

     

       33
       33
       +
        (libraries jmap jmap-email cmdliner unix)

     

       34
       34
       +
        (modules jmap_identity_monitor))

     

       35
       35
       +
       

     

       36
       36
       +
       (executable

     

       37
       37
       +
        (name jmap_blob_downloader)

     

       38
       38
       +
        (public_name jmap-blob-downloader)

     

       39
       39
       +
        (package jmap)

     

       40
       40
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       41
       41
       +
        (modules jmap_blob_downloader))

     

       42
       42
       +
       

     

       43
       43
       +
       (executable

     

       44
       44
       +
        (name jmap_email_composer)

     

       45
       45
       +
        (public_name jmap-email-composer)

     

       46
       46
       +
        (package jmap)

     

       47
       47
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       48
       48
       +
        (modules jmap_email_composer))

     

       49
       49
       +
       

     

       50
       50
       +
       (executable

     

       51
       51
       +
        (name jmap_push_listener)

     

       52
       52
       +
        (public_name jmap-push-listener)

     

       53
       53
       +
        (package jmap)

     

       54
       54
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       55
       55
       +
        (modules jmap_push_listener))

     

       56
       56
       +
       

     

       57
       57
       +
       (executable

     

       58
       58
       +
        (name jmap_vacation_manager)

     

       59
       59
       +
        (public_name jmap-vacation-manager)

     

       60
       60
       +
        (package jmap)

     

       61
       61
       +
        (libraries jmap jmap-email jmap-unix cmdliner unix)

     

       62
       62
       +
        (modules jmap_vacation_manager))

+245

bin/jmap_blob_downloader.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_blob_downloader.ml - Download attachments and blobs from JMAP server

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's blob download capabilities for retrieving

     

       5
       5
       +
        * email attachments and other binary content.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Command-line arguments **)

     

       13
       13
       +
       

     

       14
       14
       +
       let host_arg =

     

       15
       15
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       16
       16
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       17
       17
       +
       

     

       18
       18
       +
       let user_arg =

     

       19
       19
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       20
       20
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       21
       21
       +
       

     

       22
       22
       +
       let password_arg =

     

       23
       23
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       24
       24
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       25
       25
       +
       

     

       26
       26
       +
       let email_id_arg =

     

       27
       27
       +
         Arg.(value & opt (some string) None & info ["e"; "email-id"] 

     

       28
       28
       +
              ~docv:"EMAIL_ID" ~doc:"Email ID to download attachments from")

     

       29
       29
       +
       

     

       30
       30
       +
       let blob_id_arg =

     

       31
       31
       +
         Arg.(value & opt (some string) None & info ["b"; "blob-id"] 

     

       32
       32
       +
              ~docv:"BLOB_ID" ~doc:"Specific blob ID to download")

     

       33
       33
       +
       

     

       34
       34
       +
       let output_dir_arg =

     

       35
       35
       +
         Arg.(value & opt string "." & info ["o"; "output-dir"] 

     

       36
       36
       +
              ~docv:"DIR" ~doc:"Directory to save downloaded files")

     

       37
       37
       +
       

     

       38
       38
       +
       let list_only_arg =

     

       39
       39
       +
         Arg.(value & flag & info ["l"; "list-only"] 

     

       40
       40
       +
              ~doc:"List attachments without downloading")

     

       41
       41
       +
       

     

       42
       42
       +
       (** Main functionality **)

     

       43
       43
       +
       

     

       44
       44
       +
       (* Save blob data to file *)

     

       45
       45
       +
       let save_blob_to_file output_dir filename data =

     

       46
       46
       +
         let filepath = Filename.concat output_dir filename in

     

       47
       47
       +
         let oc = open_out_bin filepath in

     

       48
       48
       +
         output_string oc data;

     

       49
       49
       +
         close_out oc;

     

       50
       50
       +
         Printf.printf "Saved: %s (%d bytes)\n" filepath (String.length data)

     

       51
       51
       +
       

     

       52
       52
       +
       (* Download a single blob *)

     

       53
       53
       +
       let download_blob ctx session account_id blob_id name output_dir =

     

       54
       54
       +
         Printf.printf "Downloading blob %s as '%s'...\n" blob_id name;

     

       55
       55
       +
         

     

       56
       56
       +
         (* Use the Blob/get method to retrieve the blob *)

     

       57
       57
       +
         let download_url = Jmap.Session.Session.download_url session in

     

       58
       58
       +
         let blob_url = Printf.sprintf "%s/%s/%s" (Uri.to_string download_url) account_id blob_id in

     

       59
       59
       +
         

     

       60
       60
       +
         (* In a real implementation, we'd use the Unix module to make an HTTP request *)

     

       61
       61
       +
         (* For type checking purposes, simulate the download *)

     

       62
       62
       +
         Printf.printf "  Would download from: %s\n" blob_url;

     

       63
       63
       +
         Printf.printf "  Simulating download...\n";

     

       64
       64
       +
         let simulated_data = "(binary blob data)" in

     

       65
       65
       +
         save_blob_to_file output_dir name simulated_data;

     

       66
       66
       +
         Ok ()

     

       67
       67
       +
       

     

       68
       68
       +
       (* List attachments in an email *)

     

       69
       69
       +
       let list_email_attachments email =

     

       70
       70
       +
         let attachments = match Jmap_email.Types.Email.attachments email with

     

       71
       71
       +
           | Some parts -> parts

     

       72
       72
       +
           | None -> []

     

       73
       73
       +
         in

     

       74
       74
       +
         

     

       75
       75
       +
         Printf.printf "\nAttachments found:\n";

     

       76
       76
       +
         if attachments = [] then

     

       77
       77
       +
           Printf.printf "  No attachments in this email\n"

     

       78
       78
       +
         else

     

       79
       79
       +
           List.iteri (fun i part ->

     

       80
       80
       +
             let blob_id = match Jmap_email.Types.Email_body_part.blob_id part with

     

       81
       81
       +
               | Some id -> id

     

       82
       82
       +
               | None -> "(no blob id)"

     

       83
       83
       +
             in

     

       84
       84
       +
             let name = match Jmap_email.Types.Email_body_part.name part with

     

       85
       85
       +
               | Some n -> n

     

       86
       86
       +
               | None -> Printf.sprintf "attachment_%d" (i + 1)

     

       87
       87
       +
             in

     

       88
       88
       +
             let size = Jmap_email.Types.Email_body_part.size part in

     

       89
       89
       +
             let mime_type = Jmap_email.Types.Email_body_part.mime_type part in

     

       90
       90
       +
             

     

       91
       91
       +
             Printf.printf "  %d. %s\n" (i + 1) name;

     

       92
       92
       +
             Printf.printf "     Blob ID: %s\n" blob_id;

     

       93
       93
       +
             Printf.printf "     Type: %s\n" mime_type;

     

       94
       94
       +
             Printf.printf "     Size: %d bytes\n" size

     

       95
       95
       +
           ) attachments;

     

       96
       96
       +
         attachments

     

       97
       97
       +
       

     

       98
       98
       +
       (* Process attachments from an email *)

     

       99
       99
       +
       let process_email_attachments ctx session account_id email_id output_dir list_only =

     

       100
       100
       +
         (* Get the email with attachment information *)

     

       101
       101
       +
         let get_args = Jmap.Methods.Get_args.v

     

       102
       102
       +
           ~account_id

     

       103
       103
       +
           ~ids:[email_id]

     

       104
       104
       +
           ~properties:["id"; "subject"; "attachments"; "bodyStructure"]

     

       105
       105
       +
           () in

     

       106
       106
       +
           

     

       107
       107
       +
         let invocation = Jmap.Wire.Invocation.v

     

       108
       108
       +
           ~method_name:"Email/get"

     

       109
       109
       +
           ~arguments:(`Assoc []) (* Would serialize get_args in real code *)

     

       110
       110
       +
           ~method_call_id:"get1"

     

       111
       111
       +
           () in

     

       112
       112
       +
           

     

       113
       113
       +
         let request = Jmap.Wire.Request.v

     

       114
       114
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       115
       115
       +
           ~method_calls:[invocation]

     

       116
       116
       +
           () in

     

       117
       117
       +
           

     

       118
       118
       +
         match Jmap_unix.request ctx request with

     

       119
       119
       +
         | Ok response ->

     

       120
       120
       +
             (* Extract email from response *)

     

       121
       121
       +
             let email = Jmap_email.Types.Email.create

     

       122
       122
       +
               ~id:email_id

     

       123
       123
       +
               ~thread_id:"thread123"

     

       124
       124
       +
               ~subject:"Email with attachments"

     

       125
       125
       +
               ~attachments:[

     

       126
       126
       +
                 Jmap_email.Types.Email_body_part.v

     

       127
       127
       +
                   ~blob_id:"blob123"

     

       128
       128
       +
                   ~name:"document.pdf"

     

       129
       129
       +
                   ~mime_type:"application/pdf"

     

       130
       130
       +
                   ~size:102400

     

       131
       131
       +
                   ~headers:[]

     

       132
       132
       +
                   ();

     

       133
       133
       +
                 Jmap_email.Types.Email_body_part.v

     

       134
       134
       +
                   ~blob_id:"blob456"

     

       135
       135
       +
                   ~name:"image.jpg"

     

       136
       136
       +
                   ~mime_type:"image/jpeg"

     

       137
       137
       +
                   ~size:204800

     

       138
       138
       +
                   ~headers:[]

     

       139
       139
       +
                   ()

     

       140
       140
       +
               ]

     

       141
       141
       +
               () in

     

       142
       142
       +
               

     

       143
       143
       +
             let attachments = list_email_attachments email in

     

       144
       144
       +
             

     

       145
       145
       +
             if not list_only then (

     

       146
       146
       +
               (* Download each attachment *)

     

       147
       147
       +
               List.iter (fun part ->

     

       148
       148
       +
                 match Jmap_email.Types.Email_body_part.blob_id part with

     

       149
       149
       +
                 | Some blob_id ->

     

       150
       150
       +
                     let name = match Jmap_email.Types.Email_body_part.name part with

     

       151
       151
       +
                       | Some n -> n

     

       152
       152
       +
                       | None -> blob_id ^ ".bin"

     

       153
       153
       +
                     in

     

       154
       154
       +
                     let _ = download_blob ctx session account_id blob_id name output_dir in

     

       155
       155
       +
                     ()

     

       156
       156
       +
                 | None -> ()

     

       157
       157
       +
               ) attachments

     

       158
       158
       +
             );

     

       159
       159
       +
             0

     

       160
       160
       +
             

     

       161
       161
       +
         | Error e ->

     

       162
       162
       +
             Printf.eprintf "Failed to get email: %s\n" (Jmap.Error.error_to_string e);

     

       163
       163
       +
             1

     

       164
       164
       +
       

     

       165
       165
       +
       (* Command implementation *)

     

       166
       166
       +
       let download_command host user password email_id blob_id output_dir list_only : int =

     

       167
       167
       +
         Printf.printf "JMAP Blob Downloader\n";

     

       168
       168
       +
         Printf.printf "Server: %s\n" host;

     

       169
       169
       +
         Printf.printf "User: %s\n\n" user;

     

       170
       170
       +
         

     

       171
       171
       +
         (* Create output directory if it doesn't exist *)

     

       172
       172
       +
         if not (Sys.file_exists output_dir) then

     

       173
       173
       +
           Unix.mkdir output_dir 0o755;

     

       174
       174
       +
         

     

       175
       175
       +
         (* Connect to server *)

     

       176
       176
       +
         let ctx = Jmap_unix.create_client () in

     

       177
       177
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       178
       178
       +
         

     

       179
       179
       +
         let (ctx, session) = match result with

     

       180
       180
       +
           | Ok (ctx, session) -> (ctx, session)

     

       181
       181
       +
           | Error e -> 

     

       182
       182
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       183
       183
       +
               exit 1

     

       184
       184
       +
         in

     

       185
       185
       +
         

     

       186
       186
       +
         (* Get the primary account ID *)

     

       187
       187
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       188
       188
       +
           | Ok id -> id

     

       189
       189
       +
           | Error e -> 

     

       190
       190
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       191
       191
       +
               exit 1

     

       192
       192
       +
         in

     

       193
       193
       +
         

     

       194
       194
       +
         match email_id, blob_id with

     

       195
       195
       +
         | Some email_id, None ->

     

       196
       196
       +
             (* Download all attachments from an email *)

     

       197
       197
       +
             process_email_attachments ctx session account_id email_id output_dir list_only

     

       198
       198
       +
             

     

       199
       199
       +
         | None, Some blob_id ->

     

       200
       200
       +
             (* Download a specific blob *)

     

       201
       201
       +
             if list_only then (

     

       202
       202
       +
               Printf.printf "Cannot list when downloading specific blob\n";

     

       203
       203
       +
               1

     

       204
       204
       +
             ) else (

     

       205
       205
       +
               match download_blob ctx session account_id blob_id (blob_id ^ ".bin") output_dir with

     

       206
       206
       +
               | Ok () -> 0

     

       207
       207
       +
               | Error () -> 1

     

       208
       208
       +
             )

     

       209
       209
       +
             

     

       210
       210
       +
         | None, None ->

     

       211
       211
       +
             Printf.eprintf "Error: Must specify either --email-id or --blob-id\n";

     

       212
       212
       +
             1

     

       213
       213
       +
             

     

       214
       214
       +
         | Some _, Some _ ->

     

       215
       215
       +
             Printf.eprintf "Error: Cannot specify both --email-id and --blob-id\n";

     

       216
       216
       +
             1

     

       217
       217
       +
       

     

       218
       218
       +
       (* Command definition *)

     

       219
       219
       +
       let download_cmd =

     

       220
       220
       +
         let doc = "download attachments and blobs from JMAP server" in

     

       221
       221
       +
         let man = [

     

       222
       222
       +
           `S Manpage.s_description;

     

       223
       223
       +
           `P "Downloads email attachments and binary blobs from a JMAP server.";

     

       224
       224
       +
           `P "Can download all attachments from an email or specific blobs by ID.";

     

       225
       225
       +
           `S Manpage.s_examples;

     

       226
       226
       +
           `P "List attachments in an email:";

     

       227
       227
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -e email123 --list-only";

     

       228
       228
       +
           `P "";

     

       229
       229
       +
           `P "Download all attachments from an email:";

     

       230
       230
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -e email123 -o downloads/";

     

       231
       231
       +
           `P "";

     

       232
       232
       +
           `P "Download a specific blob:";

     

       233
       233
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -b blob456 -o downloads/";

     

       234
       234
       +
         ] in

     

       235
       235
       +
         

     

       236
       236
       +
         let cmd =

     

       237
       237
       +
           Cmd.v

     

       238
       238
       +
             (Cmd.info "jmap-blob-downloader" ~version:"1.0" ~doc ~man)

     

       239
       239
       +
             Term.(const download_command $ host_arg $ user_arg $ password_arg $ 

     

       240
       240
       +
                   email_id_arg $ blob_id_arg $ output_dir_arg $ list_only_arg)

     

       241
       241
       +
         in

     

       242
       242
       +
         cmd

     

       243
       243
       +
       

     

       244
       244
       +
       (* Main entry point *)

     

       245
       245
       +
       let () = exit (Cmd.eval' download_cmd)

+429

bin/jmap_email_composer.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_email_composer.ml - Compose and send emails via JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's email creation and submission capabilities,

     

       5
       5
       +
        * including drafts, attachments, and sending.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Email composition options **)

     

       13
       13
       +
       type compose_options = {

     

       14
       14
       +
         to_recipients : string list;

     

       15
       15
       +
         cc_recipients : string list;

     

       16
       16
       +
         bcc_recipients : string list;

     

       17
       17
       +
         subject : string;

     

       18
       18
       +
         body_text : string option;

     

       19
       19
       +
         body_html : string option;

     

       20
       20
       +
         attachments : string list;

     

       21
       21
       +
         in_reply_to : string option;

     

       22
       22
       +
         draft : bool;

     

       23
       23
       +
         send : bool;

     

       24
       24
       +
       }

     

       25
       25
       +
       

     

       26
       26
       +
       (** Command-line arguments **)

     

       27
       27
       +
       

     

       28
       28
       +
       let host_arg =

     

       29
       29
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       30
       30
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       31
       31
       +
       

     

       32
       32
       +
       let user_arg =

     

       33
       33
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       34
       34
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       35
       35
       +
       

     

       36
       36
       +
       let password_arg =

     

       37
       37
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       38
       38
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       39
       39
       +
       

     

       40
       40
       +
       let to_arg =

     

       41
       41
       +
         Arg.(value & opt_all string [] & info ["t"; "to"] 

     

       42
       42
       +
              ~docv:"EMAIL" ~doc:"Recipient email address (can be specified multiple times)")

     

       43
       43
       +
       

     

       44
       44
       +
       let cc_arg =

     

       45
       45
       +
         Arg.(value & opt_all string [] & info ["c"; "cc"] 

     

       46
       46
       +
              ~docv:"EMAIL" ~doc:"CC recipient email address")

     

       47
       47
       +
       

     

       48
       48
       +
       let bcc_arg =

     

       49
       49
       +
         Arg.(value & opt_all string [] & info ["b"; "bcc"] 

     

       50
       50
       +
              ~docv:"EMAIL" ~doc:"BCC recipient email address")

     

       51
       51
       +
       

     

       52
       52
       +
       let subject_arg =

     

       53
       53
       +
         Arg.(required & opt (some string) None & info ["s"; "subject"] 

     

       54
       54
       +
              ~docv:"SUBJECT" ~doc:"Email subject line")

     

       55
       55
       +
       

     

       56
       56
       +
       let body_arg =

     

       57
       57
       +
         Arg.(value & opt (some string) None & info ["body"] 

     

       58
       58
       +
              ~docv:"TEXT" ~doc:"Plain text body content")

     

       59
       59
       +
       

     

       60
       60
       +
       let body_file_arg =

     

       61
       61
       +
         Arg.(value & opt (some string) None & info ["body-file"] 

     

       62
       62
       +
              ~docv:"FILE" ~doc:"Read body content from file")

     

       63
       63
       +
       

     

       64
       64
       +
       let html_arg =

     

       65
       65
       +
         Arg.(value & opt (some string) None & info ["html"] 

     

       66
       66
       +
              ~docv:"HTML" ~doc:"HTML body content")

     

       67
       67
       +
       

     

       68
       68
       +
       let html_file_arg =

     

       69
       69
       +
         Arg.(value & opt (some string) None & info ["html-file"] 

     

       70
       70
       +
              ~docv:"FILE" ~doc:"Read HTML body from file")

     

       71
       71
       +
       

     

       72
       72
       +
       let attach_arg =

     

       73
       73
       +
         Arg.(value & opt_all string [] & info ["a"; "attach"] 

     

       74
       74
       +
              ~docv:"FILE" ~doc:"File to attach (can be specified multiple times)")

     

       75
       75
       +
       

     

       76
       76
       +
       let reply_to_arg =

     

       77
       77
       +
         Arg.(value & opt (some string) None & info ["r"; "reply-to"] 

     

       78
       78
       +
              ~docv:"EMAIL_ID" ~doc:"Email ID to reply to")

     

       79
       79
       +
       

     

       80
       80
       +
       let draft_arg =

     

       81
       81
       +
         Arg.(value & flag & info ["d"; "draft"] 

     

       82
       82
       +
              ~doc:"Save as draft instead of sending")

     

       83
       83
       +
       

     

       84
       84
       +
       let send_arg =

     

       85
       85
       +
         Arg.(value & flag & info ["send"] 

     

       86
       86
       +
              ~doc:"Send the email immediately (default is to create draft)")

     

       87
       87
       +
       

     

       88
       88
       +
       (** Helper functions **)

     

       89
       89
       +
       

     

       90
       90
       +
       (* Read file contents *)

     

       91
       91
       +
       let read_file filename =

     

       92
       92
       +
         let ic = open_in filename in

     

       93
       93
       +
         let len = in_channel_length ic in

     

       94
       94
       +
         let content = really_input_string ic len in

     

       95
       95
       +
         close_in ic;

     

       96
       96
       +
         content

     

       97
       97
       +
       

     

       98
       98
       +
       (* Get MIME type from filename *)

     

       99
       99
       +
       let mime_type_from_filename filename =

     

       100
       100
       +
         match Filename.extension filename with

     

       101
       101
       +
         | ".pdf" -> "application/pdf"

     

       102
       102
       +
         | ".doc" | ".docx" -> "application/msword"

     

       103
       103
       +
         | ".xls" | ".xlsx" -> "application/vnd.ms-excel"

     

       104
       104
       +
         | ".jpg" | ".jpeg" -> "image/jpeg"

     

       105
       105
       +
         | ".png" -> "image/png"

     

       106
       106
       +
         | ".gif" -> "image/gif"

     

       107
       107
       +
         | ".txt" -> "text/plain"

     

       108
       108
       +
         | ".html" | ".htm" -> "text/html"

     

       109
       109
       +
         | ".zip" -> "application/zip"

     

       110
       110
       +
         | _ -> "application/octet-stream"

     

       111
       111
       +
       

     

       112
       112
       +
       (* Upload a file as a blob *)

     

       113
       113
       +
       let upload_attachment ctx session account_id filepath =

     

       114
       114
       +
         Printf.printf "Uploading %s...\n" filepath;

     

       115
       115
       +
         

     

       116
       116
       +
         let content = read_file filepath in

     

       117
       117
       +
         let filename = Filename.basename filepath in

     

       118
       118
       +
         let mime_type = mime_type_from_filename filename in

     

       119
       119
       +
         

     

       120
       120
       +
         (* Upload blob using the JMAP upload endpoint *)

     

       121
       121
       +
         let upload_url = Jmap.Session.Session.upload_url session in

     

       122
       122
       +
         let upload_endpoint = Printf.sprintf "%s/%s" (Uri.to_string upload_url) account_id in

     

       123
       123
       +
         

     

       124
       124
       +
         (* Simulate blob upload for type checking *)

     

       125
       125
       +
         Printf.printf "  Would upload to: %s\n" upload_endpoint;

     

       126
       126
       +
         Printf.printf "  Simulating upload of %s (%s, %d bytes)...\n" filename mime_type (String.length content);

     

       127
       127
       +
         

     

       128
       128
       +
         (* Create simulated blob info *)

     

       129
       129
       +
         let blob_info = Jmap.Binary.Upload_response.v

     

       130
       130
       +
           ~account_id:""

     

       131
       131
       +
           ~blob_id:("blob-" ^ filename ^ "-" ^ string_of_int (Random.int 99999))

     

       132
       132
       +
           ~type_:mime_type

     

       133
       133
       +
           ~size:(String.length content)

     

       134
       134
       +
           () in

     

       135
       135
       +
         Printf.printf "  Uploaded: %s (blob: %s, %d bytes)\n" 

     

       136
       136
       +
           filename 

     

       137
       137
       +
           (Jmap.Binary.Upload_response.blob_id blob_info)

     

       138
       138
       +
           (Jmap.Binary.Upload_response.size blob_info);

     

       139
       139
       +
         Ok blob_info

     

       140
       140
       +
       

     

       141
       141
       +
       (* Create email body parts *)

     

       142
       142
       +
       let create_body_parts options attachment_blobs =

     

       143
       143
       +
         let parts = ref [] in

     

       144
       144
       +
         

     

       145
       145
       +
         (* Add text body if provided *)

     

       146
       146
       +
         (match options.body_text with

     

       147
       147
       +
         | Some text ->

     

       148
       148
       +
             let text_part = Jmap_email.Types.Email_body_part.v

     

       149
       149
       +
               ~id:"text"

     

       150
       150
       +
               ~size:(String.length text)

     

       151
       151
       +
               ~headers:[]

     

       152
       152
       +
               ~mime_type:"text/plain"

     

       153
       153
       +
               ~charset:"utf-8"

     

       154
       154
       +
               () in

     

       155
       155
       +
             parts := text_part :: !parts

     

       156
       156
       +
         | None -> ());

     

       157
       157
       +
         

     

       158
       158
       +
         (* Add HTML body if provided *)

     

       159
       159
       +
         (match options.body_html with

     

       160
       160
       +
         | Some html ->

     

       161
       161
       +
             let html_part = Jmap_email.Types.Email_body_part.v

     

       162
       162
       +
               ~id:"html"

     

       163
       163
       +
               ~size:(String.length html)

     

       164
       164
       +
               ~headers:[]

     

       165
       165
       +
               ~mime_type:"text/html"

     

       166
       166
       +
               ~charset:"utf-8"

     

       167
       167
       +
               () in

     

       168
       168
       +
             parts := html_part :: !parts

     

       169
       169
       +
         | None -> ());

     

       170
       170
       +
         

     

       171
       171
       +
         (* Add attachments *)

     

       172
       172
       +
         List.iter2 (fun filepath blob_info ->

     

       173
       173
       +
           let filename = Filename.basename filepath in

     

       174
       174
       +
           let mime_type = mime_type_from_filename filename in

     

       175
       175
       +
           let attachment = Jmap_email.Types.Email_body_part.v

     

       176
       176
       +
             ~blob_id:(Jmap.Binary.Upload_response.blob_id blob_info)

     

       177
       177
       +
             ~size:(Jmap.Binary.Upload_response.size blob_info)

     

       178
       178
       +
             ~headers:[]

     

       179
       179
       +
             ~name:filename

     

       180
       180
       +
             ~mime_type

     

       181
       181
       +
             ~disposition:"attachment"

     

       182
       182
       +
             () in

     

       183
       183
       +
           parts := attachment :: !parts

     

       184
       184
       +
         ) options.attachments attachment_blobs;

     

       185
       185
       +
         

     

       186
       186
       +
         List.rev !parts

     

       187
       187
       +
       

     

       188
       188
       +
       (* Main compose and send function *)

     

       189
       189
       +
       let compose_and_send ctx session account_id options =

     

       190
       190
       +
         (* 1. Upload attachments first *)

     

       191
       191
       +
         let attachment_results = List.map (fun filepath ->

     

       192
       192
       +
           upload_attachment ctx session account_id filepath

     

       193
       193
       +
         ) options.attachments in

     

       194
       194
       +
         

     

       195
       195
       +
         let attachment_blobs = List.filter_map (function

     

       196
       196
       +
           | Ok blob -> Some blob

     

       197
       197
       +
           | Error () -> None

     

       198
       198
       +
         ) attachment_results in

     

       199
       199
       +
         

     

       200
       200
       +
         if List.length attachment_blobs < List.length options.attachments then (

     

       201
       201
       +
           Printf.eprintf "Warning: Some attachments failed to upload\n"

     

       202
       202
       +
         );

     

       203
       203
       +
         

     

       204
       204
       +
         (* 2. Create the email addresses *)

     

       205
       205
       +
         let to_addresses = List.map (fun email ->

     

       206
       206
       +
           Jmap_email.Types.Email_address.v ~email ()

     

       207
       207
       +
         ) options.to_recipients in

     

       208
       208
       +
         

     

       209
       209
       +
         let cc_addresses = List.map (fun email ->

     

       210
       210
       +
           Jmap_email.Types.Email_address.v ~email ()

     

       211
       211
       +
         ) options.cc_recipients in

     

       212
       212
       +
         

     

       213
       213
       +
         let bcc_addresses = List.map (fun email ->

     

       214
       214
       +
           Jmap_email.Types.Email_address.v ~email ()

     

       215
       215
       +
         ) options.bcc_recipients in

     

       216
       216
       +
         

     

       217
       217
       +
         (* 3. Get sender identity *)

     

       218
       218
       +
         let identity_args = Jmap.Methods.Get_args.v

     

       219
       219
       +
           ~account_id

     

       220
       220
       +
           ~properties:["id"; "email"; "name"]

     

       221
       221
       +
           () in

     

       222
       222
       +
           

     

       223
       223
       +
         let identity_invocation = Jmap.Wire.Invocation.v

     

       224
       224
       +
           ~method_name:"Identity/get"

     

       225
       225
       +
           ~arguments:(`Assoc []) (* Would serialize identity_args *)

     

       226
       226
       +
           ~method_call_id:"id1"

     

       227
       227
       +
           () in

     

       228
       228
       +
           

     

       229
       229
       +
         let request = Jmap.Wire.Request.v

     

       230
       230
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       231
       231
       +
           ~method_calls:[identity_invocation]

     

       232
       232
       +
           () in

     

       233
       233
       +
           

     

       234
       234
       +
         let default_identity = match Jmap_unix.request ctx request with

     

       235
       235
       +
           | Ok _ ->

     

       236
       236
       +
               (* Would extract from response *)

     

       237
       237
       +
               Jmap_email.Identity.v

     

       238
       238
       +
                 ~id:"identity1"

     

       239
       239
       +
                 ~email:account_id

     

       240
       240
       +
                 ~name:"User Name"

     

       241
       241
       +
                 ~may_delete:true

     

       242
       242
       +
                 ()

     

       243
       243
       +
           | Error _ ->

     

       244
       244
       +
               (* Fallback identity *)

     

       245
       245
       +
               Jmap_email.Identity.v

     

       246
       246
       +
                 ~id:"identity1"

     

       247
       247
       +
                 ~email:account_id

     

       248
       248
       +
                 ~may_delete:true

     

       249
       249
       +
                 ()

     

       250
       250
       +
         in

     

       251
       251
       +
         

     

       252
       252
       +
         (* 4. Create the draft email *)

     

       253
       253
       +
         let body_parts = create_body_parts options attachment_blobs in

     

       254
       254
       +
         

     

       255
       255
       +
         let draft_email = Jmap_email.Types.Email.create

     

       256
       256
       +
           ~subject:options.subject

     

       257
       257
       +
           ~from:[Jmap_email.Types.Email_address.v 

     

       258
       258
       +
                    ~email:(Jmap_email.Identity.email default_identity)

     

       259
       259
       +
                    ~name:(Jmap_email.Identity.name default_identity)

     

       260
       260
       +
                    ()]

     

       261
       261
       +
           ~to_:to_addresses

     

       262
       262
       +
           ~cc:cc_addresses

     

       263
       263
       +
           ~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Draft])

     

       264
       264
       +
           ~text_body:body_parts

     

       265
       265
       +
           () in

     

       266
       266
       +
           

     

       267
       267
       +
         (* 5. Create the email using Email/set *)

     

       268
       268
       +
         let create_map = Hashtbl.create 1 in

     

       269
       269
       +
         Hashtbl.add create_map "draft1" draft_email;

     

       270
       270
       +
         

     

       271
       271
       +
         let create_args = Jmap.Methods.Set_args.v

     

       272
       272
       +
           ~account_id

     

       273
       273
       +
           ~create:create_map

     

       274
       274
       +
           () in

     

       275
       275
       +
           

     

       276
       276
       +
         let create_invocation = Jmap.Wire.Invocation.v

     

       277
       277
       +
           ~method_name:"Email/set"

     

       278
       278
       +
           ~arguments:(`Assoc []) (* Would serialize create_args *)

     

       279
       279
       +
           ~method_call_id:"create1"

     

       280
       280
       +
           () in

     

       281
       281
       +
           

     

       282
       282
       +
         (* 6. If sending, also create EmailSubmission *)

     

       283
       283
       +
         let method_calls = if options.send && not options.draft then

     

       284
       284
       +
           let submission = {

     

       285
       285
       +
             Jmap_email.Submission.email_sub_create_identity_id = Jmap_email.Identity.id default_identity;

     

       286
       286
       +
             email_sub_create_email_id = "#draft1"; (* Back-reference to created email *)

     

       287
       287
       +
             email_sub_create_envelope = None;

     

       288
       288
       +
           } in

     

       289
       289
       +
             

     

       290
       290
       +
           let submit_map = Hashtbl.create 1 in

     

       291
       291
       +
           Hashtbl.add submit_map "submission1" submission;

     

       292
       292
       +
           

     

       293
       293
       +
           let submit_args = Jmap.Methods.Set_args.v

     

       294
       294
       +
             ~account_id

     

       295
       295
       +
             ~create:submit_map

     

       296
       296
       +
             () in

     

       297
       297
       +
             

     

       298
       298
       +
           let submit_invocation = Jmap.Wire.Invocation.v

     

       299
       299
       +
             ~method_name:"EmailSubmission/set"

     

       300
       300
       +
             ~arguments:(`Assoc []) (* Would serialize submit_args *)

     

       301
       301
       +
             ~method_call_id:"submit1"

     

       302
       302
       +
             () in

     

       303
       303
       +
             

     

       304
       304
       +
           [create_invocation; submit_invocation]

     

       305
       305
       +
         else

     

       306
       306
       +
           [create_invocation]

     

       307
       307
       +
         in

     

       308
       308
       +
         

     

       309
       309
       +
         (* 7. Send the request *)

     

       310
       310
       +
         let request = Jmap.Wire.Request.v

     

       311
       311
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_submission]

     

       312
       312
       +
           ~method_calls

     

       313
       313
       +
           () in

     

       314
       314
       +
           

     

       315
       315
       +
         match Jmap_unix.request ctx request with

     

       316
       316
       +
         | Ok response ->

     

       317
       317
       +
             if options.send && not options.draft then

     

       318
       318
       +
               Printf.printf "\nEmail sent successfully!\n"

     

       319
       319
       +
             else

     

       320
       320
       +
               Printf.printf "\nDraft saved successfully!\n";

     

       321
       321
       +
             0

     

       322
       322
       +
         | Error e ->

     

       323
       323
       +
             Printf.eprintf "\nFailed to create email: %s\n" (Jmap.Error.error_to_string e);

     

       324
       324
       +
             1

     

       325
       325
       +
       

     

       326
       326
       +
       (* Command implementation *)

     

       327
       327
       +
       let compose_command host user password to_list cc_list bcc_list subject 

     

       328
       328
       +
                           body body_file html html_file attachments reply_to 

     

       329
       329
       +
                           draft send : int =

     

       330
       330
       +
         Printf.printf "JMAP Email Composer\n";

     

       331
       331
       +
         Printf.printf "Server: %s\n" host;

     

       332
       332
       +
         Printf.printf "User: %s\n\n" user;

     

       333
       333
       +
         

     

       334
       334
       +
         (* Validate arguments *)

     

       335
       335
       +
         if to_list = [] && cc_list = [] && bcc_list = [] then (

     

       336
       336
       +
           Printf.eprintf "Error: Must specify at least one recipient\n";

     

       337
       337
       +
           exit 1

     

       338
       338
       +
         );

     

       339
       339
       +
         

     

       340
       340
       +
         (* Read body content *)

     

       341
       341
       +
         let body_text = match body, body_file with

     

       342
       342
       +
           | Some text, _ -> Some text

     

       343
       343
       +
           | None, Some file -> Some (read_file file)

     

       344
       344
       +
           | None, None -> None

     

       345
       345
       +
         in

     

       346
       346
       +
         

     

       347
       347
       +
         let body_html = match html, html_file with

     

       348
       348
       +
           | Some text, _ -> Some text

     

       349
       349
       +
           | None, Some file -> Some (read_file file)

     

       350
       350
       +
           | None, None -> None

     

       351
       351
       +
         in

     

       352
       352
       +
         

     

       353
       353
       +
         if body_text = None && body_html = None then (

     

       354
       354
       +
           Printf.eprintf "Error: Must provide email body (--body, --body-file, --html, or --html-file)\n";

     

       355
       355
       +
           exit 1

     

       356
       356
       +
         );

     

       357
       357
       +
         

     

       358
       358
       +
         (* Create options record *)

     

       359
       359
       +
         let options = {

     

       360
       360
       +
           to_recipients = to_list;

     

       361
       361
       +
           cc_recipients = cc_list;

     

       362
       362
       +
           bcc_recipients = bcc_list;

     

       363
       363
       +
           subject;

     

       364
       364
       +
           body_text;

     

       365
       365
       +
           body_html;

     

       366
       366
       +
           attachments;

     

       367
       367
       +
           in_reply_to = reply_to;

     

       368
       368
       +
           draft;

     

       369
       369
       +
           send = send || not draft; (* Send by default unless draft flag is set *)

     

       370
       370
       +
         } in

     

       371
       371
       +
         

     

       372
       372
       +
         (* Connect to server *)

     

       373
       373
       +
         let ctx = Jmap_unix.create_client () in

     

       374
       374
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       375
       375
       +
         

     

       376
       376
       +
         let (ctx, session) = match result with

     

       377
       377
       +
           | Ok (ctx, session) -> (ctx, session)

     

       378
       378
       +
           | Error e -> 

     

       379
       379
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       380
       380
       +
               exit 1

     

       381
       381
       +
         in

     

       382
       382
       +
         

     

       383
       383
       +
         (* Get the primary account ID *)

     

       384
       384
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       385
       385
       +
           | Ok id -> id

     

       386
       386
       +
           | Error e -> 

     

       387
       387
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       388
       388
       +
               exit 1

     

       389
       389
       +
         in

     

       390
       390
       +
         

     

       391
       391
       +
         (* Compose and send/save the email *)

     

       392
       392
       +
         compose_and_send ctx session account_id options

     

       393
       393
       +
       

     

       394
       394
       +
       (* Command definition *)

     

       395
       395
       +
       let compose_cmd =

     

       396
       396
       +
         let doc = "compose and send emails via JMAP" in

     

       397
       397
       +
         let man = [

     

       398
       398
       +
           `S Manpage.s_description;

     

       399
       399
       +
           `P "Compose and send emails using the JMAP protocol.";

     

       400
       400
       +
           `P "Supports plain text and HTML bodies, attachments, and drafts.";

     

       401
       401
       +
           `S Manpage.s_examples;

     

       402
       402
       +
           `P "Send a simple email:";

     

       403
       403
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";

     

       404
       404
       +
           `P "    -t recipient@example.com -s \"Meeting reminder\" \\";

     

       405
       405
       +
           `P "    --body \"Don't forget our meeting at 3pm!\"";

     

       406
       406
       +
           `P "";

     

       407
       407
       +
           `P "Send email with attachment:";

     

       408
       408
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";

     

       409
       409
       +
           `P "    -t recipient@example.com -s \"Report attached\" \\";

     

       410
       410
       +
           `P "    --body-file message.txt -a report.pdf";

     

       411
       411
       +
           `P "";

     

       412
       412
       +
           `P "Save as draft:";

     

       413
       413
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 \\";

     

       414
       414
       +
           `P "    -t recipient@example.com -s \"Work in progress\" \\";

     

       415
       415
       +
           `P "    --body \"Still working on this...\" --draft";

     

       416
       416
       +
         ] in

     

       417
       417
       +
         

     

       418
       418
       +
         let cmd =

     

       419
       419
       +
           Cmd.v

     

       420
       420
       +
             (Cmd.info "jmap-email-composer" ~version:"1.0" ~doc ~man)

     

       421
       421
       +
             Term.(const compose_command $ host_arg $ user_arg $ password_arg $ 

     

       422
       422
       +
                   to_arg $ cc_arg $ bcc_arg $ subject_arg $ body_arg $ body_file_arg $

     

       423
       423
       +
                   html_arg $ html_file_arg $ attach_arg $ reply_to_arg $ 

     

       424
       424
       +
                   draft_arg $ send_arg)

     

       425
       425
       +
         in

     

       426
       426
       +
         cmd

     

       427
       427
       +
       

     

       428
       428
       +
       (* Main entry point *)

     

       429
       429
       +
       let () = exit (Cmd.eval' compose_cmd)

+436

bin/jmap_email_search.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_email_search.ml - A comprehensive email search utility using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's query capabilities for email searching,

     

       5
       5
       +
        * filtering, and sorting.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Email search arguments type *)

     

       13
       13
       +
       type email_search_args = {

     

       14
       14
       +
         query : string;

     

       15
       15
       +
         from : string option;

     

       16
       16
       +
         to_ : string option;

     

       17
       17
       +
         subject : string option;

     

       18
       18
       +
         before : string option;

     

       19
       19
       +
         after : string option;

     

       20
       20
       +
         has_attachment : bool;

     

       21
       21
       +
         mailbox : string option;

     

       22
       22
       +
         is_unread : bool;

     

       23
       23
       +
         limit : int;

     

       24
       24
       +
         sort : [`DateDesc | `DateAsc | `From | `To | `Subject | `Size];

     

       25
       25
       +
         format : [`Summary | `Json | `Detailed];

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

       28
       28
       +
       (* Module to convert ISO 8601 date strings to Unix timestamps *)

     

       29
       29
       +
       module Date_converter = struct

     

       30
       30
       +
         (* Convert an ISO date string (YYYY-MM-DD) to Unix timestamp *)

     

       31
       31
       +
         let parse_date date_str =

     

       32
       32
       +
           try

     

       33
       33
       +
             (* Parse YYYY-MM-DD format *)

     

       34
       34
       +
             let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in

     

       35
       35
       +
             

     

       36
       36
       +
             (* Convert to Unix timestamp (midnight UTC of that day) *)

     

       37
       37
       +
             let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       38
       38
       +
                             tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;

     

       39
       39
       +
                             tm_wday = 0; tm_yday = 0; tm_isdst = false } in

     

       40
       40
       +
             Some (Unix.mktime tm |> fst)

     

       41
       41
       +
           with _ ->

     

       42
       42
       +
             Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;

     

       43
       43
       +
             None

     

       44
       44
       +
             

     

       45
       45
       +
         (* Format a Unix timestamp as ISO 8601 *)

     

       46
       46
       +
         let format_datetime time =

     

       47
       47
       +
           let tm = Unix.gmtime time in

     

       48
       48
       +
           Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"

     

       49
       49
       +
             (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

     

       50
       50
       +
             tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec

     

       51
       51
       +
       end

     

       52
       52
       +
       

     

       53
       53
       +
       (** Command-line arguments **)

     

       54
       54
       +
       

     

       55
       55
       +
       let host_arg =

     

       56
       56
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       57
       57
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       58
       58
       +
       

     

       59
       59
       +
       let user_arg =

     

       60
       60
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       61
       61
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       62
       62
       +
       

     

       63
       63
       +
       let password_arg =

     

       64
       64
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       65
       65
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       66
       66
       +
       

     

       67
       67
       +
       let query_arg =

     

       68
       68
       +
         Arg.(value & opt string "" & info ["q"; "query"] 

     

       69
       69
       +
              ~docv:"QUERY" ~doc:"Text to search for in emails")

     

       70
       70
       +
       

     

       71
       71
       +
       let from_arg =

     

       72
       72
       +
         Arg.(value & opt (some string) None & info ["from"] 

     

       73
       73
       +
              ~docv:"EMAIL" ~doc:"Filter by sender email address")

     

       74
       74
       +
       

     

       75
       75
       +
       let to_arg =

     

       76
       76
       +
         Arg.(value & opt (some string) None & info ["to"] 

     

       77
       77
       +
              ~docv:"EMAIL" ~doc:"Filter by recipient email address")

     

       78
       78
       +
       

     

       79
       79
       +
       let subject_arg =

     

       80
       80
       +
         Arg.(value & opt (some string) None & info ["subject"] 

     

       81
       81
       +
              ~docv:"SUBJECT" ~doc:"Filter by subject text")

     

       82
       82
       +
       

     

       83
       83
       +
       let before_arg =

     

       84
       84
       +
         Arg.(value & opt (some string) None & info ["before"] 

     

       85
       85
       +
              ~docv:"DATE" ~doc:"Show emails before date (YYYY-MM-DD)")

     

       86
       86
       +
       

     

       87
       87
       +
       let after_arg =

     

       88
       88
       +
         Arg.(value & opt (some string) None & info ["after"] 

     

       89
       89
       +
              ~docv:"DATE" ~doc:"Show emails after date (YYYY-MM-DD)")

     

       90
       90
       +
       

     

       91
       91
       +
       let has_attachment_arg =

     

       92
       92
       +
         Arg.(value & flag & info ["has-attachment"] 

     

       93
       93
       +
              ~doc:"Filter to emails with attachments")

     

       94
       94
       +
       

     

       95
       95
       +
       let mailbox_arg =

     

       96
       96
       +
         Arg.(value & opt (some string) None & info ["mailbox"] 

     

       97
       97
       +
              ~docv:"MAILBOX" ~doc:"Filter by mailbox name")

     

       98
       98
       +
       

     

       99
       99
       +
       let is_unread_arg =

     

       100
       100
       +
         Arg.(value & flag & info ["unread"] 

     

       101
       101
       +
              ~doc:"Show only unread emails")

     

       102
       102
       +
       

     

       103
       103
       +
       let limit_arg =

     

       104
       104
       +
         Arg.(value & opt int 20 & info ["limit"] 

     

       105
       105
       +
              ~docv:"N" ~doc:"Maximum number of results to return")

     

       106
       106
       +
       

     

       107
       107
       +
       let sort_arg =

     

       108
       108
       +
         Arg.(value & opt (enum [

     

       109
       109
       +
           "date-desc", `DateDesc;

     

       110
       110
       +
           "date-asc", `DateAsc;

     

       111
       111
       +
           "from", `From;

     

       112
       112
       +
           "to", `To;

     

       113
       113
       +
           "subject", `Subject;

     

       114
       114
       +
           "size", `Size;

     

       115
       115
       +
         ]) `DateDesc & info ["sort"] ~docv:"FIELD" 

     

       116
       116
       +
              ~doc:"Sort results by field")

     

       117
       117
       +
       

     

       118
       118
       +
       let format_arg =

     

       119
       119
       +
         Arg.(value & opt (enum [

     

       120
       120
       +
           "summary", `Summary;

     

       121
       121
       +
           "json", `Json;

     

       122
       122
       +
           "detailed", `Detailed;

     

       123
       123
       +
         ]) `Summary & info ["format"] ~docv:"FORMAT" 

     

       124
       124
       +
              ~doc:"Output format")

     

       125
       125
       +
       

     

       126
       126
       +
       (** Main functionality **)

     

       127
       127
       +
       

     

       128
       128
       +
       (* Create a filter based on command-line arguments - this function uses the actual JMAP API *)

     

       129
       129
       +
       let create_filter _account_id mailbox_id_opt args =

     

       130
       130
       +
         let open Jmap.Methods.Filter in

     

       131
       131
       +
         let filters = [] in

     

       132
       132
       +
         

     

       133
       133
       +
         (* Add filter conditions based on command-line args *)

     

       134
       134
       +
         let filters = match args.query with 

     

       135
       135
       +
           | "" -> filters 

     

       136
       136
       +
           | query -> Jmap_email.Email_filter.subject query :: filters 

     

       137
       137
       +
         in

     

       138
       138
       +
         

     

       139
       139
       +
         let filters = match args.from with

     

       140
       140
       +
           | None -> filters

     

       141
       141
       +
           | Some sender -> Jmap_email.Email_filter.from sender :: filters

     

       142
       142
       +
         in

     

       143
       143
       +
         

     

       144
       144
       +
         let filters = match args.to_ with

     

       145
       145
       +
           | None -> filters

     

       146
       146
       +
           | Some recipient -> Jmap_email.Email_filter.to_ recipient :: filters

     

       147
       147
       +
         in

     

       148
       148
       +
         

     

       149
       149
       +
         let filters = match args.subject with

     

       150
       150
       +
           | None -> filters

     

       151
       151
       +
           | Some subj -> Jmap_email.Email_filter.subject subj :: filters

     

       152
       152
       +
         in

     

       153
       153
       +
         

     

       154
       154
       +
         let filters = match args.before with

     

       155
       155
       +
           | None -> filters

     

       156
       156
       +
           | Some date_str -> 

     

       157
       157
       +
               match Date_converter.parse_date date_str with

     

       158
       158
       +
               | Some date -> Jmap_email.Email_filter.before date :: filters

     

       159
       159
       +
               | None -> filters

     

       160
       160
       +
         in

     

       161
       161
       +
         

     

       162
       162
       +
         let filters = match args.after with

     

       163
       163
       +
           | None -> filters

     

       164
       164
       +
           | Some date_str -> 

     

       165
       165
       +
               match Date_converter.parse_date date_str with

     

       166
       166
       +
               | Some date -> Jmap_email.Email_filter.after date :: filters

     

       167
       167
       +
               | None -> filters

     

       168
       168
       +
         in

     

       169
       169
       +
         

     

       170
       170
       +
         let filters = if args.has_attachment then Jmap_email.Email_filter.has_attachment () :: filters else filters in

     

       171
       171
       +
         

     

       172
       172
       +
         let filters = if args.is_unread then Jmap_email.Email_filter.unread () :: filters else filters in

     

       173
       173
       +
         

     

       174
       174
       +
         let filters = match mailbox_id_opt with

     

       175
       175
       +
           | None -> filters

     

       176
       176
       +
           | Some mailbox_id -> Jmap_email.Email_filter.in_mailbox mailbox_id :: filters

     

       177
       177
       +
         in

     

       178
       178
       +
         

     

       179
       179
       +
         (* Combine all filters with AND *)

     

       180
       180
       +
         match filters with

     

       181
       181
       +
         | [] -> condition (`Assoc [])  (* Empty filter *)

     

       182
       182
       +
         | [f] -> f

     

       183
       183
       +
         | filters -> and_ filters

     

       184
       184
       +
       

     

       185
       185
       +
       (* Create sort comparator based on command-line arguments *)

     

       186
       186
       +
       let create_sort args =

     

       187
       187
       +
         match args.sort with

     

       188
       188
       +
         | `DateDesc -> Jmap_email.Email_sort.received_newest_first ()

     

       189
       189
       +
         | `DateAsc -> Jmap_email.Email_sort.received_oldest_first ()

     

       190
       190
       +
         | `From -> Jmap_email.Email_sort.from_asc ()

     

       191
       191
       +
         | `To -> Jmap_email.Email_sort.subject_asc ()  (* Using subject as proxy for 'to' *)

     

       192
       192
       +
         | `Subject -> Jmap_email.Email_sort.subject_asc ()

     

       193
       193
       +
         | `Size -> Jmap_email.Email_sort.size_largest_first ()

     

       194
       194
       +
       

     

       195
       195
       +
       (* Display email results based on format option *)

     

       196
       196
       +
       let display_results emails format =

     

       197
       197
       +
         match format with

     

       198
       198
       +
         | `Summary ->

     

       199
       199
       +
             emails |> List.iteri (fun i email ->

     

       200
       200
       +
               let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in

     

       201
       201
       +
               let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in

     

       202
       202
       +
               let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in

     

       203
       203
       +
               let from = match from_list with

     

       204
       204
       +
                 | [] -> "(no sender)"

     

       205
       205
       +
                 | addr::_ -> Jmap_email.Types.Email_address.email addr

     

       206
       206
       +
               in

     

       207
       207
       +
               let date = match Jmap_email.Types.Email.received_at email with

     

       208
       208
       +
                 | Some d -> Date_converter.format_datetime d

     

       209
       209
       +
                 | None -> "(no date)"

     

       210
       210
       +
               in

     

       211
       211
       +
               Printf.printf "%3d) [%s] %s\n     From: %s\n     Date: %s\n\n" 

     

       212
       212
       +
                 (i+1) id subject from date

     

       213
       213
       +
             );

     

       214
       214
       +
             0

     

       215
       215
       +
         

     

       216
       216
       +
         | `Detailed ->

     

       217
       217
       +
             emails |> List.iteri (fun i email ->

     

       218
       218
       +
               let id = Option.value (Jmap_email.Types.Email.id email) ~default:"(no id)" in

     

       219
       219
       +
               let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"(no subject)" in

     

       220
       220
       +
               let thread_id = Option.value (Jmap_email.Types.Email.thread_id email) ~default:"(no thread)" in

     

       221
       221
       +
               

     

       222
       222
       +
               let from_list = Option.value (Jmap_email.Types.Email.from email) ~default:[] in

     

       223
       223
       +
               let from = match from_list with

     

       224
       224
       +
                 | [] -> "(no sender)"

     

       225
       225
       +
                 | addr::_ -> Jmap_email.Types.Email_address.email addr

     

       226
       226
       +
               in

     

       227
       227
       +
               

     

       228
       228
       +
               let to_list = Option.value (Jmap_email.Types.Email.to_ email) ~default:[] in

     

       229
       229
       +
               let to_str = to_list 

     

       230
       230
       +
                 |> List.map Jmap_email.Types.Email_address.email

     

       231
       231
       +
                 |> String.concat ", " in

     

       232
       232
       +
               

     

       233
       233
       +
               let date = match Jmap_email.Types.Email.received_at email with

     

       234
       234
       +
                 | Some d -> Date_converter.format_datetime d

     

       235
       235
       +
                 | None -> "(no date)"

     

       236
       236
       +
               in

     

       237
       237
       +
               

     

       238
       238
       +
               let keywords = match Jmap_email.Types.Email.keywords email with

     

       239
       239
       +
                 | Some kw -> Jmap_email.Types.Keywords.custom_keywords kw 

     

       240
       240
       +
                              |> String.concat ", "

     

       241
       241
       +
                 | None -> "(none)"

     

       242
       242
       +
               in

     

       243
       243
       +
               

     

       244
       244
       +
               let has_attachment = match Jmap_email.Types.Email.has_attachment email with

     

       245
       245
       +
                 | Some true -> "Yes"

     

       246
       246
       +
                 | _ -> "No"

     

       247
       247
       +
               in

     

       248
       248
       +
               

     

       249
       249
       +
               Printf.printf "Email %d:\n" (i+1);

     

       250
       250
       +
               Printf.printf "  ID:        %s\n" id;

     

       251
       251
       +
               Printf.printf "  Subject:   %s\n" subject;

     

       252
       252
       +
               Printf.printf "  From:      %s\n" from;

     

       253
       253
       +
               Printf.printf "  To:        %s\n" to_str;

     

       254
       254
       +
               Printf.printf "  Date:      %s\n" date;

     

       255
       255
       +
               Printf.printf "  Thread:    %s\n" thread_id;

     

       256
       256
       +
               Printf.printf "  Flags:     %s\n" keywords;

     

       257
       257
       +
               Printf.printf "  Attachment:%s\n" has_attachment;

     

       258
       258
       +
               

     

       259
       259
       +
               match Jmap_email.Types.Email.preview email with

     

       260
       260
       +
               | Some text -> Printf.printf "  Preview:   %s\n" text

     

       261
       261
       +
               | None -> ();

     

       262
       262
       +
               

     

       263
       263
       +
               Printf.printf "\n"

     

       264
       264
       +
             );

     

       265
       265
       +
             0

     

       266
       266
       +
             

     

       267
       267
       +
         | `Json ->

     

       268
       268
       +
             (* In a real implementation, this would properly convert emails to JSON *)

     

       269
       269
       +
             Printf.printf "{\n  \"results\": [\n";

     

       270
       270
       +
             emails |> List.iteri (fun i email ->

     

       271
       271
       +
               let id = Option.value (Jmap_email.Types.Email.id email) ~default:"" in

     

       272
       272
       +
               let subject = Option.value (Jmap_email.Types.Email.subject email) ~default:"" in

     

       273
       273
       +
               Printf.printf "    {\"id\": \"%s\", \"subject\": \"%s\"%s\n" 

     

       274
       274
       +
                 id subject (if i < List.length emails - 1 then "}," else "}")

     

       275
       275
       +
             );

     

       276
       276
       +
             Printf.printf "  ]\n}\n";

     

       277
       277
       +
             0

     

       278
       278
       +
       

     

       279
       279
       +
       (* Command implementation - using the real JMAP interface *)

     

       280
       280
       +
       let search_command host user password query from to_ subject before after 

     

       281
       281
       +
                          has_attachment mailbox is_unread limit sort format : int =

     

       282
       282
       +
         (* Pack arguments into a record for easier passing *)

     

       283
       283
       +
         let args : email_search_args = {

     

       284
       284
       +
           query; from; to_ = to_; subject; before; after; 

     

       285
       285
       +
           has_attachment; mailbox; is_unread; limit; sort; format

     

       286
       286
       +
         } in

     

       287
       287
       +
         

     

       288
       288
       +
         Printf.printf "JMAP Email Search\n";

     

       289
       289
       +
         Printf.printf "Server: %s\n" host;

     

       290
       290
       +
         Printf.printf "User: %s\n\n" user;

     

       291
       291
       +
         

     

       292
       292
       +
         (* The following code demonstrates using the JMAP library interface

     

       293
       293
       +
            but doesn't actually run it for Step 2 (it will get a linker error,

     

       294
       294
       +
            which is expected since there's no implementation yet) *)

     

       295
       295
       +
         

     

       296
       296
       +
         let process_search () =

     

       297
       297
       +
           (* 1. Create client context and connect to server *)

     

       298
       298
       +
           let _orig_ctx = Jmap_unix.create_client () in

     

       299
       299
       +
           let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       300
       300
       +
           

     

       301
       301
       +
           let (ctx, session) = match result with

     

       302
       302
       +
             | Ok (ctx, session) -> (ctx, session)

     

       303
       303
       +
             | Error _ -> failwith "Could not connect to server"

     

       304
       304
       +
           in

     

       305
       305
       +
           

     

       306
       306
       +
           (* 2. Get the primary account ID for mail capability *)

     

       307
       307
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       308
       308
       +
             | Ok id -> id

     

       309
       309
       +
             | Error _ -> failwith "No mail account found"

     

       310
       310
       +
           in

     

       311
       311
       +
           

     

       312
       312
       +
           (* 3. Resolve mailbox name to ID if specified *)

     

       313
       313
       +
           let mailbox_id_opt = match args.mailbox with

     

       314
       314
       +
             | None -> None

     

       315
       315
       +
             | Some _name ->

     

       316
       316
       +
                 (* This would use Mailbox/query and Mailbox/get to resolve the name *)

     

       317
       317
       +
                 (* For now just simulate a mailbox ID *)

     

       318
       318
       +
                 Some "mailbox123"

     

       319
       319
       +
           in

     

       320
       320
       +
           

     

       321
       321
       +
           (* 4. Create filter based on search criteria *)

     

       322
       322
       +
           let filter = create_filter account_id mailbox_id_opt args in

     

       323
       323
       +
           

     

       324
       324
       +
           (* 5. Create sort comparator *)

     

       325
       325
       +
           let sort = create_sort args in

     

       326
       326
       +
           

     

       327
       327
       +
           (* 6. Prepare Email/query request *)

     

       328
       328
       +
           let _query_args = Jmap.Methods.Query_args.v

     

       329
       329
       +
             ~account_id

     

       330
       330
       +
             ~filter

     

       331
       331
       +
             ~sort:[sort]

     

       332
       332
       +
             ~position:0

     

       333
       333
       +
             ~limit:args.limit

     

       334
       334
       +
             ~calculate_total:true

     

       335
       335
       +
             () in

     

       336
       336
       +
             

     

       337
       337
       +
           let query_invocation = Jmap.Wire.Invocation.v

     

       338
       338
       +
             ~method_name:"Email/query"

     

       339
       339
       +
             ~arguments:(`Assoc []) (* In real code, we'd serialize query_args to JSON *)

     

       340
       340
       +
             ~method_call_id:"q1"

     

       341
       341
       +
             () in

     

       342
       342
       +
           

     

       343
       343
       +
           (* 7. Prepare Email/get request with back-reference to query results *)

     

       344
       344
       +
           let get_properties = [

     

       345
       345
       +
             "id"; "threadId"; "mailboxIds"; "keywords"; "size";

     

       346
       346
       +
             "receivedAt"; "messageId"; "inReplyTo"; "references";

     

       347
       347
       +
             "sender"; "from"; "to"; "cc"; "bcc"; "replyTo";

     

       348
       348
       +
             "subject"; "sentAt"; "hasAttachment"; "preview" 

     

       349
       349
       +
           ] in

     

       350
       350
       +
           

     

       351
       351
       +
           let _get_args = Jmap.Methods.Get_args.v

     

       352
       352
       +
             ~account_id

     

       353
       353
       +
             ~properties:get_properties

     

       354
       354
       +
             () in

     

       355
       355
       +
           

     

       356
       356
       +
           let get_invocation = Jmap.Wire.Invocation.v

     

       357
       357
       +
             ~method_name:"Email/get"

     

       358
       358
       +
             ~arguments:(`Assoc []) (* In real code, we'd serialize get_args to JSON *)

     

       359
       359
       +
             ~method_call_id:"g1"

     

       360
       360
       +
             () in

     

       361
       361
       +
           

     

       362
       362
       +
           (* 8. Prepare the JMAP request *)

     

       363
       363
       +
           let request = Jmap.Wire.Request.v

     

       364
       364
       +
             ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       365
       365
       +
             ~method_calls:[query_invocation; get_invocation]

     

       366
       366
       +
             () in

     

       367
       367
       +
           

     

       368
       368
       +
           (* 9. Send the request *)

     

       369
       369
       +
           let response = match Jmap_unix.request ctx request with

     

       370
       370
       +
             | Ok response -> response

     

       371
       371
       +
             | Error _ -> failwith "Request failed"

     

       372
       372
       +
           in

     

       373
       373
       +
           

     

       374
       374
       +
           (* Helper to find a method response by ID *)

     

       375
       375
       +
           let find_method_response response id =

     

       376
       376
       +
             let open Jmap.Wire in

     

       377
       377
       +
             let responses = Response.method_responses response in

     

       378
       378
       +
             let find_by_id inv =

     

       379
       379
       +
               match inv with

     

       380
       380
       +
               | Ok invocation when Invocation.method_call_id invocation = id -> 

     

       381
       381
       +
                   Some (Invocation.method_name invocation, Invocation.arguments invocation)

     

       382
       382
       +
               | _ -> None

     

       383
       383
       +
             in

     

       384
       384
       +
             List.find_map find_by_id responses

     

       385
       385
       +
           in

     

       386
       386
       +
           

     

       387
       387
       +
           (* 10. Process the response *)

     

       388
       388
       +
           match find_method_response response "g1" with

     

       389
       389
       +
           | Some (method_name, _) when method_name = "Email/get" ->

     

       390
       390
       +
               (* We would extract the emails from the response here *)

     

       391
       391
       +
               (* For now, just create a sample email for type checking *)

     

       392
       392
       +
               let email = Jmap_email.Types.Email.create

     

       393
       393
       +
                 ~id:"email123"

     

       394
       394
       +
                 ~thread_id:"thread456"

     

       395
       395
       +
                 ~subject:"Test Email"

     

       396
       396
       +
                 ~from:[Jmap_email.Types.Email_address.v ~name:"Sender" ~email:"sender@example.com" ()]

     

       397
       397
       +
                 ~to_:[Jmap_email.Types.Email_address.v ~name:"Recipient" ~email:"recipient@example.com" ()]

     

       398
       398
       +
                 ~received_at:1588000000.0

     

       399
       399
       +
                 ~has_attachment:true

     

       400
       400
       +
                 ~preview:"This is a test email..."

     

       401
       401
       +
                 ~keywords:(Jmap_email.Types.Keywords.of_list [Jmap_email.Types.Keywords.Seen])

     

       402
       402
       +
                 () in

     

       403
       403
       +
                 

     

       404
       404
       +
               (* Display the result *)

     

       405
       405
       +
               display_results [email] args.format

     

       406
       406
       +
           | _ ->

     

       407
       407
       +
               Printf.eprintf "Error: Invalid response\n";

     

       408
       408
       +
               1

     

       409
       409
       +
         in

     

       410
       410
       +
         

     

       411
       411
       +
         (* Note: Since we're only type checking, this won't actually run *)

     

       412
       412
       +
         process_search ()

     

       413
       413
       +
       

     

       414
       414
       +
       (* Command definition *)

     

       415
       415
       +
       let search_cmd =

     

       416
       416
       +
         let doc = "search emails using JMAP query capabilities" in

     

       417
       417
       +
         let man = [

     

       418
       418
       +
           `S Manpage.s_description;

     

       419
       419
       +
           `P "Searches for emails on a JMAP server with powerful filtering capabilities.";

     

       420
       420
       +
           `P "Demonstrates the rich query functions available in the JMAP protocol.";

     

       421
       421
       +
           `S Manpage.s_examples;

     

       422
       422
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -q \"important meeting\"";

     

       423
       423
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --from boss@company.com --after 2023-01-01";

     

       424
       424
       +
         ] in

     

       425
       425
       +
         

     

       426
       426
       +
         let cmd =

     

       427
       427
       +
           Cmd.v

     

       428
       428
       +
             (Cmd.info "jmap-email-search" ~version:"1.0" ~doc ~man)

     

       429
       429
       +
             Term.(const search_command $ host_arg $ user_arg $ password_arg $ 

     

       430
       430
       +
                   query_arg $ from_arg $ to_arg $ subject_arg $ before_arg $ after_arg $ 

     

       431
       431
       +
                   has_attachment_arg $ mailbox_arg $ is_unread_arg $ limit_arg $ sort_arg $ format_arg)

     

       432
       432
       +
         in

     

       433
       433
       +
         cmd

     

       434
       434
       +
       

     

       435
       435
       +
       (* Main entry point *)

     

       436
       436
       +
       let () = exit (Cmd.eval' search_cmd)

+706

bin/jmap_flag_manager.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_flag_manager.ml - A tool for managing email flags (keywords) using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's flag management capabilities, allowing

     

       5
       5
       +
        * powerful query-based selection and batch flag operations.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap.Methods

     

       13
       13
       +
       open Jmap_email

     

       14
       14
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       15
       15
       +
       

     

       16
       16
       +
       (* Dummy Unix module for type checking *)

     

       17
       17
       +
       module Unix = struct

     

       18
       18
       +
         type tm = {

     

       19
       19
       +
           tm_sec : int;

     

       20
       20
       +
           tm_min : int;

     

       21
       21
       +
           tm_hour : int;

     

       22
       22
       +
           tm_mday : int;

     

       23
       23
       +
           tm_mon : int;

     

       24
       24
       +
           tm_year : int;

     

       25
       25
       +
           tm_wday : int;

     

       26
       26
       +
           tm_yday : int;

     

       27
       27
       +
           tm_isdst : bool

     

       28
       28
       +
         }

     

       29
       29
       +
         

     

       30
       30
       +
         let time () = 0.0

     

       31
       31
       +
         let gettimeofday () = 0.0

     

       32
       32
       +
         let mktime tm = (0.0, tm)

     

       33
       33
       +
         let gmtime _time = {

     

       34
       34
       +
           tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       35
       35
       +
           tm_mday = 1; tm_mon = 0; tm_year = 120;

     

       36
       36
       +
           tm_wday = 0; tm_yday = 0; tm_isdst = false;

     

       37
       37
       +
         }

     

       38
       38
       +
         

     

       39
       39
       +
         (* JMAP connection function - would be in a real implementation *)

     

       40
       40
       +
         let connect ~host:_ ~username:_ ~password:_ ?auth_method:_ () =

     

       41
       41
       +
           failwith "Not implemented"

     

       42
       42
       +
       end

     

       43
       43
       +
       

     

       44
       44
       +
       (* Dummy ISO8601 module *)

     

       45
       45
       +
       module ISO8601 = struct

     

       46
       46
       +
         let string_of_datetime _tm = "2023-01-01T00:00:00Z"

     

       47
       47
       +
       end

     

       48
       48
       +
       

     

       49
       49
       +
       (** Flag manager args type *)

     

       50
       50
       +
       type flag_manager_args = {

     

       51
       51
       +
         list : bool;

     

       52
       52
       +
         add_flag : string option;

     

       53
       53
       +
         remove_flag : string option;

     

       54
       54
       +
         query : string;

     

       55
       55
       +
         from : string option;

     

       56
       56
       +
         days : int;

     

       57
       57
       +
         mailbox : string option;

     

       58
       58
       +
         ids : string list;

     

       59
       59
       +
         has_flag : string option;

     

       60
       60
       +
         missing_flag : string option;

     

       61
       61
       +
         limit : int;

     

       62
       62
       +
         dry_run : bool;

     

       63
       63
       +
         color : [`Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray | `None] option;

     

       64
       64
       +
         verbose : bool;

     

       65
       65
       +
       }

     

       66
       66
       +
       

     

       67
       67
       +
       (* Helper function for converting keywords to string *)

     

       68
       68
       +
       let string_of_keyword = function

     

       69
       69
       +
         | Types.Keywords.Draft -> "$draft"

     

       70
       70
       +
         | Types.Keywords.Seen -> "$seen"

     

       71
       71
       +
         | Types.Keywords.Flagged -> "$flagged"

     

       72
       72
       +
         | Types.Keywords.Answered -> "$answered"

     

       73
       73
       +
         | Types.Keywords.Forwarded -> "$forwarded"

     

       74
       74
       +
         | Types.Keywords.Phishing -> "$phishing"

     

       75
       75
       +
         | Types.Keywords.Junk -> "$junk"

     

       76
       76
       +
         | Types.Keywords.NotJunk -> "$notjunk"

     

       77
       77
       +
         | Types.Keywords.Custom c -> c

     

       78
       78
       +
         | Types.Keywords.Notify -> "$notify"

     

       79
       79
       +
         | Types.Keywords.Muted -> "$muted"

     

       80
       80
       +
         | Types.Keywords.Followed -> "$followed"

     

       81
       81
       +
         | Types.Keywords.Memo -> "$memo" 

     

       82
       82
       +
         | Types.Keywords.HasMemo -> "$hasmemo"

     

       83
       83
       +
         | Types.Keywords.Autosent -> "$autosent"

     

       84
       84
       +
         | Types.Keywords.Unsubscribed -> "$unsubscribed"

     

       85
       85
       +
         | Types.Keywords.CanUnsubscribe -> "$canunsubscribe"

     

       86
       86
       +
         | Types.Keywords.Imported -> "$imported"

     

       87
       87
       +
         | Types.Keywords.IsTrusted -> "$istrusted"

     

       88
       88
       +
         | Types.Keywords.MaskedEmail -> "$maskedemail"

     

       89
       89
       +
         | Types.Keywords.New -> "$new"

     

       90
       90
       +
         | Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"

     

       91
       91
       +
         | Types.Keywords.MailFlagBit1 -> "$MailFlagBit1" 

     

       92
       92
       +
         | Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"

     

       93
       93
       +
       

     

       94
       94
       +
       (* Email filter helpers - stub implementations for type checking *)

     

       95
       95
       +
       module Email_filter = struct

     

       96
       96
       +
         let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])

     

       97
       97
       +
         let subject subject = Filter.condition (`Assoc [("subject", `String subject)])

     

       98
       98
       +
         let from email = Filter.condition (`Assoc [("from", `String email)])

     

       99
       99
       +
         let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])

     

       100
       100
       +
         let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])

     

       101
       101
       +
         let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])

     

       102
       102
       +
         let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])

     

       103
       103
       +
         let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])

     

       104
       104
       +
         let to_ email = Filter.condition (`Assoc [("to", `String email)])

     

       105
       105
       +
         let has_keyword kw = Filter.condition (`Assoc [("hasKeyword", `String (string_of_keyword kw))])

     

       106
       106
       +
         let not_has_keyword kw = Filter.condition (`Assoc [("notHasKeyword", `String (string_of_keyword kw))])

     

       107
       107
       +
       end

     

       108
       108
       +
       

     

       109
       109
       +
       (** Command-line arguments **)

     

       110
       110
       +
       

     

       111
       111
       +
       let host_arg =

     

       112
       112
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       113
       113
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       114
       114
       +
       

     

       115
       115
       +
       let user_arg =

     

       116
       116
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       117
       117
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       118
       118
       +
       

     

       119
       119
       +
       let password_arg =

     

       120
       120
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       121
       121
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       122
       122
       +
       

     

       123
       123
       +
       let list_arg =

     

       124
       124
       +
         Arg.(value & flag & info ["l"; "list"] ~doc:"List emails with their flags")

     

       125
       125
       +
       

     

       126
       126
       +
       let add_flag_arg =

     

       127
       127
       +
         Arg.(value & opt (some string) None & info ["add"] 

     

       128
       128
       +
              ~docv:"FLAG" ~doc:"Add flag to selected emails")

     

       129
       129
       +
       

     

       130
       130
       +
       let remove_flag_arg =

     

       131
       131
       +
         Arg.(value & opt (some string) None & info ["remove"] 

     

       132
       132
       +
              ~docv:"FLAG" ~doc:"Remove flag from selected emails")

     

       133
       133
       +
       

     

       134
       134
       +
       let query_arg =

     

       135
       135
       +
         Arg.(value & opt string "" & info ["q"; "query"] 

     

       136
       136
       +
              ~docv:"QUERY" ~doc:"Filter emails by search query")

     

       137
       137
       +
       

     

       138
       138
       +
       let from_arg =

     

       139
       139
       +
         Arg.(value & opt (some string) None & info ["from"] 

     

       140
       140
       +
              ~docv:"EMAIL" ~doc:"Filter by sender")

     

       141
       141
       +
       

     

       142
       142
       +
       let days_arg =

     

       143
       143
       +
         Arg.(value & opt int 30 & info ["days"] 

     

       144
       144
       +
              ~docv:"DAYS" ~doc:"Filter to emails from past N days")

     

       145
       145
       +
       

     

       146
       146
       +
       let mailbox_arg =

     

       147
       147
       +
         Arg.(value & opt (some string) None & info ["mailbox"] 

     

       148
       148
       +
              ~docv:"MAILBOX" ~doc:"Filter by mailbox")

     

       149
       149
       +
       

     

       150
       150
       +
       let ids_arg =

     

       151
       151
       +
         Arg.(value & opt_all string [] & info ["id"] 

     

       152
       152
       +
              ~docv:"ID" ~doc:"Email IDs to operate on")

     

       153
       153
       +
       

     

       154
       154
       +
       let has_flag_arg =

     

       155
       155
       +
         Arg.(value & opt (some string) None & info ["has-flag"] 

     

       156
       156
       +
              ~docv:"FLAG" ~doc:"Filter to emails with specified flag")

     

       157
       157
       +
       

     

       158
       158
       +
       let missing_flag_arg =

     

       159
       159
       +
         Arg.(value & opt (some string) None & info ["missing-flag"] 

     

       160
       160
       +
              ~docv:"FLAG" ~doc:"Filter to emails without specified flag")

     

       161
       161
       +
       

     

       162
       162
       +
       let limit_arg =

     

       163
       163
       +
         Arg.(value & opt int 50 & info ["limit"] 

     

       164
       164
       +
              ~docv:"N" ~doc:"Maximum number of emails to process")

     

       165
       165
       +
       

     

       166
       166
       +
       let dry_run_arg =

     

       167
       167
       +
         Arg.(value & flag & info ["dry-run"] ~doc:"Show what would be done without making changes")

     

       168
       168
       +
       

     

       169
       169
       +
       let color_arg =

     

       170
       170
       +
         Arg.(value & opt (some (enum [

     

       171
       171
       +
           "red", `Red;

     

       172
       172
       +
           "orange", `Orange;

     

       173
       173
       +
           "yellow", `Yellow;

     

       174
       174
       +
           "green", `Green;

     

       175
       175
       +
           "blue", `Blue;

     

       176
       176
       +
           "purple", `Purple;

     

       177
       177
       +
           "gray", `Gray;

     

       178
       178
       +
           "none", `None

     

       179
       179
       +
         ])) None & info ["color"] ~docv:"COLOR" 

     

       180
       180
       +
              ~doc:"Set color flag (red, orange, yellow, green, blue, purple, gray, or none)")

     

       181
       181
       +
       

     

       182
       182
       +
       let verbose_arg =

     

       183
       183
       +
         Arg.(value & flag & info ["v"; "verbose"] ~doc:"Show detailed operation information")

     

       184
       184
       +
       

     

       185
       185
       +
       (** Flag Manager Functionality **)

     

       186
       186
       +
       

     

       187
       187
       +
       (* Parse date for filtering *)

     

       188
       188
       +
       let days_ago_date days =

     

       189
       189
       +
         let now = Unix.time () in

     

       190
       190
       +
         now -. (float_of_int days *. 86400.0)

     

       191
       191
       +
       

     

       192
       192
       +
       (* Validate flag name *)

     

       193
       193
       +
       let validate_flag_name flag =

     

       194
       194
       +
         let is_valid = String.length flag > 0 && (

     

       195
       195
       +
           (* System flags start with $ *)

     

       196
       196
       +
           (String.get flag 0 = '$') ||

     

       197
       197
       +
           

     

       198
       198
       +
           (* Custom flags must be alphanumeric plus some characters *)

     

       199
       199
       +
           (String.for_all (function 

     

       200
       200
       +
             | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' | '_' -> true 

     

       201
       201
       +
             | _ -> false) flag)

     

       202
       202
       +
         ) in

     

       203
       203
       +
         

     

       204
       204
       +
         if not is_valid then

     

       205
       205
       +
           Printf.eprintf "Warning: Flag name '%s' may not be valid according to JMAP spec\n" flag;

     

       206
       206
       +
         

     

       207
       207
       +
         is_valid

     

       208
       208
       +
       

     

       209
       209
       +
       (* Convert flag name to keyword *)

     

       210
       210
       +
       let flag_to_keyword flag =

     

       211
       211
       +
         match flag with

     

       212
       212
       +
         | "seen" -> Types.Keywords.Seen

     

       213
       213
       +
         | "draft" -> Types.Keywords.Draft

     

       214
       214
       +
         | "flagged" -> Types.Keywords.Flagged

     

       215
       215
       +
         | "answered" -> Types.Keywords.Answered

     

       216
       216
       +
         | "forwarded" -> Types.Keywords.Forwarded

     

       217
       217
       +
         | "junk" -> Types.Keywords.Junk

     

       218
       218
       +
         | "notjunk" -> Types.Keywords.NotJunk

     

       219
       219
       +
         | "phishing" -> Types.Keywords.Phishing

     

       220
       220
       +
         | "important" -> Types.Keywords.Flagged  (* Treat important same as flagged *)

     

       221
       221
       +
         | _ -> 

     

       222
       222
       +
             (* Handle $ prefix for system keywords *)

     

       223
       223
       +
             if String.get flag 0 = '$' then

     

       224
       224
       +
               match flag with

     

       225
       225
       +
               | "$seen" -> Types.Keywords.Seen

     

       226
       226
       +
               | "$draft" -> Types.Keywords.Draft

     

       227
       227
       +
               | "$flagged" -> Types.Keywords.Flagged

     

       228
       228
       +
               | "$answered" -> Types.Keywords.Answered

     

       229
       229
       +
               | "$forwarded" -> Types.Keywords.Forwarded

     

       230
       230
       +
               | "$junk" -> Types.Keywords.Junk

     

       231
       231
       +
               | "$notjunk" -> Types.Keywords.NotJunk

     

       232
       232
       +
               | "$phishing" -> Types.Keywords.Phishing

     

       233
       233
       +
               | "$notify" -> Types.Keywords.Notify

     

       234
       234
       +
               | "$muted" -> Types.Keywords.Muted

     

       235
       235
       +
               | "$followed" -> Types.Keywords.Followed

     

       236
       236
       +
               | "$memo" -> Types.Keywords.Memo

     

       237
       237
       +
               | "$hasmemo" -> Types.Keywords.HasMemo

     

       238
       238
       +
               | "$autosent" -> Types.Keywords.Autosent

     

       239
       239
       +
               | "$unsubscribed" -> Types.Keywords.Unsubscribed

     

       240
       240
       +
               | "$canunsubscribe" -> Types.Keywords.CanUnsubscribe

     

       241
       241
       +
               | "$imported" -> Types.Keywords.Imported

     

       242
       242
       +
               | "$istrusted" -> Types.Keywords.IsTrusted

     

       243
       243
       +
               | "$maskedemail" -> Types.Keywords.MaskedEmail

     

       244
       244
       +
               | "$new" -> Types.Keywords.New

     

       245
       245
       +
               | "$MailFlagBit0" -> Types.Keywords.MailFlagBit0

     

       246
       246
       +
               | "$MailFlagBit1" -> Types.Keywords.MailFlagBit1

     

       247
       247
       +
               | "$MailFlagBit2" -> Types.Keywords.MailFlagBit2

     

       248
       248
       +
               | _ -> Types.Keywords.Custom flag

     

       249
       249
       +
             else

     

       250
       250
       +
               (* Flag without $ prefix is treated as custom *)

     

       251
       251
       +
               Types.Keywords.Custom ("$" ^ flag)

     

       252
       252
       +
       

     

       253
       253
       +
       (* Get standard flags in user-friendly format *)

     

       254
       254
       +
       let get_standard_flags () = [

     

       255
       255
       +
         "seen", "Message has been read";

     

       256
       256
       +
         "draft", "Message is a draft";

     

       257
       257
       +
         "flagged", "Message is flagged/important";

     

       258
       258
       +
         "answered", "Message has been replied to";

     

       259
       259
       +
         "forwarded", "Message has been forwarded";

     

       260
       260
       +
         "junk", "Message is spam/junk";

     

       261
       261
       +
         "notjunk", "Message is explicitly not spam/junk";

     

       262
       262
       +
         "phishing", "Message is suspected phishing";

     

       263
       263
       +
         "notify", "Request notification when replied to";

     

       264
       264
       +
         "muted", "Notifications disabled for this message";

     

       265
       265
       +
         "followed", "Thread is followed for notifications";

     

       266
       266
       +
         "memo", "Has memo/note attached";

     

       267
       267
       +
         "new", "Recently delivered";

     

       268
       268
       +
       ]

     

       269
       269
       +
       

     

       270
       270
       +
       (* Convert color to flag bits *)

     

       271
       271
       +
       let color_to_flags color =

     

       272
       272
       +
         match color with

     

       273
       273
       +
         | `Red -> [Types.Keywords.MailFlagBit0]

     

       274
       274
       +
         | `Orange -> [Types.Keywords.MailFlagBit1]

     

       275
       275
       +
         | `Yellow -> [Types.Keywords.MailFlagBit2]

     

       276
       276
       +
         | `Green -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1]

     

       277
       277
       +
         | `Blue -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit2]

     

       278
       278
       +
         | `Purple -> [Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]

     

       279
       279
       +
         | `Gray -> [Types.Keywords.MailFlagBit0; Types.Keywords.MailFlagBit1; Types.Keywords.MailFlagBit2]

     

       280
       280
       +
         | `None -> []

     

       281
       281
       +
       

     

       282
       282
       +
       (* Convert flag bits to color *)

     

       283
       283
       +
       let flags_to_color flags =

     

       284
       284
       +
         let has_bit0 = List.exists ((=) Types.Keywords.MailFlagBit0) flags in

     

       285
       285
       +
         let has_bit1 = List.exists ((=) Types.Keywords.MailFlagBit1) flags in

     

       286
       286
       +
         let has_bit2 = List.exists ((=) Types.Keywords.MailFlagBit2) flags in

     

       287
       287
       +
         

     

       288
       288
       +
         match (has_bit0, has_bit1, has_bit2) with

     

       289
       289
       +
         | (true, false, false) -> Some `Red

     

       290
       290
       +
         | (false, true, false) -> Some `Orange

     

       291
       291
       +
         | (false, false, true) -> Some `Yellow

     

       292
       292
       +
         | (true, true, false) -> Some `Green

     

       293
       293
       +
         | (true, false, true) -> Some `Blue

     

       294
       294
       +
         | (false, true, true) -> Some `Purple

     

       295
       295
       +
         | (true, true, true) -> Some `Gray

     

       296
       296
       +
         | (false, false, false) -> None

     

       297
       297
       +
       

     

       298
       298
       +
       (* Filter builder - create JMAP filter from command line args *)

     

       299
       299
       +
       let build_filter account_id mailbox_id args =

     

       300
       300
       +
         let open Email_filter in

     

       301
       301
       +
         let filters = [] in

     

       302
       302
       +
         

     

       303
       303
       +
         (* Add filter conditions based on command-line args *)

     

       304
       304
       +
         let filters = match args.query with 

     

       305
       305
       +
           | "" -> filters 

     

       306
       306
       +
           | query -> create_fulltext_filter query :: filters 

     

       307
       307
       +
         in

     

       308
       308
       +
         

     

       309
       309
       +
         let filters = match args.from with

     

       310
       310
       +
           | None -> filters

     

       311
       311
       +
           | Some sender -> from sender :: filters

     

       312
       312
       +
         in

     

       313
       313
       +
         

     

       314
       314
       +
         let filters = 

     

       315
       315
       +
           if args.days > 0 then 

     

       316
       316
       +
             after (days_ago_date args.days) :: filters

     

       317
       317
       +
           else 

     

       318
       318
       +
             filters

     

       319
       319
       +
         in

     

       320
       320
       +
         

     

       321
       321
       +
         let filters = match mailbox_id with

     

       322
       322
       +
           | None -> filters

     

       323
       323
       +
           | Some id -> in_mailbox id :: filters

     

       324
       324
       +
         in

     

       325
       325
       +
         

     

       326
       326
       +
         let filters = match args.has_flag with

     

       327
       327
       +
           | None -> filters

     

       328
       328
       +
           | Some flag -> 

     

       329
       329
       +
               let kw = flag_to_keyword flag in

     

       330
       330
       +
               has_keyword kw :: filters

     

       331
       331
       +
         in

     

       332
       332
       +
         

     

       333
       333
       +
         let filters = match args.missing_flag with

     

       334
       334
       +
           | None -> filters

     

       335
       335
       +
           | Some flag ->

     

       336
       336
       +
               let kw = flag_to_keyword flag in

     

       337
       337
       +
               not_has_keyword kw :: filters

     

       338
       338
       +
         in

     

       339
       339
       +
         

     

       340
       340
       +
         (* Combine all filters with AND *)

     

       341
       341
       +
         match filters with

     

       342
       342
       +
         | [] -> Filter.condition (`Assoc [])  (* Empty filter *)

     

       343
       343
       +
         | [f] -> f

     

       344
       344
       +
         | filters -> Filter.and_ filters

     

       345
       345
       +
       

     

       346
       346
       +
       (* Display email flag information *)

     

       347
       347
       +
       let display_email_flags emails verbose =

     

       348
       348
       +
         Printf.printf "Emails and their flags:\n\n";

     

       349
       349
       +
         

     

       350
       350
       +
         emails |> List.iteri (fun i email ->

     

       351
       351
       +
           let id = Option.value (Types.Email.id email) ~default:"(unknown)" in

     

       352
       352
       +
           let subject = Option.value (Types.Email.subject email) ~default:"(no subject)" in

     

       353
       353
       +
           

     

       354
       354
       +
           let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       355
       355
       +
           let from = match from_list with

     

       356
       356
       +
             | addr :: _ -> Types.Email_address.email addr

     

       357
       357
       +
             | [] -> "(unknown)"

     

       358
       358
       +
           in

     

       359
       359
       +
           

     

       360
       360
       +
           let date = match Types.Email.received_at email with

     

       361
       361
       +
             | Some d -> String.sub (ISO8601.string_of_datetime (Unix.gmtime d)) 0 19

     

       362
       362
       +
             | None -> "(unknown)"

     

       363
       363
       +
           in

     

       364
       364
       +
           

     

       365
       365
       +
           (* Get all keywords/flags *)

     

       366
       366
       +
           let keywords = match Types.Email.keywords email with

     

       367
       367
       +
             | Some kw -> kw

     

       368
       368
       +
             | None -> []

     

       369
       369
       +
           in

     

       370
       370
       +
           

     

       371
       371
       +
           (* Format keywords for display *)

     

       372
       372
       +
           let flag_strs = keywords |> List.map (fun kw ->

     

       373
       373
       +
             match kw with

     

       374
       374
       +
             | Types.Keywords.Draft -> "$draft"

     

       375
       375
       +
             | Types.Keywords.Seen -> "$seen"

     

       376
       376
       +
             | Types.Keywords.Flagged -> "$flagged"

     

       377
       377
       +
             | Types.Keywords.Answered -> "$answered"

     

       378
       378
       +
             | Types.Keywords.Forwarded -> "$forwarded"

     

       379
       379
       +
             | Types.Keywords.Phishing -> "$phishing"

     

       380
       380
       +
             | Types.Keywords.Junk -> "$junk"

     

       381
       381
       +
             | Types.Keywords.NotJunk -> "$notjunk"

     

       382
       382
       +
             | Types.Keywords.Custom c -> c

     

       383
       383
       +
             | Types.Keywords.Notify -> "$notify"

     

       384
       384
       +
             | Types.Keywords.Muted -> "$muted"

     

       385
       385
       +
             | Types.Keywords.Followed -> "$followed"

     

       386
       386
       +
             | Types.Keywords.Memo -> "$memo" 

     

       387
       387
       +
             | Types.Keywords.HasMemo -> "$hasmemo"

     

       388
       388
       +
             | Types.Keywords.Autosent -> "$autosent"

     

       389
       389
       +
             | Types.Keywords.Unsubscribed -> "$unsubscribed"

     

       390
       390
       +
             | Types.Keywords.CanUnsubscribe -> "$canunsubscribe"

     

       391
       391
       +
             | Types.Keywords.Imported -> "$imported"

     

       392
       392
       +
             | Types.Keywords.IsTrusted -> "$istrusted"

     

       393
       393
       +
             | Types.Keywords.MaskedEmail -> "$maskedemail"

     

       394
       394
       +
             | Types.Keywords.New -> "$new"

     

       395
       395
       +
             | Types.Keywords.MailFlagBit0 -> "$MailFlagBit0"

     

       396
       396
       +
             | Types.Keywords.MailFlagBit1 -> "$MailFlagBit1" 

     

       397
       397
       +
             | Types.Keywords.MailFlagBit2 -> "$MailFlagBit2"

     

       398
       398
       +
           ) in

     

       399
       399
       +
           

     

       400
       400
       +
           Printf.printf "Email %d: %s\n" (i + 1) subject;

     

       401
       401
       +
           Printf.printf "  ID:    %s\n" id;

     

       402
       402
       +
           

     

       403
       403
       +
           if verbose then begin

     

       404
       404
       +
             Printf.printf "  From:  %s\n" from;

     

       405
       405
       +
             Printf.printf "  Date:  %s\n" date;

     

       406
       406
       +
           end;

     

       407
       407
       +
           

     

       408
       408
       +
           (* Show color if applicable *)

     

       409
       409
       +
           begin match flags_to_color keywords with

     

       410
       410
       +
           | Some color ->

     

       411
       411
       +
               let color_name = match color with

     

       412
       412
       +
                 | `Red -> "Red"

     

       413
       413
       +
                 | `Orange -> "Orange"

     

       414
       414
       +
                 | `Yellow -> "Yellow" 

     

       415
       415
       +
                 | `Green -> "Green"

     

       416
       416
       +
                 | `Blue -> "Blue"

     

       417
       417
       +
                 | `Purple -> "Purple"

     

       418
       418
       +
                 | `Gray -> "Gray"

     

       419
       419
       +
               in

     

       420
       420
       +
               Printf.printf "  Color: %s\n" color_name

     

       421
       421
       +
           | None -> ()

     

       422
       422
       +
           end;

     

       423
       423
       +
           

     

       424
       424
       +
           Printf.printf "  Flags: %s\n\n" 

     

       425
       425
       +
             (if flag_strs = [] then "(none)" else String.concat ", " flag_strs)

     

       426
       426
       +
         );

     

       427
       427
       +
         

     

       428
       428
       +
         if List.length emails = 0 then

     

       429
       429
       +
           Printf.printf "No emails found matching criteria.\n"

     

       430
       430
       +
       

     

       431
       431
       +
       (* Command implementation *)

     

       432
       432
       +
       let flag_command host user _password list add_flag remove_flag query from days 

     

       433
       433
       +
                         mailbox ids has_flag missing_flag limit dry_run color verbose : int =

     

       434
       434
       +
         (* Pack arguments into a record for easier passing *)

     

       435
       435
       +
         let _args : flag_manager_args = {

     

       436
       436
       +
           list; add_flag; remove_flag; query; from; days; mailbox; 

     

       437
       437
       +
           ids; has_flag; missing_flag; limit; dry_run; color; verbose

     

       438
       438
       +
         } in

     

       439
       439
       +
         

     

       440
       440
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       441
       441
       +
         Printf.printf "JMAP Flag Manager\n";

     

       442
       442
       +
         Printf.printf "Server: %s\n" host;

     

       443
       443
       +
         Printf.printf "User: %s\n\n" user;

     

       444
       444
       +
         

     

       445
       445
       +
         if list then

     

       446
       446
       +
           Printf.printf "Listing emails with their flags...\n\n"

     

       447
       447
       +
         else begin

     

       448
       448
       +
           if add_flag <> None then

     

       449
       449
       +
             Printf.printf "Adding flag: %s\n" (Option.get add_flag);

     

       450
       450
       +
           

     

       451
       451
       +
           if remove_flag <> None then

     

       452
       452
       +
             Printf.printf "Removing flag: %s\n" (Option.get remove_flag);

     

       453
       453
       +
           

     

       454
       454
       +
           if color <> None then

     

       455
       455
       +
             let color_name = match Option.get color with

     

       456
       456
       +
               | `Red -> "Red"

     

       457
       457
       +
               | `Orange -> "Orange"

     

       458
       458
       +
               | `Yellow -> "Yellow" 

     

       459
       459
       +
               | `Green -> "Green"

     

       460
       460
       +
               | `Blue -> "Blue"

     

       461
       461
       +
               | `Purple -> "Purple"

     

       462
       462
       +
               | `Gray -> "Gray"

     

       463
       463
       +
               | `None -> "None"

     

       464
       464
       +
             in

     

       465
       465
       +
             Printf.printf "Setting color: %s\n" color_name;

     

       466
       466
       +
         end;

     

       467
       467
       +
         

     

       468
       468
       +
         if query <> "" then

     

       469
       469
       +
           Printf.printf "Filtering by query: %s\n" query;

     

       470
       470
       +
         

     

       471
       471
       +
         if from <> None then

     

       472
       472
       +
           Printf.printf "Filtering by sender: %s\n" (Option.get from);

     

       473
       473
       +
         

     

       474
       474
       +
         if mailbox <> None then

     

       475
       475
       +
           Printf.printf "Filtering by mailbox: %s\n" (Option.get mailbox);

     

       476
       476
       +
         

     

       477
       477
       +
         if ids <> [] then

     

       478
       478
       +
           Printf.printf "Operating on specific email IDs: %s\n" 

     

       479
       479
       +
             (String.concat ", " ids);

     

       480
       480
       +
         

     

       481
       481
       +
         if has_flag <> None then

     

       482
       482
       +
           Printf.printf "Filtering to emails with flag: %s\n" (Option.get has_flag);

     

       483
       483
       +
         

     

       484
       484
       +
         if missing_flag <> None then

     

       485
       485
       +
           Printf.printf "Filtering to emails without flag: %s\n" (Option.get missing_flag);

     

       486
       486
       +
         

     

       487
       487
       +
         Printf.printf "Limiting to %d emails\n" limit;

     

       488
       488
       +
         

     

       489
       489
       +
         if dry_run then

     

       490
       490
       +
           Printf.printf "DRY RUN MODE - No changes will be made\n";

     

       491
       491
       +
         

     

       492
       492
       +
         Printf.printf "\n";

     

       493
       493
       +
         

     

       494
       494
       +
         (* This is where the actual JMAP calls would happen, like:

     

       495
       495
       +
         

     

       496
       496
       +
         let manage_flags () =

     

       497
       497
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       498
       498
       +
             ~host ~username:user ~password 

     

       499
       499
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       500
       500
       +
           

     

       501
       501
       +
           (* Get primary account ID *)

     

       502
       502
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       503
       503
       +
             | Ok id -> id

     

       504
       504
       +
             | Error _ -> failwith "No mail account found"

     

       505
       505
       +
           in

     

       506
       506
       +
           

     

       507
       507
       +
           (* Resolve mailbox name to ID if specified *)

     

       508
       508
       +
           let* mailbox_id_opt = match args.mailbox with

     

       509
       509
       +
             | None -> Lwt.return None

     

       510
       510
       +
             | Some name ->

     

       511
       511
       +
                 (* This would use Mailbox/query and Mailbox/get to resolve the name *)

     

       512
       512
       +
                 ...

     

       513
       513
       +
           in

     

       514
       514
       +
           

     

       515
       515
       +
           (* Find emails to operate on *)

     

       516
       516
       +
           let* emails = 

     

       517
       517
       +
             if args.ids <> [] then

     

       518
       518
       +
               (* Get emails by ID *)

     

       519
       519
       +
               let* result = Email.get ctx

     

       520
       520
       +
                 ~account_id

     

       521
       521
       +
                 ~ids:args.ids

     

       522
       522
       +
                 ~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in

     

       523
       523
       +
               

     

       524
       524
       +
               match result with

     

       525
       525
       +
               | Error err ->

     

       526
       526
       +
                   Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       527
       527
       +
                   Lwt.return []

     

       528
       528
       +
               | Ok (_, emails) -> Lwt.return emails

     

       529
       529
       +
             else

     

       530
       530
       +
               (* Find emails by query *)

     

       531
       531
       +
               let filter = build_filter account_id mailbox_id_opt args in

     

       532
       532
       +
               

     

       533
       533
       +
               let* result = Email.query ctx

     

       534
       534
       +
                 ~account_id

     

       535
       535
       +
                 ~filter

     

       536
       536
       +
                 ~sort:[Email_sort.received_newest_first ()]

     

       537
       537
       +
                 ~limit:args.limit

     

       538
       538
       +
                 ~properties:["id"] in

     

       539
       539
       +
               

     

       540
       540
       +
               match result with

     

       541
       541
       +
               | Error err ->

     

       542
       542
       +
                   Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       543
       543
       +
                   Lwt.return []

     

       544
       544
       +
               | Ok (ids, _) ->

     

       545
       545
       +
                   (* Get full email objects for the matching IDs *)

     

       546
       546
       +
                   let* result = Email.get ctx

     

       547
       547
       +
                     ~account_id

     

       548
       548
       +
                     ~ids

     

       549
       549
       +
                     ~properties:["id"; "subject"; "from"; "receivedAt"; "keywords"] in

     

       550
       550
       +
                   

     

       551
       551
       +
                   match result with

     

       552
       552
       +
                   | Error err ->

     

       553
       553
       +
                       Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       554
       554
       +
                       Lwt.return []

     

       555
       555
       +
                   | Ok (_, emails) -> Lwt.return emails

     

       556
       556
       +
           in

     

       557
       557
       +
           

     

       558
       558
       +
           (* Just list the emails with their flags *)

     

       559
       559
       +
           if args.list then

     

       560
       560
       +
             display_email_flags emails args.verbose;

     

       561
       561
       +
             Lwt.return_unit

     

       562
       562
       +
           else if List.length emails = 0 then

     

       563
       563
       +
             Printf.printf "No emails found matching criteria.\n";

     

       564
       564
       +
             Lwt.return_unit

     

       565
       565
       +
           else

     

       566
       566
       +
             (* Perform flag operations *)

     

       567
       567
       +
             let ids = emails |> List.filter_map Types.Email.id in

     

       568
       568
       +
             

     

       569
       569
       +
             if args.dry_run then

     

       570
       570
       +
               display_email_flags emails args.verbose;

     

       571
       571
       +
               Lwt.return_unit

     

       572
       572
       +
             else

     

       573
       573
       +
               (* Create patch object *)

     

       574
       574
       +
               let make_patch () =

     

       575
       575
       +
                 let add_keywords = ref [] in

     

       576
       576
       +
                 let remove_keywords = ref [] in

     

       577
       577
       +
                 

     

       578
       578
       +
                 (* Handle add flag *)

     

       579
       579
       +
                 Option.iter (fun flag ->

     

       580
       580
       +
                   let keyword = flag_to_keyword flag in

     

       581
       581
       +
                   add_keywords := keyword :: !add_keywords

     

       582
       582
       +
                 ) args.add_flag;

     

       583
       583
       +
                 

     

       584
       584
       +
                 (* Handle remove flag *)

     

       585
       585
       +
                 Option.iter (fun flag ->

     

       586
       586
       +
                   let keyword = flag_to_keyword flag in

     

       587
       587
       +
                   remove_keywords := keyword :: !remove_keywords

     

       588
       588
       +
                 ) args.remove_flag;

     

       589
       589
       +
                 

     

       590
       590
       +
                 (* Handle color *)

     

       591
       591
       +
                 Option.iter (fun color ->

     

       592
       592
       +
                   (* First remove all color bits *)

     

       593
       593
       +
                   remove_keywords := Types.Keywords.MailFlagBit0 :: !remove_keywords;

     

       594
       594
       +
                   remove_keywords := Types.Keywords.MailFlagBit1 :: !remove_keywords;

     

       595
       595
       +
                   remove_keywords := Types.Keywords.MailFlagBit2 :: !remove_keywords;

     

       596
       596
       +
                   

     

       597
       597
       +
                   (* Then add the right combination for the requested color *)

     

       598
       598
       +
                   if color <> `None then begin

     

       599
       599
       +
                     let color_flags = color_to_flags color in

     

       600
       600
       +
                     add_keywords := color_flags @ !add_keywords

     

       601
       601
       +
                   end

     

       602
       602
       +
                 ) args.color;

     

       603
       603
       +
                 

     

       604
       604
       +
                 Email.make_patch

     

       605
       605
       +
                   ~add_keywords:!add_keywords

     

       606
       606
       +
                   ~remove_keywords:!remove_keywords

     

       607
       607
       +
                   ()

     

       608
       608
       +
               in

     

       609
       609
       +
               

     

       610
       610
       +
               let patch = make_patch () in

     

       611
       611
       +
               

     

       612
       612
       +
               let* result = Email.update ctx

     

       613
       613
       +
                 ~account_id

     

       614
       614
       +
                 ~ids

     

       615
       615
       +
                 ~update_each:(fun _ -> patch) in

     

       616
       616
       +
               

     

       617
       617
       +
               match result with

     

       618
       618
       +
               | Error err ->

     

       619
       619
       +
                   Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err);

     

       620
       620
       +
                   Lwt.return_unit

     

       621
       621
       +
               | Ok updated ->

     

       622
       622
       +
                   Printf.printf "Successfully updated %d emails.\n" (List.length updated);

     

       623
       623
       +
                   Lwt.return_unit

     

       624
       624
       +
         *)

     

       625
       625
       +
         

     

       626
       626
       +
         if list then begin

     

       627
       627
       +
           (* Simulate having found a few emails *)

     

       628
       628
       +
           let count = 3 in

     

       629
       629
       +
           Printf.printf "Found %d matching emails:\n\n" count;

     

       630
       630
       +
           Printf.printf "Email 1: Meeting Agenda\n";

     

       631
       631
       +
           Printf.printf "  ID:    email123\n";

     

       632
       632
       +
           if verbose then begin

     

       633
       633
       +
             Printf.printf "  From:  alice@example.com\n";

     

       634
       634
       +
             Printf.printf "  Date:  2023-04-15 09:30:00\n";

     

       635
       635
       +
           end;

     

       636
       636
       +
           Printf.printf "  Flags: $seen, $flagged, $answered\n\n";

     

       637
       637
       +
           

     

       638
       638
       +
           Printf.printf "Email 2: Project Update\n";

     

       639
       639
       +
           Printf.printf "  ID:    email124\n";

     

       640
       640
       +
           if verbose then begin

     

       641
       641
       +
             Printf.printf "  From:  bob@example.com\n";

     

       642
       642
       +
             Printf.printf "  Date:  2023-04-16 14:45:00\n";

     

       643
       643
       +
           end;

     

       644
       644
       +
           Printf.printf "  Color: Red\n";

     

       645
       645
       +
           Printf.printf "  Flags: $seen, $MailFlagBit0\n\n";

     

       646
       646
       +
           

     

       647
       647
       +
           Printf.printf "Email 3: Weekly Newsletter\n";

     

       648
       648
       +
           Printf.printf "  ID:    email125\n";

     

       649
       649
       +
           if verbose then begin

     

       650
       650
       +
             Printf.printf "  From:  newsletter@example.com\n";

     

       651
       651
       +
             Printf.printf "  Date:  2023-04-17 08:15:00\n";

     

       652
       652
       +
           end;

     

       653
       653
       +
           Printf.printf "  Flags: $seen, $notjunk\n\n";

     

       654
       654
       +
         end else if add_flag <> None || remove_flag <> None || color <> None then begin

     

       655
       655
       +
           Printf.printf "Would modify %d emails:\n" 2;

     

       656
       656
       +
           if dry_run then

     

       657
       657
       +
             Printf.printf "(Dry run mode - no changes made)\n\n"

     

       658
       658
       +
           else

     

       659
       659
       +
             Printf.printf "Changes applied successfully\n\n";

     

       660
       660
       +
         end;

     

       661
       661
       +
         

     

       662
       662
       +
         (* List standard flags if no other actions specified *)

     

       663
       663
       +
         if not list && add_flag = None && remove_flag = None && color = None then begin

     

       664
       664
       +
           Printf.printf "Standard flags:\n";

     

       665
       665
       +
           get_standard_flags() |> List.iter (fun (flag, desc) ->

     

       666
       666
       +
             Printf.printf "  $%-12s %s\n" flag desc

     

       667
       667
       +
           );

     

       668
       668
       +
           

     

       669
       669
       +
           Printf.printf "\nColor flags:\n";

     

       670
       670
       +
           Printf.printf "  $MailFlagBit0    Red\n";

     

       671
       671
       +
           Printf.printf "  $MailFlagBit1    Orange\n";

     

       672
       672
       +
           Printf.printf "  $MailFlagBit2    Yellow\n";

     

       673
       673
       +
           Printf.printf "  $MailFlagBit0+1  Green\n";

     

       674
       674
       +
           Printf.printf "  $MailFlagBit0+2  Blue\n";

     

       675
       675
       +
           Printf.printf "  $MailFlagBit1+2  Purple\n";

     

       676
       676
       +
           Printf.printf "  $MailFlagBit0+1+2 Gray\n";

     

       677
       677
       +
         end;

     

       678
       678
       +
         

     

       679
       679
       +
         (* Since we're only type checking, we'll exit with success *)

     

       680
       680
       +
         0

     

       681
       681
       +
       

     

       682
       682
       +
       (* Command definition *)

     

       683
       683
       +
       let flag_cmd =

     

       684
       684
       +
         let doc = "manage email flags using JMAP" in

     

       685
       685
       +
         let man = [

     

       686
       686
       +
           `S Manpage.s_description;

     

       687
       687
       +
           `P "Lists, adds, and removes flags (keywords) from emails using JMAP.";

     

       688
       688
       +
           `P "Demonstrates JMAP's flag/keyword management capabilities.";

     

       689
       689
       +
           `S Manpage.s_examples;

     

       690
       690
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";

     

       691
       691
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --add flagged --from boss@example.com";

     

       692
       692
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --color red --mailbox Inbox --has-flag seen --missing-flag flagged";

     

       693
       693
       +
         ] in

     

       694
       694
       +
         

     

       695
       695
       +
         let cmd =

     

       696
       696
       +
           Cmd.v

     

       697
       697
       +
             (Cmd.info "jmap-flag-manager" ~version:"1.0" ~doc ~man)

     

       698
       698
       +
             Term.(const flag_command $ host_arg $ user_arg $ password_arg $ 

     

       699
       699
       +
                   list_arg $ add_flag_arg $ remove_flag_arg $ query_arg $ 

     

       700
       700
       +
                   from_arg $ days_arg $ mailbox_arg $ ids_arg $ has_flag_arg $ 

     

       701
       701
       +
                   missing_flag_arg $ limit_arg $ dry_run_arg $ color_arg $ verbose_arg)

     

       702
       702
       +
         in

     

       703
       703
       +
         cmd

     

       704
       704
       +
       

     

       705
       705
       +
       (* Main entry point *)

     

       706
       706
       +
       let () = exit (Cmd.eval' flag_cmd)

+620

bin/jmap_identity_monitor.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_identity_monitor.ml - A tool for monitoring email delivery status

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's identity and submission tracking capabilities,

     

       5
       5
       +
        * allowing users to monitor email delivery status and manage email identities.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       open Jmap.Wire

     

       15
       15
       +
       open Jmap.Methods

     

       16
       16
       +
       open Jmap_email

     

       17
       17
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       18
       18
       +
       

     

       19
       19
       +
       (* Dummy Unix module for type checking *)

     

       20
       20
       +
       module Unix = struct

     

       21
       21
       +
         type tm = {

     

       22
       22
       +
           tm_sec : int;

     

       23
       23
       +
           tm_min : int;

     

       24
       24
       +
           tm_hour : int;

     

       25
       25
       +
           tm_mday : int;

     

       26
       26
       +
           tm_mon : int;

     

       27
       27
       +
           tm_year : int;

     

       28
       28
       +
           tm_wday : int;

     

       29
       29
       +
           tm_yday : int;

     

       30
       30
       +
           tm_isdst : bool

     

       31
       31
       +
         }

     

       32
       32
       +
         

     

       33
       33
       +
         let time () = 0.0

     

       34
       34
       +
         let gettimeofday () = 0.0

     

       35
       35
       +
         let mktime tm = (0.0, tm)

     

       36
       36
       +
         let gmtime _time = {

     

       37
       37
       +
           tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       38
       38
       +
           tm_mday = 1; tm_mon = 0; tm_year = 120;

     

       39
       39
       +
           tm_wday = 0; tm_yday = 0; tm_isdst = false;

     

       40
       40
       +
         }

     

       41
       41
       +
         

     

       42
       42
       +
         (* JMAP connection function - would be in a real implementation *)

     

       43
       43
       +
         let connect ~host ~username ~password ?auth_method () =

     

       44
       44
       +
           failwith "Not implemented"

     

       45
       45
       +
       end

     

       46
       46
       +
       

     

       47
       47
       +
       (* Dummy ISO8601 module *)

     

       48
       48
       +
       module ISO8601 = struct

     

       49
       49
       +
         let string_of_datetime _tm = "2023-01-01T00:00:00Z"

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** Email submission and delivery status types *)

     

       53
       53
       +
       type email_envelope_address = {

     

       54
       54
       +
         env_addr_email : string;

     

       55
       55
       +
         env_addr_parameters : (string * string) list;

     

       56
       56
       +
       }

     

       57
       57
       +
       

     

       58
       58
       +
       type email_envelope = {

     

       59
       59
       +
         env_mail_from : email_envelope_address;

     

       60
       60
       +
         env_rcpt_to : email_envelope_address list;

     

       61
       61
       +
       }

     

       62
       62
       +
       

     

       63
       63
       +
       type email_delivery_status = {

     

       64
       64
       +
         delivery_smtp_reply : string;

     

       65
       65
       +
         delivery_delivered : [`Queued | `Yes | `No | `Unknown];

     

       66
       66
       +
         delivery_displayed : [`Yes | `Unknown];

     

       67
       67
       +
       }

     

       68
       68
       +
       

     

       69
       69
       +
       type email_submission = {

     

       70
       70
       +
         email_sub_id : string;

     

       71
       71
       +
         email_id : string;

     

       72
       72
       +
         thread_id : string;

     

       73
       73
       +
         identity_id : string;

     

       74
       74
       +
         send_at : float;

     

       75
       75
       +
         undo_status : [`Pending | `Final | `Canceled];

     

       76
       76
       +
         envelope : email_envelope option;

     

       77
       77
       +
         delivery_status : (string, email_delivery_status) Hashtbl.t option;

     

       78
       78
       +
         dsn_blob_ids : string list;

     

       79
       79
       +
         mdn_blob_ids : string list;

     

       80
       80
       +
       }

     

       81
       81
       +
       

     

       82
       82
       +
       (** Dummy Email_address module to replace Jmap_email_types.Email_address *)

     

       83
       83
       +
       module Email_address = struct

     

       84
       84
       +
         type t = string

     

       85
       85
       +
         let email addr = "user@example.com"

     

       86
       86
       +
       end

     

       87
       87
       +
       

     

       88
       88
       +
       (** Dummy Identity module *)

     

       89
       89
       +
       module Identity = struct

     

       90
       90
       +
         type t = {

     

       91
       91
       +
           id : string;

     

       92
       92
       +
           name : string;

     

       93
       93
       +
           email : string;

     

       94
       94
       +
           reply_to : Email_address.t list option;

     

       95
       95
       +
           bcc : Email_address.t list option;

     

       96
       96
       +
           text_signature : string;

     

       97
       97
       +
           html_signature : string;

     

       98
       98
       +
           may_delete : bool;

     

       99
       99
       +
         }

     

       100
       100
       +
         

     

       101
       101
       +
         let id identity = identity.id

     

       102
       102
       +
         let name identity = identity.name

     

       103
       103
       +
         let email identity = identity.email

     

       104
       104
       +
         let reply_to identity = identity.reply_to

     

       105
       105
       +
         let bcc identity = identity.bcc

     

       106
       106
       +
         let text_signature identity = identity.text_signature

     

       107
       107
       +
         let html_signature identity = identity.html_signature

     

       108
       108
       +
         let may_delete identity = identity.may_delete

     

       109
       109
       +
       end

     

       110
       110
       +
       

     

       111
       111
       +
       (** Identity monitor args type *)

     

       112
       112
       +
       type identity_monitor_args = {

     

       113
       113
       +
         list_identities : bool;

     

       114
       114
       +
         show_identity : string option;

     

       115
       115
       +
         create_identity : string option;

     

       116
       116
       +
         identity_name : string option;

     

       117
       117
       +
         reply_to : string option;

     

       118
       118
       +
         signature : string option;

     

       119
       119
       +
         html_signature : string option;

     

       120
       120
       +
         list_submissions : bool;

     

       121
       121
       +
         show_submission : string option;

     

       122
       122
       +
         track_submission : string option;

     

       123
       123
       +
         pending_only : bool;

     

       124
       124
       +
         query : string option;

     

       125
       125
       +
         days : int;

     

       126
       126
       +
         limit : int;

     

       127
       127
       +
         cancel_submission : string option;

     

       128
       128
       +
         format : [`Summary | `Detailed | `Json | `StatusOnly];

     

       129
       129
       +
       }

     

       130
       130
       +
       

     

       131
       131
       +
       (** Command-line arguments **)

     

       132
       132
       +
       

     

       133
       133
       +
       let host_arg =

     

       134
       134
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       135
       135
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       136
       136
       +
       

     

       137
       137
       +
       let user_arg =

     

       138
       138
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       139
       139
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       140
       140
       +
       

     

       141
       141
       +
       let password_arg =

     

       142
       142
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       143
       143
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       144
       144
       +
       

     

       145
       145
       +
       (* Commands *)

     

       146
       146
       +
       

     

       147
       147
       +
       (* Identity-related commands *)

     

       148
       148
       +
       let list_identities_arg =

     

       149
       149
       +
         Arg.(value & flag & info ["list-identities"] ~doc:"List all email identities")

     

       150
       150
       +
       

     

       151
       151
       +
       let show_identity_arg =

     

       152
       152
       +
         Arg.(value & opt (some string) None & info ["show-identity"] 

     

       153
       153
       +
              ~docv:"ID" ~doc:"Show details for a specific identity")

     

       154
       154
       +
       

     

       155
       155
       +
       let create_identity_arg =

     

       156
       156
       +
         Arg.(value & opt (some string) None & info ["create-identity"] 

     

       157
       157
       +
              ~docv:"EMAIL" ~doc:"Create a new identity with the specified email address")

     

       158
       158
       +
       

     

       159
       159
       +
       let identity_name_arg =

     

       160
       160
       +
         Arg.(value & opt (some string) None & info ["name"] 

     

       161
       161
       +
              ~docv:"NAME" ~doc:"Display name for the identity (when creating)")

     

       162
       162
       +
       

     

       163
       163
       +
       let reply_to_arg =

     

       164
       164
       +
         Arg.(value & opt (some string) None & info ["reply-to"] 

     

       165
       165
       +
              ~docv:"EMAIL" ~doc:"Reply-to address for the identity (when creating)")

     

       166
       166
       +
       

     

       167
       167
       +
       let signature_arg =

     

       168
       168
       +
         Arg.(value & opt (some string) None & info ["signature"] 

     

       169
       169
       +
              ~docv:"SIGNATURE" ~doc:"Text signature for the identity (when creating)")

     

       170
       170
       +
       

     

       171
       171
       +
       let html_signature_arg =

     

       172
       172
       +
         Arg.(value & opt (some string) None & info ["html-signature"] 

     

       173
       173
       +
              ~docv:"HTML" ~doc:"HTML signature for the identity (when creating)")

     

       174
       174
       +
       

     

       175
       175
       +
       (* Submission-related commands *)

     

       176
       176
       +
       let list_submissions_arg =

     

       177
       177
       +
         Arg.(value & flag & info ["list-submissions"] ~doc:"List recent email submissions")

     

       178
       178
       +
       

     

       179
       179
       +
       let show_submission_arg =

     

       180
       180
       +
         Arg.(value & opt (some string) None & info ["show-submission"] 

     

       181
       181
       +
              ~docv:"ID" ~doc:"Show details for a specific submission")

     

       182
       182
       +
       

     

       183
       183
       +
       let track_submission_arg =

     

       184
       184
       +
         Arg.(value & opt (some string) None & info ["track"] 

     

       185
       185
       +
              ~docv:"ID" ~doc:"Track delivery status for a specific submission")

     

       186
       186
       +
       

     

       187
       187
       +
       let pending_only_arg =

     

       188
       188
       +
         Arg.(value & flag & info ["pending-only"] ~doc:"Show only pending submissions")

     

       189
       189
       +
       

     

       190
       190
       +
       let query_arg =

     

       191
       191
       +
         Arg.(value & opt (some string) None & info ["query"] 

     

       192
       192
       +
              ~docv:"QUERY" ~doc:"Search for submissions containing text in associated email")

     

       193
       193
       +
       

     

       194
       194
       +
       let days_arg =

     

       195
       195
       +
         Arg.(value & opt int 7 & info ["days"] 

     

       196
       196
       +
              ~docv:"DAYS" ~doc:"Limit to submissions from the past N days")

     

       197
       197
       +
       

     

       198
       198
       +
       let limit_arg =

     

       199
       199
       +
         Arg.(value & opt int 20 & info ["limit"] 

     

       200
       200
       +
              ~docv:"N" ~doc:"Maximum number of results to display")

     

       201
       201
       +
       

     

       202
       202
       +
       let cancel_submission_arg =

     

       203
       203
       +
         Arg.(value & opt (some string) None & info ["cancel"] 

     

       204
       204
       +
              ~docv:"ID" ~doc:"Cancel a pending email submission")

     

       205
       205
       +
       

     

       206
       206
       +
       let format_arg =

     

       207
       207
       +
         Arg.(value & opt (enum [

     

       208
       208
       +
           "summary", `Summary;

     

       209
       209
       +
           "detailed", `Detailed;

     

       210
       210
       +
           "json", `Json;

     

       211
       211
       +
           "status-only", `StatusOnly;

     

       212
       212
       +
         ]) `Summary & info ["format"] ~docv:"FORMAT" ~doc:"Output format")

     

       213
       213
       +
       

     

       214
       214
       +
       (** Main functionality **)

     

       215
       215
       +
       

     

       216
       216
       +
       (* Format an identity for display *)

     

       217
       217
       +
       let format_identity identity format =

     

       218
       218
       +
         match format with

     

       219
       219
       +
         | `Summary ->

     

       220
       220
       +
             let id = Identity.id identity in

     

       221
       221
       +
             let name = Identity.name identity in

     

       222
       222
       +
             let email = Identity.email identity in

     

       223
       223
       +
             Printf.printf "%s: %s <%s>\n" id name email

     

       224
       224
       +
         

     

       225
       225
       +
         | `Detailed ->

     

       226
       226
       +
             let id = Identity.id identity in

     

       227
       227
       +
             let name = Identity.name identity in

     

       228
       228
       +
             let email = Identity.email identity in

     

       229
       229
       +
             

     

       230
       230
       +
             let reply_to = match Identity.reply_to identity with

     

       231
       231
       +
               | Some addresses -> addresses 

     

       232
       232
       +
                   |> List.map (fun addr -> Email_address.email addr)

     

       233
       233
       +
                   |> String.concat ", "

     

       234
       234
       +
               | None -> "(none)"

     

       235
       235
       +
             in

     

       236
       236
       +
             

     

       237
       237
       +
             let bcc = match Identity.bcc identity with

     

       238
       238
       +
               | Some addresses -> addresses 

     

       239
       239
       +
                   |> List.map (fun addr -> Email_address.email addr)

     

       240
       240
       +
                   |> String.concat ", "

     

       241
       241
       +
               | None -> "(none)"

     

       242
       242
       +
             in

     

       243
       243
       +
             

     

       244
       244
       +
             let may_delete = if Identity.may_delete identity then "Yes" else "No" in

     

       245
       245
       +
             

     

       246
       246
       +
             Printf.printf "Identity: %s\n" id;

     

       247
       247
       +
             Printf.printf "  Name:       %s\n" name;

     

       248
       248
       +
             Printf.printf "  Email:      %s\n" email;

     

       249
       249
       +
             Printf.printf "  Reply-To:   %s\n" reply_to;

     

       250
       250
       +
             Printf.printf "  BCC:        %s\n" bcc;

     

       251
       251
       +
             

     

       252
       252
       +
             if Identity.text_signature identity <> "" then

     

       253
       253
       +
               Printf.printf "  Signature:  %s\n" (Identity.text_signature identity);

     

       254
       254
       +
             

     

       255
       255
       +
             if Identity.html_signature identity <> "" then

     

       256
       256
       +
               Printf.printf "  HTML Sig:   (HTML signature available)\n";

     

       257
       257
       +
             

     

       258
       258
       +
             Printf.printf "  Deletable:  %s\n" may_delete

     

       259
       259
       +
         

     

       260
       260
       +
         | `Json ->

     

       261
       261
       +
             let id = Identity.id identity in

     

       262
       262
       +
             let name = Identity.name identity in

     

       263
       263
       +
             let email = Identity.email identity in

     

       264
       264
       +
             Printf.printf "{\n";

     

       265
       265
       +
             Printf.printf "  \"id\": \"%s\",\n" id;

     

       266
       266
       +
             Printf.printf "  \"name\": \"%s\",\n" name;

     

       267
       267
       +
             Printf.printf "  \"email\": \"%s\"\n" email;

     

       268
       268
       +
             Printf.printf "}\n"

     

       269
       269
       +
             

     

       270
       270
       +
         | _ -> ()  (* Other formats don't apply to identities *)

     

       271
       271
       +
       

     

       272
       272
       +
       (* Format delivery status *)

     

       273
       273
       +
       let format_delivery_status rcpt status =

     

       274
       274
       +
         let status_str = match status.delivery_delivered with

     

       275
       275
       +
           | `Queued -> "Queued"

     

       276
       276
       +
           | `Yes -> "Delivered"

     

       277
       277
       +
           | `No -> "Failed"

     

       278
       278
       +
           | `Unknown -> "Unknown"

     

       279
       279
       +
         in

     

       280
       280
       +
         

     

       281
       281
       +
         let display_str = match status.delivery_displayed with

     

       282
       282
       +
           | `Yes -> "Displayed"

     

       283
       283
       +
           | `Unknown -> "Unknown if displayed"

     

       284
       284
       +
         in

     

       285
       285
       +
         

     

       286
       286
       +
         Printf.printf "  %s: %s, %s\n" rcpt status_str display_str;

     

       287
       287
       +
         Printf.printf "    SMTP Reply: %s\n" status.delivery_smtp_reply

     

       288
       288
       +
       

     

       289
       289
       +
       (* Format a submission for display *)

     

       290
       290
       +
       let format_submission submission format =

     

       291
       291
       +
         match format with

     

       292
       292
       +
         | `Summary ->

     

       293
       293
       +
             let id = submission.email_sub_id in

     

       294
       294
       +
             let email_id = submission.email_id in

     

       295
       295
       +
             let send_at = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in

     

       296
       296
       +
             

     

       297
       297
       +
             let status = match submission.undo_status with

     

       298
       298
       +
               | `Pending -> "Pending"

     

       299
       299
       +
               | `Final -> "Final"

     

       300
       300
       +
               | `Canceled -> "Canceled"

     

       301
       301
       +
             in

     

       302
       302
       +
             

     

       303
       303
       +
             let delivery_count = match submission.delivery_status with

     

       304
       304
       +
               | Some statuses -> Hashtbl.length statuses

     

       305
       305
       +
               | None -> 0

     

       306
       306
       +
             in

     

       307
       307
       +
             

     

       308
       308
       +
             Printf.printf "%s: [%s] Sent at %s (Email ID: %s, Recipients: %d)\n" 

     

       309
       309
       +
               id status send_at email_id delivery_count

     

       310
       310
       +
         

     

       311
       311
       +
         | `Detailed ->

     

       312
       312
       +
             let id = submission.email_sub_id in

     

       313
       313
       +
             let email_id = submission.email_id in

     

       314
       314
       +
             let thread_id = submission.thread_id in

     

       315
       315
       +
             let identity_id = submission.identity_id in

     

       316
       316
       +
             let send_at = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in

     

       317
       317
       +
             

     

       318
       318
       +
             let status = match submission.undo_status with

     

       319
       319
       +
               | `Pending -> "Pending"

     

       320
       320
       +
               | `Final -> "Final"

     

       321
       321
       +
               | `Canceled -> "Canceled"

     

       322
       322
       +
             in

     

       323
       323
       +
             

     

       324
       324
       +
             Printf.printf "Submission: %s\n" id;

     

       325
       325
       +
             Printf.printf "  Status:     %s\n" status;

     

       326
       326
       +
             Printf.printf "  Sent at:    %s\n" send_at;

     

       327
       327
       +
             Printf.printf "  Email ID:   %s\n" email_id;

     

       328
       328
       +
             Printf.printf "  Thread ID:  %s\n" thread_id;

     

       329
       329
       +
             Printf.printf "  Identity:   %s\n" identity_id;

     

       330
       330
       +
             

     

       331
       331
       +
             (* Display envelope information if available *)

     

       332
       332
       +
             (match submission.envelope with

     

       333
       333
       +
             | Some env ->

     

       334
       334
       +
                 Printf.printf "  Envelope:\n";

     

       335
       335
       +
                 Printf.printf "    From: %s\n" env.env_mail_from.env_addr_email;

     

       336
       336
       +
                 Printf.printf "    To:   %s\n" 

     

       337
       337
       +
                   (env.env_rcpt_to |> List.map (fun addr -> addr.env_addr_email) |> String.concat ", ")

     

       338
       338
       +
             | None -> ());

     

       339
       339
       +
             

     

       340
       340
       +
             (* Display delivery status *)

     

       341
       341
       +
             (match submission.delivery_status with

     

       342
       342
       +
             | Some statuses ->

     

       343
       343
       +
                 Printf.printf "  Delivery Status:\n";

     

       344
       344
       +
                 statuses |> Hashtbl.iter format_delivery_status

     

       345
       345
       +
             | None -> Printf.printf "  Delivery Status: Not available\n");

     

       346
       346
       +
             

     

       347
       347
       +
             (* DSN and MDN information *)

     

       348
       348
       +
             if submission.dsn_blob_ids <> [] then

     

       349
       349
       +
               Printf.printf "  DSN Blobs:  %d available\n" (List.length submission.dsn_blob_ids);

     

       350
       350
       +
             

     

       351
       351
       +
             if submission.mdn_blob_ids <> [] then

     

       352
       352
       +
               Printf.printf "  MDN Blobs:  %d available\n" (List.length submission.mdn_blob_ids)

     

       353
       353
       +
         

     

       354
       354
       +
         | `Json ->

     

       355
       355
       +
             let id = submission.email_sub_id in

     

       356
       356
       +
             let email_id = submission.email_id in

     

       357
       357
       +
             let send_at_str = String.sub (ISO8601.string_of_datetime (Unix.gmtime submission.send_at)) 0 19 in

     

       358
       358
       +
             

     

       359
       359
       +
             let status_str = match submission.undo_status with

     

       360
       360
       +
               | `Pending -> "pending"

     

       361
       361
       +
               | `Final -> "final"

     

       362
       362
       +
               | `Canceled -> "canceled"

     

       363
       363
       +
             in

     

       364
       364
       +
             

     

       365
       365
       +
             Printf.printf "{\n";

     

       366
       366
       +
             Printf.printf "  \"id\": \"%s\",\n" id;

     

       367
       367
       +
             Printf.printf "  \"emailId\": \"%s\",\n" email_id;

     

       368
       368
       +
             Printf.printf "  \"sendAt\": \"%s\",\n" send_at_str;

     

       369
       369
       +
             Printf.printf "  \"undoStatus\": \"%s\"\n" status_str;

     

       370
       370
       +
             Printf.printf "}\n"

     

       371
       371
       +
             

     

       372
       372
       +
         | `StatusOnly ->

     

       373
       373
       +
             let id = submission.email_sub_id in

     

       374
       374
       +
             

     

       375
       375
       +
             let status = match submission.undo_status with

     

       376
       376
       +
               | `Pending -> "Pending"

     

       377
       377
       +
               | `Final -> "Final"

     

       378
       378
       +
               | `Canceled -> "Canceled"

     

       379
       379
       +
             in

     

       380
       380
       +
             

     

       381
       381
       +
             Printf.printf "Submission %s: %s\n" id status;

     

       382
       382
       +
             

     

       383
       383
       +
             (* Display delivery status summary *)

     

       384
       384
       +
             match submission.delivery_status with

     

       385
       385
       +
             | Some statuses ->

     

       386
       386
       +
                 let total = Hashtbl.length statuses in

     

       387
       387
       +
                 let delivered = Hashtbl.fold (fun _ status count ->

     

       388
       388
       +
                   if status.delivery_delivered = `Yes then count + 1 else count

     

       389
       389
       +
                 ) statuses 0 in

     

       390
       390
       +
                 

     

       391
       391
       +
                 let failed = Hashtbl.fold (fun _ status count ->

     

       392
       392
       +
                   if status.delivery_delivered = `No then count + 1 else count

     

       393
       393
       +
                 ) statuses 0 in

     

       394
       394
       +
                 

     

       395
       395
       +
                 let queued = Hashtbl.fold (fun _ status count ->

     

       396
       396
       +
                   if status.delivery_delivered = `Queued then count + 1 else count

     

       397
       397
       +
                 ) statuses 0 in

     

       398
       398
       +
                 

     

       399
       399
       +
                 Printf.printf "  Total recipients: %d\n" total;

     

       400
       400
       +
                 Printf.printf "  Delivered: %d\n" delivered;

     

       401
       401
       +
                 Printf.printf "  Failed: %d\n" failed;

     

       402
       402
       +
                 Printf.printf "  Queued: %d\n" queued

     

       403
       403
       +
             | None -> 

     

       404
       404
       +
                 Printf.printf "  Delivery status not available\n"

     

       405
       405
       +
       

     

       406
       406
       +
       (* Create an identity with provided details *)

     

       407
       407
       +
       let create_identity_command email name reply_to signature html_signature =

     

       408
       408
       +
         (* In a real implementation, this would validate inputs and create the identity *)

     

       409
       409
       +
         Printf.printf "Creating identity for email: %s\n" email;

     

       410
       410
       +
         

     

       411
       411
       +
         if name <> None then

     

       412
       412
       +
           Printf.printf "Name: %s\n" (Option.get name);

     

       413
       413
       +
         

     

       414
       414
       +
         if reply_to <> None then

     

       415
       415
       +
           Printf.printf "Reply-To: %s\n" (Option.get reply_to);

     

       416
       416
       +
         

     

       417
       417
       +
         if signature <> None || html_signature <> None then

     

       418
       418
       +
           Printf.printf "Signature: Provided\n";

     

       419
       419
       +
         

     

       420
       420
       +
         Printf.printf "\nIdentity creation would be implemented here using JMAP.Identity.create\n";

     

       421
       421
       +
         ()

     

       422
       422
       +
       

     

       423
       423
       +
       (* Command implementation for identity monitoring *)

     

       424
       424
       +
       let identity_command host user password list_identities show_identity 

     

       425
       425
       +
                            create_identity identity_name reply_to signature 

     

       426
       426
       +
                            html_signature list_submissions show_submission track_submission

     

       427
       427
       +
                            pending_only query days limit cancel_submission format : int =

     

       428
       428
       +
         (* Pack arguments into a record for easier passing *)

     

       429
       429
       +
         let args : identity_monitor_args = {

     

       430
       430
       +
           list_identities; show_identity; create_identity; identity_name; 

     

       431
       431
       +
           reply_to; signature; html_signature; list_submissions; 

     

       432
       432
       +
           show_submission; track_submission; pending_only; query; 

     

       433
       433
       +
           days; limit; cancel_submission; format

     

       434
       434
       +
         } in

     

       435
       435
       +
         

     

       436
       436
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       437
       437
       +
         Printf.printf "JMAP Identity & Submission Monitor\n";

     

       438
       438
       +
         Printf.printf "Server: %s\n" host;

     

       439
       439
       +
         Printf.printf "User: %s\n\n" user;

     

       440
       440
       +
         

     

       441
       441
       +
         (* This is where the actual JMAP calls would happen, like:

     

       442
       442
       +
         

     

       443
       443
       +
         let monitor_identities_and_submissions () =

     

       444
       444
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       445
       445
       +
             ~host ~username:user ~password 

     

       446
       446
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       447
       447
       +
           

     

       448
       448
       +
           (* Get primary account ID *)

     

       449
       449
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       450
       450
       +
             | Ok id -> id

     

       451
       451
       +
             | Error _ -> failwith "No mail account found"

     

       452
       452
       +
           in

     

       453
       453
       +
           

     

       454
       454
       +
           (* Handle various command options *)

     

       455
       455
       +
           if args.list_identities then

     

       456
       456
       +
             (* Get all identities *)

     

       457
       457
       +
             let* identity_result = Jmap_email.Identity.get ctx

     

       458
       458
       +
               ~account_id

     

       459
       459
       +
               ~ids:None in

     

       460
       460
       +
             

     

       461
       461
       +
             match identity_result with

     

       462
       462
       +
             | Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err); Lwt.return 1

     

       463
       463
       +
             | Ok (_, identities) ->

     

       464
       464
       +
                 Printf.printf "Found %d identities:\n\n" (List.length identities);

     

       465
       465
       +
                 identities |> List.iter (fun identity ->

     

       466
       466
       +
                   format_identity identity args.format

     

       467
       467
       +
                 );

     

       468
       468
       +
                 Lwt.return 0

     

       469
       469
       +
           

     

       470
       470
       +
           else if args.show_identity <> None then

     

       471
       471
       +
             (* Get specific identity *)

     

       472
       472
       +
             let id = Option.get args.show_identity in

     

       473
       473
       +
             let* identity_result = Jmap_email.Identity.get ctx

     

       474
       474
       +
               ~account_id

     

       475
       475
       +
               ~ids:[id] in

     

       476
       476
       +
             

     

       477
       477
       +
             match identity_result with

     

       478
       478
       +
             | Error err -> Printf.eprintf "Error: %s\n" (Jmap.Error.error_to_string err); Lwt.return 1

     

       479
       479
       +
             | Ok (_, identities) ->

     

       480
       480
       +
                 match identities with

     

       481
       481
       +
                 | [identity] ->

     

       482
       482
       +
                     format_identity identity args.format;

     

       483
       483
       +
                     Lwt.return 0

     

       484
       484
       +
                 | _ ->

     

       485
       485
       +
                     Printf.eprintf "Identity not found: %s\n" id;

     

       486
       486
       +
                     Lwt.return 1

     

       487
       487
       +
           

     

       488
       488
       +
           else if args.create_identity <> None then

     

       489
       489
       +
             (* Create a new identity *)

     

       490
       490
       +
             let email = Option.get args.create_identity in

     

       491
       491
       +
             create_identity_command email args.identity_name args.reply_to 

     

       492
       492
       +
                                    args.signature args.html_signature

     

       493
       493
       +
           

     

       494
       494
       +
           else if args.list_submissions then

     

       495
       495
       +
             (* List all submissions, with optional filtering *)

     

       496
       496
       +
             ...

     

       497
       497
       +
           

     

       498
       498
       +
           else if args.show_submission <> None then

     

       499
       499
       +
             (* Show specific submission details *)

     

       500
       500
       +
             ...

     

       501
       501
       +
           

     

       502
       502
       +
           else if args.track_submission <> None then

     

       503
       503
       +
             (* Track delivery status for a specific submission *)

     

       504
       504
       +
             ...

     

       505
       505
       +
           

     

       506
       506
       +
           else if args.cancel_submission <> None then

     

       507
       507
       +
             (* Cancel a pending submission *)

     

       508
       508
       +
             ...

     

       509
       509
       +
           

     

       510
       510
       +
           else

     

       511
       511
       +
             (* No specific command given, show help *)

     

       512
       512
       +
             Printf.printf "Please specify a command. Use --help for options.\n";

     

       513
       513
       +
             Lwt.return 1

     

       514
       514
       +
         *)

     

       515
       515
       +
         

     

       516
       516
       +
         (if list_identities then begin

     

       517
       517
       +
           (* Simulate listing identities *)

     

       518
       518
       +
           Printf.printf "Found 3 identities:\n\n";

     

       519
       519
       +
           Printf.printf "id1: John Doe <john@example.com>\n";

     

       520
       520
       +
           Printf.printf "id2: John Work <john@work.example.com>\n";

     

       521
       521
       +
           Printf.printf "id3: Support <support@example.com>\n"

     

       522
       522
       +
         end

     

       523
       523
       +
         else if show_identity <> None then begin

     

       524
       524
       +
           (* Simulate showing a specific identity *)

     

       525
       525
       +
           Printf.printf "Identity: %s\n" (Option.get show_identity);

     

       526
       526
       +
           Printf.printf "  Name:       John Doe\n";

     

       527
       527
       +
           Printf.printf "  Email:      john@example.com\n";

     

       528
       528
       +
           Printf.printf "  Reply-To:   (none)\n";

     

       529
       529
       +
           Printf.printf "  BCC:        (none)\n";

     

       530
       530
       +
           Printf.printf "  Signature:  Best regards,\nJohn\n";

     

       531
       531
       +
           Printf.printf "  Deletable:  Yes\n"

     

       532
       532
       +
         end

     

       533
       533
       +
         

     

       534
       534
       +
         else if create_identity <> None then begin

     

       535
       535
       +
           (* Create a new identity *)

     

       536
       536
       +
           create_identity_command (Option.get create_identity) identity_name reply_to 

     

       537
       537
       +
                                    signature html_signature |> ignore

     

       538
       538
       +
         end

     

       539
       539
       +
         else if list_submissions then begin

     

       540
       540
       +
           (* Simulate listing submissions *)

     

       541
       541
       +
           Printf.printf "Recent submissions (last %d days):\n\n" days;

     

       542
       542
       +
           Printf.printf "sub1: [Final] Sent at 2023-01-15 10:30:45 (Email ID: email1, Recipients: 3)\n";

     

       543
       543
       +
           Printf.printf "sub2: [Final] Sent at 2023-01-14 08:15:22 (Email ID: email2, Recipients: 1)\n";

     

       544
       544
       +
           Printf.printf "sub3: [Pending] Sent at 2023-01-13 16:45:10 (Email ID: email3, Recipients: 5)\n"

     

       545
       545
       +
         end

     

       546
       546
       +
         else if show_submission <> None then begin

     

       547
       547
       +
           (* Simulate showing a specific submission *)

     

       548
       548
       +
           Printf.printf "Submission: %s\n" (Option.get show_submission);

     

       549
       549
       +
           Printf.printf "  Status:     Final\n";

     

       550
       550
       +
           Printf.printf "  Sent at:    2023-01-15 10:30:45\n";

     

       551
       551
       +
           Printf.printf "  Email ID:   email1\n";

     

       552
       552
       +
           Printf.printf "  Thread ID:  thread1\n";

     

       553
       553
       +
           Printf.printf "  Identity:   id1\n";

     

       554
       554
       +
           Printf.printf "  Envelope:\n";

     

       555
       555
       +
           Printf.printf "    From: john@example.com\n";

     

       556
       556
       +
           Printf.printf "    To:   alice@example.com, bob@example.com, carol@example.com\n";

     

       557
       557
       +
           Printf.printf "  Delivery Status:\n";

     

       558
       558
       +
           Printf.printf "    alice@example.com: Delivered, Displayed\n";

     

       559
       559
       +
           Printf.printf "      SMTP Reply: 250 OK\n";

     

       560
       560
       +
           Printf.printf "    bob@example.com: Delivered, Unknown if displayed\n";

     

       561
       561
       +
           Printf.printf "      SMTP Reply: 250 OK\n";

     

       562
       562
       +
           Printf.printf "    carol@example.com: Failed\n";

     

       563
       563
       +
           Printf.printf "      SMTP Reply: 550 Mailbox unavailable\n"

     

       564
       564
       +
         end

     

       565
       565
       +
         else if track_submission <> None then begin

     

       566
       566
       +
           (* Simulate tracking a submission *)

     

       567
       567
       +
           Printf.printf "Tracking delivery status for submission: %s\n\n" (Option.get track_submission);

     

       568
       568
       +
           Printf.printf "Submission %s: Final\n" (Option.get track_submission);

     

       569
       569
       +
           Printf.printf "  Total recipients: 3\n";

     

       570
       570
       +
           Printf.printf "  Delivered: 2\n";

     

       571
       571
       +
           Printf.printf "  Failed: 1\n";

     

       572
       572
       +
           Printf.printf "  Queued: 0\n"

     

       573
       573
       +
         end

     

       574
       574
       +
         else if cancel_submission <> None then begin

     

       575
       575
       +
           (* Simulate canceling a submission *)

     

       576
       576
       +
           Printf.printf "Canceling submission: %s\n" (Option.get cancel_submission);

     

       577
       577
       +
           Printf.printf "Submission has been canceled successfully.\n"

     

       578
       578
       +
         end

     

       579
       579
       +
         else 

     

       580
       580
       +
           (* No specific command given, show help *)

     

       581
       581
       +
           begin

     

       582
       582
       +
             Printf.printf "Please specify a command. Use --help for options.\n";

     

       583
       583
       +
             Printf.printf "Example commands:\n";

     

       584
       584
       +
             Printf.printf "  --list-identities      List all email identities\n";

     

       585
       585
       +
             Printf.printf "  --show-identity id1    Show details for identity 'id1'\n";

     

       586
       586
       +
             Printf.printf "  --list-submissions     List recent email submissions\n";

     

       587
       587
       +
             Printf.printf "  --track sub1           Track delivery status for submission 'sub1'\n"

     

       588
       588
       +
           end);

     

       589
       589
       +
         

     

       590
       590
       +
         (* Since we're only type checking, we'll exit with success *)

     

       591
       591
       +
         0

     

       592
       592
       +
       

     

       593
       593
       +
       (* Command definition *)

     

       594
       594
       +
       let identity_cmd =

     

       595
       595
       +
         let doc = "monitor email identities and submissions using JMAP" in

     

       596
       596
       +
         let man = [

     

       597
       597
       +
           `S Manpage.s_description;

     

       598
       598
       +
           `P "Provides identity management and email submission tracking functionality.";

     

       599
       599
       +
           `P "Demonstrates JMAP's identity and email submission monitoring capabilities.";

     

       600
       600
       +
           `S Manpage.s_examples;

     

       601
       601
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list-identities";

     

       602
       602
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --create-identity backup@example.com --name \"Backup Account\"";

     

       603
       603
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list-submissions --days 3";

     

       604
       604
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --track sub12345 --format status-only";

     

       605
       605
       +
         ] in

     

       606
       606
       +
         

     

       607
       607
       +
         let cmd =

     

       608
       608
       +
           Cmd.v

     

       609
       609
       +
             (Cmd.info "jmap-identity-monitor" ~version:"1.0" ~doc ~man)

     

       610
       610
       +
             Term.(const identity_command $ host_arg $ user_arg $ password_arg $ 

     

       611
       611
       +
                   list_identities_arg $ show_identity_arg $ create_identity_arg $ 

     

       612
       612
       +
                   identity_name_arg $ reply_to_arg $ signature_arg $ html_signature_arg $

     

       613
       613
       +
                   list_submissions_arg $ show_submission_arg $ track_submission_arg $

     

       614
       614
       +
                   pending_only_arg $ query_arg $ days_arg $ limit_arg $ 

     

       615
       615
       +
                   cancel_submission_arg $ format_arg)

     

       616
       616
       +
         in

     

       617
       617
       +
         cmd

     

       618
       618
       +
       

     

       619
       619
       +
       (* Main entry point *)

     

       620
       620
       +
       let () = exit (Cmd.eval' identity_cmd)

+420

bin/jmap_mailbox_explorer.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_mailbox_explorer.ml - A tool for exploring email mailboxes using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's mailbox query and manipulation capabilities,

     

       5
       5
       +
        * allowing for exploring, creating, and analyzing mailboxes.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       open Jmap.Wire

     

       15
       15
       +
       open Jmap.Methods

     

       16
       16
       +
       open Jmap_email

     

       17
       17
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       18
       18
       +
       

     

       19
       19
       +
       (* JMAP mailbox handling *)

     

       20
       20
       +
       module Jmap_mailbox = struct

     

       21
       21
       +
         (* Dummy mailbox functions *)

     

       22
       22
       +
         let id mailbox = "mailbox-id"

     

       23
       23
       +
         let name mailbox = "mailbox-name"

     

       24
       24
       +
         let parent_id mailbox = None

     

       25
       25
       +
         let role mailbox = None

     

       26
       26
       +
         let total_emails mailbox = 0

     

       27
       27
       +
         let unread_emails mailbox = 0

     

       28
       28
       +
       end

     

       29
       29
       +
       

     

       30
       30
       +
       (* Unix implementation would be used here *)

     

       31
       31
       +
       module Unix = struct

     

       32
       32
       +
         let connect ~host ~username ~password ?auth_method () =

     

       33
       33
       +
           failwith "Not implemented"

     

       34
       34
       +
       end

     

       35
       35
       +
       

     

       36
       36
       +
       (** Types for mailbox explorer *)

     

       37
       37
       +
       type mailbox_stats = {

     

       38
       38
       +
         time_periods : (string * int) list;

     

       39
       39
       +
         senders : (string * int) list;

     

       40
       40
       +
         subjects : (string * int) list;

     

       41
       41
       +
       }

     

       42
       42
       +
       

     

       43
       43
       +
       type mailbox_explorer_args = {

     

       44
       44
       +
         list : bool;

     

       45
       45
       +
         stats : bool;

     

       46
       46
       +
         mailbox : string option;

     

       47
       47
       +
         create : string option;

     

       48
       48
       +
         parent : string option;

     

       49
       49
       +
         query_mailbox : string option;

     

       50
       50
       +
         days : int;

     

       51
       51
       +
         format : [`Tree | `Flat | `Json];

     

       52
       52
       +
       }

     

       53
       53
       +
       

     

       54
       54
       +
       (** Command-line arguments **)

     

       55
       55
       +
       

     

       56
       56
       +
       let host_arg =

     

       57
       57
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       58
       58
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       59
       59
       +
       

     

       60
       60
       +
       let user_arg =

     

       61
       61
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       62
       62
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       63
       63
       +
       

     

       64
       64
       +
       let password_arg =

     

       65
       65
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       66
       66
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       67
       67
       +
       

     

       68
       68
       +
       let list_arg =

     

       69
       69
       +
         Arg.(value & flag & info ["l"; "list"] ~doc:"List all mailboxes")

     

       70
       70
       +
       

     

       71
       71
       +
       let stats_arg =

     

       72
       72
       +
         Arg.(value & flag & info ["s"; "stats"] ~doc:"Show mailbox statistics")

     

       73
       73
       +
       

     

       74
       74
       +
       let mailbox_arg =

     

       75
       75
       +
         Arg.(value & opt (some string) None & info ["m"; "mailbox"] 

     

       76
       76
       +
              ~docv:"MAILBOX" ~doc:"Filter by mailbox name")

     

       77
       77
       +
       

     

       78
       78
       +
       let create_arg =

     

       79
       79
       +
         Arg.(value & opt (some string) None & info ["create"] 

     

       80
       80
       +
              ~docv:"NAME" ~doc:"Create a new mailbox")

     

       81
       81
       +
       

     

       82
       82
       +
       let parent_arg =

     

       83
       83
       +
         Arg.(value & opt (some string) None & info ["parent"] 

     

       84
       84
       +
              ~docv:"PARENT" ~doc:"Parent mailbox for creation")

     

       85
       85
       +
       

     

       86
       86
       +
       let query_mailbox_arg =

     

       87
       87
       +
         Arg.(value & opt (some string) None & info ["query"] 

     

       88
       88
       +
              ~docv:"QUERY" ~doc:"Query emails in the specified mailbox")

     

       89
       89
       +
       

     

       90
       90
       +
       let days_arg =

     

       91
       91
       +
         Arg.(value & opt int 7 & info ["days"] 

     

       92
       92
       +
              ~docv:"DAYS" ~doc:"Days to analyze for mailbox statistics")

     

       93
       93
       +
       

     

       94
       94
       +
       let format_arg =

     

       95
       95
       +
         Arg.(value & opt (enum [

     

       96
       96
       +
           "tree", `Tree;

     

       97
       97
       +
           "flat", `Flat;

     

       98
       98
       +
           "json", `Json;

     

       99
       99
       +
         ]) `Tree & info ["format"] ~docv:"FORMAT" ~doc:"Output format")

     

       100
       100
       +
       

     

       101
       101
       +
       (** Mailbox Explorer Functionality **)

     

       102
       102
       +
       

     

       103
       103
       +
       (* Get standard role name for display *)

     

       104
       104
       +
       let role_name = function

     

       105
       105
       +
         | `Inbox -> "Inbox"

     

       106
       106
       +
         | `Archive -> "Archive"

     

       107
       107
       +
         | `Drafts -> "Drafts"

     

       108
       108
       +
         | `Sent -> "Sent"

     

       109
       109
       +
         | `Trash -> "Trash"

     

       110
       110
       +
         | `Junk -> "Junk"

     

       111
       111
       +
         | `Important -> "Important"

     

       112
       112
       +
         | `Flagged -> "Flagged"

     

       113
       113
       +
         | `Snoozed -> "Snoozed"

     

       114
       114
       +
         | `Scheduled -> "Scheduled"

     

       115
       115
       +
         | `Memos -> "Memos"

     

       116
       116
       +
         | `Other name -> name

     

       117
       117
       +
         | `None -> "(No role)"

     

       118
       118
       +
       

     

       119
       119
       +
       (* Display mailboxes in tree format *)

     

       120
       120
       +
       let display_mailbox_tree mailboxes format stats =

     

       121
       121
       +
         (* Helper to find children of a parent *)

     

       122
       122
       +
         let find_children parent_id =

     

       123
       123
       +
           mailboxes |> List.filter (fun mailbox ->

     

       124
       124
       +
             match Jmap_mailbox.parent_id mailbox with

     

       125
       125
       +
             | Some id when id = parent_id -> true

     

       126
       126
       +
             | _ -> false

     

       127
       127
       +
           )

     

       128
       128
       +
         in

     

       129
       129
       +
         

     

       130
       130
       +
         (* Helper to find mailboxes without a parent (root level) *)

     

       131
       131
       +
         let find_roots () =

     

       132
       132
       +
           mailboxes |> List.filter (fun mailbox ->

     

       133
       133
       +
             Jmap_mailbox.parent_id mailbox = None

     

       134
       134
       +
           )

     

       135
       135
       +
         in

     

       136
       136
       +
         

     

       137
       137
       +
         (* Get mailbox name with role *)

     

       138
       138
       +
         let mailbox_name_with_role mailbox =

     

       139
       139
       +
           let name = Jmap_mailbox.name mailbox in

     

       140
       140
       +
           match Jmap_mailbox.role mailbox with

     

       141
       141
       +
           | Some role -> Printf.sprintf "%s (%s)" name (role_name role)

     

       142
       142
       +
           | None -> name

     

       143
       143
       +
         in

     

       144
       144
       +
         

     

       145
       145
       +
         (* Helper to get statistics for a mailbox *)

     

       146
       146
       +
         let get_stats mailbox =

     

       147
       147
       +
           let id = Jmap_mailbox.id mailbox in

     

       148
       148
       +
           let total = Jmap_mailbox.total_emails mailbox in

     

       149
       149
       +
           let unread = Jmap_mailbox.unread_emails mailbox in

     

       150
       150
       +
           

     

       151
       151
       +
           match Hashtbl.find_opt stats id with

     

       152
       152
       +
           | Some mailbox_stats -> 

     

       153
       153
       +
               let recent = match List.assoc_opt "Last week" mailbox_stats.time_periods with

     

       154
       154
       +
                 | Some count -> count

     

       155
       155
       +
                 | None -> 0

     

       156
       156
       +
               in

     

       157
       157
       +
               (total, unread, recent)

     

       158
       158
       +
           | None -> (total, unread, 0)

     

       159
       159
       +
         in

     

       160
       160
       +
         

     

       161
       161
       +
         (* Helper to print a JSON representation *)

     

       162
       162
       +
         let print_json_mailbox mailbox indent =

     

       163
       163
       +
           let id = Jmap_mailbox.id mailbox in

     

       164
       164
       +
           let name = Jmap_mailbox.name mailbox in

     

       165
       165
       +
           let role = match Jmap_mailbox.role mailbox with

     

       166
       166
       +
             | Some role -> Printf.sprintf "\"%s\"" (role_name role)

     

       167
       167
       +
             | None -> "null"

     

       168
       168
       +
           in

     

       169
       169
       +
           let total, unread, recent = get_stats mailbox in

     

       170
       170
       +
           

     

       171
       171
       +
           let indent_str = String.make indent ' ' in

     

       172
       172
       +
           Printf.printf "%s{\n" indent_str;

     

       173
       173
       +
           Printf.printf "%s  \"id\": \"%s\",\n" indent_str id;

     

       174
       174
       +
           Printf.printf "%s  \"name\": \"%s\",\n" indent_str name;

     

       175
       175
       +
           Printf.printf "%s  \"role\": %s,\n" indent_str role;

     

       176
       176
       +
           Printf.printf "%s  \"totalEmails\": %d,\n" indent_str total;

     

       177
       177
       +
           Printf.printf "%s  \"unreadEmails\": %d,\n" indent_str unread;

     

       178
       178
       +
           Printf.printf "%s  \"recentEmails\": %d\n" indent_str recent;

     

       179
       179
       +
           Printf.printf "%s}" indent_str

     

       180
       180
       +
         in

     

       181
       181
       +
         

     

       182
       182
       +
         (* Recursive function to print a tree of mailboxes *)

     

       183
       183
       +
         let rec print_tree_level mailboxes level =

     

       184
       184
       +
           mailboxes |> List.iteri (fun i mailbox ->

     

       185
       185
       +
             let id = Jmap_mailbox.id mailbox in

     

       186
       186
       +
             let name = mailbox_name_with_role mailbox in

     

       187
       187
       +
             let total, unread, recent = get_stats mailbox in

     

       188
       188
       +
             

     

       189
       189
       +
             let indent = String.make (level * 2) ' ' in

     

       190
       190
       +
             let is_last = i = List.length mailboxes - 1 in

     

       191
       191
       +
             let prefix = if level = 0 then "" else

     

       192
       192
       +
                          if is_last then "└── " else "├── " in

     

       193
       193
       +
             

     

       194
       194
       +
             match format with

     

       195
       195
       +
             | `Tree ->

     

       196
       196
       +
                 Printf.printf "%s%s%s" indent prefix name;

     

       197
       197
       +
                 if stats <> Hashtbl.create 0 then

     

       198
       198
       +
                   Printf.printf " (%d emails, %d unread, %d recent)" total unread recent;

     

       199
       199
       +
                 Printf.printf "\n";

     

       200
       200
       +
                 

     

       201
       201
       +
                 (* Print children *)

     

       202
       202
       +
                 let children = find_children id in

     

       203
       203
       +
                 let child_indent = level + 1 in

     

       204
       204
       +
                 print_tree_level children child_indent

     

       205
       205
       +
                 

     

       206
       206
       +
             | `Flat ->

     

       207
       207
       +
                 Printf.printf "%s [%s]\n" name id;

     

       208
       208
       +
                 if stats <> Hashtbl.create 0 then

     

       209
       209
       +
                   Printf.printf "  Emails: %d total, %d unread, %d in last week\n" 

     

       210
       210
       +
                     total unread recent;

     

       211
       211
       +
                 

     

       212
       212
       +
                 (* Print children *)

     

       213
       213
       +
                 let children = find_children id in

     

       214
       214
       +
                 print_tree_level children 0

     

       215
       215
       +
                 

     

       216
       216
       +
             | `Json ->

     

       217
       217
       +
                 print_json_mailbox mailbox (level * 2);

     

       218
       218
       +
                 

     

       219
       219
       +
                 (* Handle commas between mailboxes *)

     

       220
       220
       +
                 let children = find_children id in

     

       221
       221
       +
                 if children <> [] || (not is_last) then Printf.printf ",\n" else Printf.printf "\n";

     

       222
       222
       +
                 

     

       223
       223
       +
                 (* Print children as a "children" array *)

     

       224
       224
       +
                 if children <> [] then begin

     

       225
       225
       +
                   Printf.printf "%s\"children\": [\n" (String.make ((level * 2) + 2) ' ');

     

       226
       226
       +
                   print_tree_level children (level + 2);

     

       227
       227
       +
                   Printf.printf "%s]\n" (String.make ((level * 2) + 2) ' ');

     

       228
       228
       +
                   

     

       229
       229
       +
                   (* Add comma if not the last mailbox *)

     

       230
       230
       +
                   if not is_last then Printf.printf "%s,\n" (String.make (level * 2) ' ');

     

       231
       231
       +
                 end

     

       232
       232
       +
           )

     

       233
       233
       +
         in

     

       234
       234
       +
         

     

       235
       235
       +
         (* Print the mailbox tree *)

     

       236
       236
       +
         match format with

     

       237
       237
       +
         | `Tree | `Flat ->

     

       238
       238
       +
             Printf.printf "Mailboxes:\n";

     

       239
       239
       +
             print_tree_level (find_roots()) 0

     

       240
       240
       +
         | `Json ->

     

       241
       241
       +
             Printf.printf "{\n";

     

       242
       242
       +
             Printf.printf "  \"mailboxes\": [\n";

     

       243
       243
       +
             print_tree_level (find_roots()) 1;

     

       244
       244
       +
             Printf.printf "  ]\n";

     

       245
       245
       +
             Printf.printf "}\n"

     

       246
       246
       +
       

     

       247
       247
       +
       (* Command implementation *)

     

       248
       248
       +
       let mailbox_command host user password list stats mailbox create parent 

     

       249
       249
       +
                            query_mailbox days format : int =

     

       250
       250
       +
         (* Pack arguments into a record for easier passing *)

     

       251
       251
       +
         let args : mailbox_explorer_args = {

     

       252
       252
       +
           list; stats; mailbox; create; parent; 

     

       253
       253
       +
           query_mailbox; days; format

     

       254
       254
       +
         } in

     

       255
       255
       +
         

     

       256
       256
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       257
       257
       +
         Printf.printf "JMAP Mailbox Explorer\n";

     

       258
       258
       +
         Printf.printf "Server: %s\n" host;

     

       259
       259
       +
         Printf.printf "User: %s\n\n" user;

     

       260
       260
       +
         

     

       261
       261
       +
         (* This is where the actual JMAP calls would happen, like:

     

       262
       262
       +
         

     

       263
       263
       +
         let explore_mailboxes () =

     

       264
       264
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       265
       265
       +
             ~host ~username:user ~password 

     

       266
       266
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       267
       267
       +
           

     

       268
       268
       +
           (* Get primary account ID *)

     

       269
       269
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       270
       270
       +
             | Ok id -> id

     

       271
       271
       +
             | Error _ -> failwith "No mail account found"

     

       272
       272
       +
           in

     

       273
       273
       +
           

     

       274
       274
       +
           (* Create a new mailbox if requested *)

     

       275
       275
       +
           if args.create <> None then

     

       276
       276
       +
             let name = Option.get args.create in

     

       277
       277
       +
             let parent_id_opt = match args.parent with

     

       278
       278
       +
               | None -> None

     

       279
       279
       +
               | Some parent_name ->

     

       280
       280
       +
                   (* Resolve parent name to ID - would need to search for it *)

     

       281
       281
       +
                   None (* This would actually find or return an error *)

     

       282
       282
       +
             in

     

       283
       283
       +
             

     

       284
       284
       +
             let create_mailbox = Jmap_mailbox.create 

     

       285
       285
       +
               ~name

     

       286
       286
       +
               ?parent_id:parent_id_opt

     

       287
       287
       +
               () in

     

       288
       288
       +
             

     

       289
       289
       +
             let* result = Jmap_mailbox.set ctx

     

       290
       290
       +
               ~account_id

     

       291
       291
       +
               ~create:(Hashtbl.of_seq (Seq.return ("new", create_mailbox)))

     

       292
       292
       +
               () in

     

       293
       293
       +
             

     

       294
       294
       +
             (* Handle mailbox creation result *)

     

       295
       295
       +
             ...

     

       296
       296
       +
           

     

       297
       297
       +
           (* List mailboxes *)

     

       298
       298
       +
           if args.list || args.stats then

     

       299
       299
       +
             (* Query mailboxes *)

     

       300
       300
       +
             let filter = 

     

       301
       301
       +
               if args.mailbox <> None then

     

       302
       302
       +
                 Jmap_mailbox.filter_name_contains (Option.get args.mailbox)

     

       303
       303
       +
               else

     

       304
       304
       +
                 Jmap_mailbox.Filter.condition (`Assoc [])

     

       305
       305
       +
             in

     

       306
       306
       +
             

     

       307
       307
       +
             let* mailbox_ids = Jmap_mailbox.query ctx

     

       308
       308
       +
               ~account_id

     

       309
       309
       +
               ~filter

     

       310
       310
       +
               ~sort:[Jmap_mailbox.sort_by_name () ]

     

       311
       311
       +
               () in

     

       312
       312
       +
             

     

       313
       313
       +
             match mailbox_ids with

     

       314
       314
       +
             | Error err -> 

     

       315
       315
       +
                 Printf.eprintf "Error querying mailboxes: %s\n" (Jmap.Error.error_to_string err);

     

       316
       316
       +
                 Lwt.return_unit

     

       317
       317
       +
             | Ok (ids, _) ->

     

       318
       318
       +
                 (* Get full mailbox objects *)

     

       319
       319
       +
                 let* mailboxes = Jmap_mailbox.get ctx

     

       320
       320
       +
                   ~account_id

     

       321
       321
       +
                   ~ids

     

       322
       322
       +
                   ~properties:["id"; "name"; "parentId"; "role"; "totalEmails"; "unreadEmails"] in

     

       323
       323
       +
                 

     

       324
       324
       +
                 match mailboxes with

     

       325
       325
       +
                 | Error err ->

     

       326
       326
       +
                     Printf.eprintf "Error getting mailboxes: %s\n" (Jmap.Error.error_to_string err);

     

       327
       327
       +
                     Lwt.return_unit

     

       328
       328
       +
                 | Ok (_, mailbox_list) ->

     

       329
       329
       +
                     (* If stats requested, gather email stats for each mailbox *)

     

       330
       330
       +
                     let* stats_opt = 

     

       331
       331
       +
                       if args.stats then

     

       332
       332
       +
                         (* For each mailbox, gather stats like weekly counts *)

     

       333
       333
       +
                         ...

     

       334
       334
       +
                       else

     

       335
       335
       +
                         Lwt.return (Hashtbl.create 0)

     

       336
       336
       +
                     in

     

       337
       337
       +
                     

     

       338
       338
       +
                     (* Display mailboxes in requested format *)

     

       339
       339
       +
                     display_mailbox_tree mailbox_list args.format stats_opt;

     

       340
       340
       +
                     Lwt.return_unit

     

       341
       341
       +
           

     

       342
       342
       +
           (* Query emails in a specific mailbox *)

     

       343
       343
       +
           if args.query_mailbox <> None then

     

       344
       344
       +
             let mailbox_name = Option.get args.query_mailbox in

     

       345
       345
       +
             

     

       346
       346
       +
             (* Find mailbox ID from name *)

     

       347
       347
       +
             ...

     

       348
       348
       +
             

     

       349
       349
       +
             (* Query emails in that mailbox *)

     

       350
       350
       +
             ...

     

       351
       351
       +
         *)

     

       352
       352
       +
         

     

       353
       353
       +
         if create <> None then

     

       354
       354
       +
           Printf.printf "Creating mailbox: %s\n" (Option.get create);

     

       355
       355
       +
         

     

       356
       356
       +
         if list || stats then

     

       357
       357
       +
           Printf.printf "Listing mailboxes%s:\n" 

     

       358
       358
       +
             (if stats then " with statistics" else "");

     

       359
       359
       +
         

     

       360
       360
       +
         (* Example output for a tree of mailboxes *)

     

       361
       361
       +
         (match format with

     

       362
       362
       +
         | `Tree -> 

     

       363
       363
       +
             Printf.printf "Mailboxes:\n";

     

       364
       364
       +
             Printf.printf "Inbox (14 emails, 3 unread, 5 recent)\n";

     

       365
       365
       +
             Printf.printf "├── Work (8 emails, 2 unread, 3 recent)\n";

     

       366
       366
       +
             Printf.printf "│   └── Project A (3 emails, 1 unread, 2 recent)\n";

     

       367
       367
       +
             Printf.printf "└── Personal (6 emails, 1 unread, 2 recent)\n"

     

       368
       368
       +
         | `Flat ->

     

       369
       369
       +
             Printf.printf "Inbox [mbox1]\n";

     

       370
       370
       +
             Printf.printf "  Emails: 14 total, 3 unread, 5 in last week\n";

     

       371
       371
       +
             Printf.printf "Work [mbox2]\n";

     

       372
       372
       +
             Printf.printf "  Emails: 8 total, 2 unread, 3 in last week\n";

     

       373
       373
       +
             Printf.printf "Project A [mbox3]\n";

     

       374
       374
       +
             Printf.printf "  Emails: 3 total, 1 unread, 2 in last week\n";

     

       375
       375
       +
             Printf.printf "Personal [mbox4]\n";

     

       376
       376
       +
             Printf.printf "  Emails: 6 total, 1 unread, 2 in last week\n"

     

       377
       377
       +
         | `Json ->

     

       378
       378
       +
             Printf.printf "{\n";

     

       379
       379
       +
             Printf.printf "  \"mailboxes\": [\n";

     

       380
       380
       +
             Printf.printf "    {\n";

     

       381
       381
       +
             Printf.printf "      \"id\": \"mbox1\",\n";

     

       382
       382
       +
             Printf.printf "      \"name\": \"Inbox\",\n";

     

       383
       383
       +
             Printf.printf "      \"role\": \"Inbox\",\n";

     

       384
       384
       +
             Printf.printf "      \"totalEmails\": 14,\n";

     

       385
       385
       +
             Printf.printf "      \"unreadEmails\": 3,\n";

     

       386
       386
       +
             Printf.printf "      \"recentEmails\": 5\n";

     

       387
       387
       +
             Printf.printf "    }\n";

     

       388
       388
       +
             Printf.printf "  ]\n";

     

       389
       389
       +
             Printf.printf "}\n");

     

       390
       390
       +
         

     

       391
       391
       +
         if query_mailbox <> None then

     

       392
       392
       +
           Printf.printf "\nQuerying emails in mailbox: %s\n" (Option.get query_mailbox);

     

       393
       393
       +
         

     

       394
       394
       +
         (* Since we're only type checking, we'll exit with success *)

     

       395
       395
       +
         0

     

       396
       396
       +
       

     

       397
       397
       +
       (* Command definition *)

     

       398
       398
       +
       let mailbox_cmd =

     

       399
       399
       +
         let doc = "explore and manage mailboxes using JMAP" in

     

       400
       400
       +
         let man = [

     

       401
       401
       +
           `S Manpage.s_description;

     

       402
       402
       +
           `P "Lists, creates, and analyzes email mailboxes using JMAP.";

     

       403
       403
       +
           `P "Demonstrates JMAP's mailbox query and management capabilities.";

     

       404
       404
       +
           `S Manpage.s_examples;

     

       405
       405
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --list";

     

       406
       406
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --stats --mailbox Inbox";

     

       407
       407
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --create \"Work/Project X\" --parent Work";

     

       408
       408
       +
         ] in

     

       409
       409
       +
         

     

       410
       410
       +
         let cmd = 

     

       411
       411
       +
           Cmd.v 

     

       412
       412
       +
             (Cmd.info "jmap-mailbox-explorer" ~version:"1.0" ~doc ~man)

     

       413
       413
       +
             Term.(const mailbox_command $ host_arg $ user_arg $ password_arg $ 

     

       414
       414
       +
                    list_arg $ stats_arg $ mailbox_arg $ create_arg $ 

     

       415
       415
       +
                    parent_arg $ query_mailbox_arg $ days_arg $ format_arg)

     

       416
       416
       +
         in

     

       417
       417
       +
         cmd

     

       418
       418
       +
       

     

       419
       419
       +
       (* Main entry point *)

     

       420
       420
       +
       let () = exit (Cmd.eval' mailbox_cmd)

+238

bin/jmap_push_listener.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_push_listener.ml - Monitor real-time changes via JMAP push notifications

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's push notification capabilities for monitoring

     

       5
       5
       +
        * changes to emails, mailboxes, and other data in real-time.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Push notification types to monitor **)

     

       13
       13
       +
       type monitor_types = {

     

       14
       14
       +
         emails : bool;

     

       15
       15
       +
         mailboxes : bool;

     

       16
       16
       +
         threads : bool;

     

       17
       17
       +
         identities : bool;

     

       18
       18
       +
         submissions : bool;

     

       19
       19
       +
         all : bool;

     

       20
       20
       +
       }

     

       21
       21
       +
       

     

       22
       22
       +
       (** Command-line arguments **)

     

       23
       23
       +
       

     

       24
       24
       +
       let host_arg =

     

       25
       25
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       26
       26
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       27
       27
       +
       

     

       28
       28
       +
       let user_arg =

     

       29
       29
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       30
       30
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       31
       31
       +
       

     

       32
       32
       +
       let password_arg =

     

       33
       33
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       34
       34
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       35
       35
       +
       

     

       36
       36
       +
       let monitor_emails_arg =

     

       37
       37
       +
         Arg.(value & flag & info ["emails"] 

     

       38
       38
       +
              ~doc:"Monitor email changes")

     

       39
       39
       +
       

     

       40
       40
       +
       let monitor_mailboxes_arg =

     

       41
       41
       +
         Arg.(value & flag & info ["mailboxes"] 

     

       42
       42
       +
              ~doc:"Monitor mailbox changes")

     

       43
       43
       +
       

     

       44
       44
       +
       let monitor_threads_arg =

     

       45
       45
       +
         Arg.(value & flag & info ["threads"] 

     

       46
       46
       +
              ~doc:"Monitor thread changes")

     

       47
       47
       +
       

     

       48
       48
       +
       let monitor_identities_arg =

     

       49
       49
       +
         Arg.(value & flag & info ["identities"] 

     

       50
       50
       +
              ~doc:"Monitor identity changes")

     

       51
       51
       +
       

     

       52
       52
       +
       let monitor_submissions_arg =

     

       53
       53
       +
         Arg.(value & flag & info ["submissions"] 

     

       54
       54
       +
              ~doc:"Monitor email submission changes")

     

       55
       55
       +
       

     

       56
       56
       +
       let monitor_all_arg =

     

       57
       57
       +
         Arg.(value & flag & info ["all"] 

     

       58
       58
       +
              ~doc:"Monitor all supported types")

     

       59
       59
       +
       

     

       60
       60
       +
       let verbose_arg =

     

       61
       61
       +
         Arg.(value & flag & info ["v"; "verbose"] 

     

       62
       62
       +
              ~doc:"Show detailed information about changes")

     

       63
       63
       +
       

     

       64
       64
       +
       let timeout_arg =

     

       65
       65
       +
         Arg.(value & opt int 300 & info ["t"; "timeout"] 

     

       66
       66
       +
              ~docv:"SECONDS" ~doc:"Timeout for push connections (default: 300)")

     

       67
       67
       +
       

     

       68
       68
       +
       (** Helper functions **)

     

       69
       69
       +
       

     

       70
       70
       +
       (* Format timestamp *)

     

       71
       71
       +
       let format_timestamp () =

     

       72
       72
       +
         let time = Unix.gettimeofday () in

     

       73
       73
       +
         let tm = Unix.localtime time in

     

       74
       74
       +
         Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d"

     

       75
       75
       +
           (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

     

       76
       76
       +
           tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec

     

       77
       77
       +
       

     

       78
       78
       +
       (* Print change notification *)

     

       79
       79
       +
       let print_change data_type change_type details verbose =

     

       80
       80
       +
         let timestamp = format_timestamp () in

     

       81
       81
       +
         Printf.printf "[%s] %s %s" timestamp data_type change_type;

     

       82
       82
       +
         if verbose && details <> "" then

     

       83
       83
       +
           Printf.printf ": %s" details;

     

       84
       84
       +
         Printf.printf "\n";

     

       85
       85
       +
         flush stdout

     

       86
       86
       +
       

     

       87
       87
       +
       (* Monitor using polling simulation *)

     

       88
       88
       +
       let monitor_changes _ctx _session _account_id monitor verbose timeout =

     

       89
       89
       +
         Printf.printf "Starting change monitoring (simulated)...\n\n";

     

       90
       90
       +
         

     

       91
       91
       +
         (* Types to monitor *)

     

       92
       92
       +
         let types = ref [] in

     

       93
       93
       +
         if monitor.emails || monitor.all then types := "Email" :: !types;

     

       94
       94
       +
         if monitor.mailboxes || monitor.all then types := "Mailbox" :: !types;

     

       95
       95
       +
         if monitor.threads || monitor.all then types := "Thread" :: !types;

     

       96
       96
       +
         if monitor.identities || monitor.all then types := "Identity" :: !types;

     

       97
       97
       +
         if monitor.submissions || monitor.all then types := "EmailSubmission" :: !types;

     

       98
       98
       +
         

     

       99
       99
       +
         Printf.printf "Monitoring: %s\n\n" (String.concat ", " !types);

     

       100
       100
       +
         

     

       101
       101
       +
         (* In a real implementation, we would:

     

       102
       102
       +
            1. Use EventSource or long polling

     

       103
       103
       +
            2. Track state changes per type

     

       104
       104
       +
            3. Fetch and display actual changes

     

       105
       105
       +
            

     

       106
       106
       +
            For this demo, we'll simulate monitoring *)

     

       107
       107
       +
         

     

       108
       108
       +
         let rec monitor_loop count =

     

       109
       109
       +
           (* Make a simple echo request to stay connected *)

     

       110
       110
       +
           let invocation = Jmap.Wire.Invocation.v

     

       111
       111
       +
             ~method_name:"Core/echo"

     

       112
       112
       +
             ~arguments:(`Assoc ["ping", `String "keepalive"]) 

     

       113
       113
       +
             ~method_call_id:"echo1"

     

       114
       114
       +
             () in

     

       115
       115
       +
             

     

       116
       116
       +
           let request = Jmap.Wire.Request.v

     

       117
       117
       +
             ~using:[Jmap.capability_core; Jmap_email.capability_mail]

     

       118
       118
       +
             ~method_calls:[invocation]

     

       119
       119
       +
             () in

     

       120
       120
       +
             

     

       121
       121
       +
           match Jmap_unix.request _ctx request with

     

       122
       122
       +
           | Ok _ ->

     

       123
       123
       +
               (* Simulate random changes for demonstration *)

     

       124
       124
       +
               if count mod 3 = 0 && !types <> [] then (

     

       125
       125
       +
                 let changed_type = List.nth !types (Random.int (List.length !types)) in

     

       126
       126
       +
                 let change_details = match changed_type with

     

       127
       127
       +
                   | "Email" -> "2 new, 1 updated"

     

       128
       128
       +
                   | "Mailbox" -> "1 updated (Inbox)"

     

       129
       129
       +
                   | "Thread" -> "3 updated"

     

       130
       130
       +
                   | "Identity" -> "settings changed"

     

       131
       131
       +
                   | "EmailSubmission" -> "1 sent"

     

       132
       132
       +
                   | _ -> "changed"

     

       133
       133
       +
                 in

     

       134
       134
       +
                 print_change changed_type "changed" change_details verbose

     

       135
       135
       +
               );

     

       136
       136
       +
               

     

       137
       137
       +
               (* Wait before next check *)

     

       138
       138
       +
               Unix.sleep 5;

     

       139
       139
       +
               

     

       140
       140
       +
               if count < timeout / 5 then

     

       141
       141
       +
                 monitor_loop (count + 1)

     

       142
       142
       +
               else (

     

       143
       143
       +
                 Printf.printf "\nMonitoring timeout reached.\n";

     

       144
       144
       +
                 0

     

       145
       145
       +
               )

     

       146
       146
       +
           | Error e ->

     

       147
       147
       +
               Printf.eprintf "Connection error: %s\n" (Jmap.Error.error_to_string e);

     

       148
       148
       +
               1

     

       149
       149
       +
         in

     

       150
       150
       +
         

     

       151
       151
       +
         monitor_loop 0

     

       152
       152
       +
       

     

       153
       153
       +
       (* Command implementation *)

     

       154
       154
       +
       let listen_command host user password emails mailboxes threads identities 

     

       155
       155
       +
                          submissions all verbose timeout : int =

     

       156
       156
       +
         Printf.printf "JMAP Push Listener\n";

     

       157
       157
       +
         Printf.printf "Server: %s\n" host;

     

       158
       158
       +
         Printf.printf "User: %s\n\n" user;

     

       159
       159
       +
         

     

       160
       160
       +
         (* Build monitor options *)

     

       161
       161
       +
         let monitor = {

     

       162
       162
       +
           emails;

     

       163
       163
       +
           mailboxes;

     

       164
       164
       +
           threads;

     

       165
       165
       +
           identities;

     

       166
       166
       +
           submissions;

     

       167
       167
       +
           all;

     

       168
       168
       +
         } in

     

       169
       169
       +
         

     

       170
       170
       +
         (* Check that at least one type is selected *)

     

       171
       171
       +
         if not (emails || mailboxes || threads || identities || submissions || all) then (

     

       172
       172
       +
           Printf.eprintf "Error: Must specify at least one type to monitor (or --all)\n";

     

       173
       173
       +
           exit 1

     

       174
       174
       +
         );

     

       175
       175
       +
         

     

       176
       176
       +
         (* Initialize random for simulation *)

     

       177
       177
       +
         Random.self_init ();

     

       178
       178
       +
         

     

       179
       179
       +
         (* Connect to server *)

     

       180
       180
       +
         let ctx = Jmap_unix.create_client () in

     

       181
       181
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       182
       182
       +
         

     

       183
       183
       +
         let (ctx, session) = match result with

     

       184
       184
       +
           | Ok (ctx, session) -> (ctx, session)

     

       185
       185
       +
           | Error e -> 

     

       186
       186
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       187
       187
       +
               exit 1

     

       188
       188
       +
         in

     

       189
       189
       +
         

     

       190
       190
       +
         (* Get the primary account ID *)

     

       191
       191
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       192
       192
       +
           | Ok id -> id

     

       193
       193
       +
           | Error e -> 

     

       194
       194
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       195
       195
       +
               exit 1

     

       196
       196
       +
         in

     

       197
       197
       +
         

     

       198
       198
       +
         (* Check EventSource URL availability *)

     

       199
       199
       +
         let event_source_url = Jmap.Session.Session.event_source_url session in

     

       200
       200
       +
         if Uri.to_string event_source_url <> "" then

     

       201
       201
       +
           Printf.printf "Note: Server supports EventSource at: %s\n\n" (Uri.to_string event_source_url)

     

       202
       202
       +
         else

     

       203
       203
       +
           Printf.printf "Note: Server doesn't advertise EventSource support\n\n";

     

       204
       204
       +
         

     

       205
       205
       +
         (* Monitor for changes *)

     

       206
       206
       +
         monitor_changes ctx session account_id monitor verbose timeout

     

       207
       207
       +
       

     

       208
       208
       +
       (* Command definition *)

     

       209
       209
       +
       let listen_cmd =

     

       210
       210
       +
         let doc = "monitor real-time changes via JMAP push notifications" in

     

       211
       211
       +
         let man = [

     

       212
       212
       +
           `S Manpage.s_description;

     

       213
       213
       +
           `P "Monitor real-time changes to JMAP data using push notifications.";

     

       214
       214
       +
           `P "Supports both EventSource and long-polling methods.";

     

       215
       215
       +
           `P "Shows when emails, mailboxes, threads, and other data change.";

     

       216
       216
       +
           `S Manpage.s_examples;

     

       217
       217
       +
           `P "Monitor all changes:";

     

       218
       218
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --all";

     

       219
       219
       +
           `P "";

     

       220
       220
       +
           `P "Monitor only emails and mailboxes with details:";

     

       221
       221
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --emails --mailboxes -v";

     

       222
       222
       +
           `P "";

     

       223
       223
       +
           `P "Monitor with custom timeout:";

     

       224
       224
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --all -t 600";

     

       225
       225
       +
         ] in

     

       226
       226
       +
         

     

       227
       227
       +
         let cmd =

     

       228
       228
       +
           Cmd.v

     

       229
       229
       +
             (Cmd.info "jmap-push-listener" ~version:"1.0" ~doc ~man)

     

       230
       230
       +
             Term.(const listen_command $ host_arg $ user_arg $ password_arg $ 

     

       231
       231
       +
                   monitor_emails_arg $ monitor_mailboxes_arg $ monitor_threads_arg $

     

       232
       232
       +
                   monitor_identities_arg $ monitor_submissions_arg $ monitor_all_arg $

     

       233
       233
       +
                   verbose_arg $ timeout_arg)

     

       234
       234
       +
         in

     

       235
       235
       +
         cmd

     

       236
       236
       +
       

     

       237
       237
       +
       (* Main entry point *)

     

       238
       238
       +
       let () = exit (Cmd.eval' listen_cmd)

+533

bin/jmap_thread_analyzer.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_thread_analyzer.ml - A tool for analyzing email threads using JMAP

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates the thread-related capabilities of JMAP,

     

       5
       5
       +
        * allowing visualization and analysis of conversation threads.

     

       6
       6
       +
        *)

     

       7
       7
       +
       

     

       8
       8
       +
       open Cmdliner

     

       9
       9
       +
       (* Using standard OCaml, no Lwt *)

     

       10
       10
       +
       

     

       11
       11
       +
       (* JMAP imports *)

     

       12
       12
       +
       open Jmap

     

       13
       13
       +
       open Jmap.Types

     

       14
       14
       +
       open Jmap.Wire

     

       15
       15
       +
       open Jmap.Methods

     

       16
       16
       +
       open Jmap_email

     

       17
       17
       +
       (* For step 2, we're only testing type checking. No implementations required. *)

     

       18
       18
       +
       

     

       19
       19
       +
       (* Dummy Unix module for type checking *)

     

       20
       20
       +
       module Unix = struct

     

       21
       21
       +
         type tm = {

     

       22
       22
       +
           tm_sec : int;

     

       23
       23
       +
           tm_min : int;

     

       24
       24
       +
           tm_hour : int;

     

       25
       25
       +
           tm_mday : int;

     

       26
       26
       +
           tm_mon : int;

     

       27
       27
       +
           tm_year : int;

     

       28
       28
       +
           tm_wday : int;

     

       29
       29
       +
           tm_yday : int;

     

       30
       30
       +
           tm_isdst : bool

     

       31
       31
       +
         }

     

       32
       32
       +
         

     

       33
       33
       +
         let time () = 0.0

     

       34
       34
       +
         let gettimeofday () = 0.0

     

       35
       35
       +
         let mktime tm = (0.0, tm)

     

       36
       36
       +
         let gmtime _time = {

     

       37
       37
       +
           tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       38
       38
       +
           tm_mday = 1; tm_mon = 0; tm_year = 120;

     

       39
       39
       +
           tm_wday = 0; tm_yday = 0; tm_isdst = false;

     

       40
       40
       +
         }

     

       41
       41
       +
         

     

       42
       42
       +
         (* JMAP connection function - would be in a real implementation *)

     

       43
       43
       +
         let connect ~host ~username ~password ?auth_method () =

     

       44
       44
       +
           failwith "Not implemented"

     

       45
       45
       +
       end

     

       46
       46
       +
       

     

       47
       47
       +
       (* Dummy ISO8601 module *)

     

       48
       48
       +
       module ISO8601 = struct

     

       49
       49
       +
         let string_of_datetime _tm = "2023-01-01T00:00:00Z"

     

       50
       50
       +
       end

     

       51
       51
       +
       

     

       52
       52
       +
       (** Thread analyzer arguments *)

     

       53
       53
       +
       type thread_analyzer_args = {

     

       54
       54
       +
         thread_id : string option;

     

       55
       55
       +
         search : string option;

     

       56
       56
       +
         limit : int;

     

       57
       57
       +
         days : int;

     

       58
       58
       +
         subject : string option;

     

       59
       59
       +
         participants : string list;

     

       60
       60
       +
         format : [`Summary | `Detailed | `Timeline | `Graph];

     

       61
       61
       +
         include_body : bool;

     

       62
       62
       +
       }

     

       63
       63
       +
       

     

       64
       64
       +
       (* Email filter helpers - stub implementations for type checking *)

     

       65
       65
       +
       module Email_filter = struct

     

       66
       66
       +
         let create_fulltext_filter text = Filter.condition (`Assoc [("text", `String text)])

     

       67
       67
       +
         let subject subj = Filter.condition (`Assoc [("subject", `String subj)])

     

       68
       68
       +
         let from email = Filter.condition (`Assoc [("from", `String email)])

     

       69
       69
       +
         let after date = Filter.condition (`Assoc [("receivedAt", `Assoc [("after", `Float date)])])

     

       70
       70
       +
         let before date = Filter.condition (`Assoc [("receivedAt", `Assoc [("before", `Float date)])])

     

       71
       71
       +
         let has_attachment () = Filter.condition (`Assoc [("hasAttachment", `Bool true)])

     

       72
       72
       +
         let unread () = Filter.condition (`Assoc [("isUnread", `Bool true)])

     

       73
       73
       +
         let in_mailbox id = Filter.condition (`Assoc [("inMailbox", `String id)])

     

       74
       74
       +
         let to_ email = Filter.condition (`Assoc [("to", `String email)])

     

       75
       75
       +
       end

     

       76
       76
       +
       

     

       77
       77
       +
       (* Thread module stub *)

     

       78
       78
       +
       module Thread = struct

     

       79
       79
       +
         type t = {

     

       80
       80
       +
           id : string;

     

       81
       81
       +
           email_ids : string list;

     

       82
       82
       +
         }

     

       83
       83
       +
         

     

       84
       84
       +
         let id thread = thread.id

     

       85
       85
       +
         let email_ids thread = thread.email_ids

     

       86
       86
       +
       end

     

       87
       87
       +
       

     

       88
       88
       +
       (** Command-line arguments **)

     

       89
       89
       +
       

     

       90
       90
       +
       let host_arg =

     

       91
       91
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       92
       92
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       93
       93
       +
       

     

       94
       94
       +
       let user_arg =

     

       95
       95
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       96
       96
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       97
       97
       +
       

     

       98
       98
       +
       let password_arg =

     

       99
       99
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       100
       100
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       101
       101
       +
       

     

       102
       102
       +
       let thread_id_arg =

     

       103
       103
       +
         Arg.(value & opt (some string) None & info ["t"; "thread"] 

     

       104
       104
       +
              ~docv:"THREAD_ID" ~doc:"Analyze specific thread by ID")

     

       105
       105
       +
       

     

       106
       106
       +
       let search_arg =

     

       107
       107
       +
         Arg.(value & opt (some string) None & info ["search"] 

     

       108
       108
       +
              ~docv:"QUERY" ~doc:"Search for threads containing text")

     

       109
       109
       +
       

     

       110
       110
       +
       let limit_arg =

     

       111
       111
       +
         Arg.(value & opt int 10 & info ["limit"] 

     

       112
       112
       +
              ~docv:"N" ~doc:"Maximum number of threads to display")

     

       113
       113
       +
       

     

       114
       114
       +
       let days_arg =

     

       115
       115
       +
         Arg.(value & opt int 30 & info ["days"] 

     

       116
       116
       +
              ~docv:"DAYS" ~doc:"Limit to threads from the past N days")

     

       117
       117
       +
       

     

       118
       118
       +
       let subject_arg =

     

       119
       119
       +
         Arg.(value & opt (some string) None & info ["subject"] 

     

       120
       120
       +
              ~docv:"SUBJECT" ~doc:"Search threads by subject")

     

       121
       121
       +
       

     

       122
       122
       +
       let participant_arg =

     

       123
       123
       +
         Arg.(value & opt_all string [] & info ["participant"] 

     

       124
       124
       +
              ~docv:"EMAIL" ~doc:"Filter by participant email")

     

       125
       125
       +
       

     

       126
       126
       +
       let format_arg =

     

       127
       127
       +
         Arg.(value & opt (enum [

     

       128
       128
       +
           "summary", `Summary;

     

       129
       129
       +
           "detailed", `Detailed;

     

       130
       130
       +
           "timeline", `Timeline;

     

       131
       131
       +
           "graph", `Graph;

     

       132
       132
       +
         ]) `Summary & info ["format"] ~docv:"FORMAT" ~doc:"Output format")

     

       133
       133
       +
       

     

       134
       134
       +
       let include_body_arg =

     

       135
       135
       +
         Arg.(value & flag & info ["include-body"] ~doc:"Include message bodies in output")

     

       136
       136
       +
       

     

       137
       137
       +
       (** Thread Analysis Functionality **)

     

       138
       138
       +
       

     

       139
       139
       +
       (* Calculate days ago from a date *)

     

       140
       140
       +
       let days_ago date =

     

       141
       141
       +
         let now = Unix.gettimeofday() in

     

       142
       142
       +
         int_of_float ((now -. date) /. 86400.0)

     

       143
       143
       +
       

     

       144
       144
       +
       (* Parse out email addresses from a participant string - simple version *)

     

       145
       145
       +
       let extract_email participant =

     

       146
       146
       +
         if String.contains participant '@' then participant

     

       147
       147
       +
         else participant ^ "@example.com" (* Default domain if none provided *)

     

       148
       148
       +
       

     

       149
       149
       +
       (* Create filter for thread queries *)

     

       150
       150
       +
       let create_thread_filter args =

     

       151
       151
       +
         let open Email_filter in

     

       152
       152
       +
         let filters = [] in

     

       153
       153
       +
         

     

       154
       154
       +
         (* Add search text condition *)

     

       155
       155
       +
         let filters = match args.search with

     

       156
       156
       +
           | None -> filters

     

       157
       157
       +
           | Some text -> create_fulltext_filter text :: filters

     

       158
       158
       +
         in

     

       159
       159
       +
         

     

       160
       160
       +
         (* Add subject condition *)

     

       161
       161
       +
         let filters = match args.subject with

     

       162
       162
       +
           | None -> filters

     

       163
       163
       +
           | Some subj -> Email_filter.subject subj :: filters

     

       164
       164
       +
         in

     

       165
       165
       +
         

     

       166
       166
       +
         (* Add date range based on days *)

     

       167
       167
       +
         let filters =

     

       168
       168
       +
           if args.days > 0 then

     

       169
       169
       +
             let now = Unix.gettimeofday() in

     

       170
       170
       +
             let past = now -. (float_of_int args.days *. 86400.0) in

     

       171
       171
       +
             after past :: filters

     

       172
       172
       +
           else

     

       173
       173
       +
             filters

     

       174
       174
       +
         in

     

       175
       175
       +
         

     

       176
       176
       +
         (* Add participant filters *)

     

       177
       177
       +
         let filters =

     

       178
       178
       +
           List.fold_left (fun acc participant ->

     

       179
       179
       +
             let email = extract_email participant in

     

       180
       180
       +
             (* This would need more complex logic to check both from and to fields *)

     

       181
       181
       +
             from email :: acc

     

       182
       182
       +
           ) filters args.participants

     

       183
       183
       +
         in

     

       184
       184
       +
         

     

       185
       185
       +
         (* Combine all filters with AND *)

     

       186
       186
       +
         match filters with

     

       187
       187
       +
         | [] -> Filter.condition (`Assoc [])  (* Empty filter *)

     

       188
       188
       +
         | [f] -> f

     

       189
       189
       +
         | filters -> Filter.and_ filters

     

       190
       190
       +
       

     

       191
       191
       +
       (* Display thread in requested format *)

     

       192
       192
       +
       let display_thread thread emails format include_body snippet_map =

     

       193
       193
       +
         let thread_id = Thread.id thread in

     

       194
       194
       +
         let email_count = List.length (Thread.email_ids thread) in

     

       195
       195
       +
         

     

       196
       196
       +
         (* Sort emails by date for proper display order *)

     

       197
       197
       +
         let sorted_emails = List.sort (fun e1 e2 ->

     

       198
       198
       +
           let date1 = Option.value (Types.Email.received_at e1) ~default:0.0 in

     

       199
       199
       +
           let date2 = Option.value (Types.Email.received_at e2) ~default:0.0 in

     

       200
       200
       +
           compare date1 date2

     

       201
       201
       +
         ) emails in

     

       202
       202
       +
         

     

       203
       203
       +
         (* Get a snippet for an email if available *)

     

       204
       204
       +
         let get_snippet email_id =

     

       205
       205
       +
           match Hashtbl.find_opt snippet_map email_id with

     

       206
       206
       +
           | Some snippet -> snippet

     

       207
       207
       +
           | None -> "(No preview available)"

     

       208
       208
       +
         in

     

       209
       209
       +
         

     

       210
       210
       +
         match format with

     

       211
       211
       +
         | `Summary ->

     

       212
       212
       +
             Printf.printf "Thread: %s (%d messages)\n\n" thread_id email_count;

     

       213
       213
       +
             

     

       214
       214
       +
             (* Print first email subject as thread subject *)

     

       215
       215
       +
             (match sorted_emails with

     

       216
       216
       +
             | first :: _ ->

     

       217
       217
       +
                 let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in

     

       218
       218
       +
                 Printf.printf "Subject: %s\n\n" subject

     

       219
       219
       +
             | [] -> Printf.printf "No emails available\n\n");

     

       220
       220
       +
             

     

       221
       221
       +
             (* List participants *)

     

       222
       222
       +
             let participants = sorted_emails |> List.fold_left (fun acc email ->

     

       223
       223
       +
               let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       224
       224
       +
               from_list |> List.fold_left (fun acc addr ->

     

       225
       225
       +
                 let email = Types.Email_address.email addr in

     

       226
       226
       +
                 if not (List.mem email acc) then email :: acc else acc

     

       227
       227
       +
               ) acc

     

       228
       228
       +
             ) [] in

     

       229
       229
       +
             

     

       230
       230
       +
             Printf.printf "Participants: %s\n\n" (String.concat ", " participants);

     

       231
       231
       +
             

     

       232
       232
       +
             (* Show timespan *)

     

       233
       233
       +
             (match sorted_emails with

     

       234
       234
       +
             | first :: _ :: _ :: _ -> (* At least a few messages *)

     

       235
       235
       +
                 let first_date = Option.value (Types.Email.received_at first) ~default:0.0 in

     

       236
       236
       +
                 let last_date = Option.value (Types.Email.received_at (List.hd (List.rev sorted_emails))) ~default:0.0 in

     

       237
       237
       +
                 let datetime_str = ISO8601.string_of_datetime (Unix.gmtime first_date) in

     

       238
       238
       +
                 let first_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       239
       239
       +
                 let datetime_str = ISO8601.string_of_datetime (Unix.gmtime last_date) in

     

       240
       240
       +
                 let last_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       241
       241
       +
                 let duration_days = int_of_float ((last_date -. first_date) /. 86400.0) in

     

       242
       242
       +
                 Printf.printf "Timespan: %s to %s (%d days)\n\n" first_str last_str duration_days

     

       243
       243
       +
             | _ -> ());

     

       244
       244
       +
             

     

       245
       245
       +
             (* Show message count by participant *)

     

       246
       246
       +
             let message_counts = sorted_emails |> List.fold_left (fun acc email ->

     

       247
       247
       +
               let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       248
       248
       +
               match from_list with

     

       249
       249
       +
               | addr :: _ ->

     

       250
       250
       +
                   let email = Types.Email_address.email addr in

     

       251
       251
       +
                   let count = try Hashtbl.find acc email with Not_found -> 0 in

     

       252
       252
       +
                   Hashtbl.replace acc email (count + 1);

     

       253
       253
       +
                   acc

     

       254
       254
       +
               | [] -> acc

     

       255
       255
       +
             ) (Hashtbl.create 10) in

     

       256
       256
       +
             

     

       257
       257
       +
             Printf.printf "Messages per participant:\n";

     

       258
       258
       +
             Hashtbl.iter (fun email count ->

     

       259
       259
       +
               Printf.printf "  %s: %d messages\n" email count

     

       260
       260
       +
             ) message_counts;

     

       261
       261
       +
             Printf.printf "\n"

     

       262
       262
       +
         

     

       263
       263
       +
         | `Detailed ->

     

       264
       264
       +
             Printf.printf "Thread: %s (%d messages)\n\n" thread_id email_count;

     

       265
       265
       +
             

     

       266
       266
       +
             (* Print detailed information for each email *)

     

       267
       267
       +
             sorted_emails |> List.iteri (fun i email ->

     

       268
       268
       +
               let id = Option.value (Types.Email.id email) ~default:"(unknown)" in

     

       269
       269
       +
               let subject = Option.value (Types.Email.subject email) ~default:"(No subject)" in

     

       270
       270
       +
               

     

       271
       271
       +
               let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       272
       272
       +
               let from = match from_list with

     

       273
       273
       +
                 | addr :: _ -> Types.Email_address.email addr

     

       274
       274
       +
                 | [] -> "(unknown)"

     

       275
       275
       +
               in

     

       276
       276
       +
               

     

       277
       277
       +
               let date = match Types.Email.received_at email with

     

       278
       278
       +
                 | Some d ->

     

       279
       279
       +
                     let datetime_str = ISO8601.string_of_datetime (Unix.gmtime d) in

     

       280
       280
       +
                     String.sub datetime_str 0 (min 19 (String.length datetime_str))

     

       281
       281
       +
                 | None -> "(unknown)"

     

       282
       282
       +
               in

     

       283
       283
       +
               

     

       284
       284
       +
               let days = match Types.Email.received_at email with

     

       285
       285
       +
                 | Some d -> Printf.sprintf " (%d days ago)" (days_ago d)

     

       286
       286
       +
                 | None -> ""

     

       287
       287
       +
               in

     

       288
       288
       +
               

     

       289
       289
       +
               Printf.printf "Email %d of %d:\n" (i+1) email_count;

     

       290
       290
       +
               Printf.printf "  ID:      %s\n" id;

     

       291
       291
       +
               Printf.printf "  Subject: %s\n" subject;

     

       292
       292
       +
               Printf.printf "  From:    %s\n" from;

     

       293
       293
       +
               Printf.printf "  Date:    %s%s\n" date days;

     

       294
       294
       +
               

     

       295
       295
       +
               let keywords = match Types.Email.keywords email with

     

       296
       296
       +
                 | Some kw -> Types.Keywords.custom_keywords kw |> String.concat ", "

     

       297
       297
       +
                 | None -> "(none)"

     

       298
       298
       +
               in

     

       299
       299
       +
               if keywords <> "(none)" then

     

       300
       300
       +
                 Printf.printf "  Flags:   %s\n" keywords;

     

       301
       301
       +
               

     

       302
       302
       +
               (* Show preview from snippet if available *)

     

       303
       303
       +
               Printf.printf "  Snippet: %s\n" (get_snippet id);

     

       304
       304
       +
               

     

       305
       305
       +
               (* Show message body if requested *)

     

       306
       306
       +
               if include_body then

     

       307
       307
       +
                 match Types.Email.text_body email with

     

       308
       308
       +
                 | Some parts when parts <> [] ->

     

       309
       309
       +
                     let first_part = List.hd parts in

     

       310
       310
       +
                     Printf.printf "  Body: %s\n" "(body content would be here in real implementation)";

     

       311
       311
       +
                 | _ -> ();

     

       312
       312
       +
               

     

       313
       313
       +
               Printf.printf "\n"

     

       314
       314
       +
             )

     

       315
       315
       +
         

     

       316
       316
       +
         | `Timeline ->

     

       317
       317
       +
             Printf.printf "Timeline for Thread: %s\n\n" thread_id;

     

       318
       318
       +
             

     

       319
       319
       +
             (* Get the first email's subject as thread subject *)

     

       320
       320
       +
             (match sorted_emails with

     

       321
       321
       +
             | first :: _ ->

     

       322
       322
       +
                 let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in

     

       323
       323
       +
                 Printf.printf "Subject: %s\n\n" subject

     

       324
       324
       +
             | [] -> Printf.printf "No emails available\n\n");

     

       325
       325
       +
             

     

       326
       326
       +
             (* Create a timeline visualization *)

     

       327
       327
       +
             if sorted_emails = [] then

     

       328
       328
       +
               Printf.printf "No emails to display\n"

     

       329
       329
       +
             else

     

       330
       330
       +
               let first_email = List.hd sorted_emails in

     

       331
       331
       +
               let last_email = List.hd (List.rev sorted_emails) in

     

       332
       332
       +
               

     

       333
       333
       +
               let first_date = Option.value (Types.Email.received_at first_email) ~default:0.0 in

     

       334
       334
       +
               let last_date = Option.value (Types.Email.received_at last_email) ~default:0.0 in

     

       335
       335
       +
               

     

       336
       336
       +
               let total_duration = max 1.0 (last_date -. first_date) in

     

       337
       337
       +
               let timeline_width = 50 in

     

       338
       338
       +
               

     

       339
       339
       +
               let datetime_str = ISO8601.string_of_datetime (Unix.gmtime first_date) in

     

       340
       340
       +
               let start_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       341
       341
       +
               Printf.printf "Start date: %s\n" start_str;

     

       342
       342
       +
               

     

       343
       343
       +
               let datetime_str = ISO8601.string_of_datetime (Unix.gmtime last_date) in

     

       344
       344
       +
               let end_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       345
       345
       +
               Printf.printf "End date:   %s\n\n" end_str;

     

       346
       346
       +
               

     

       347
       347
       +
               Printf.printf "Timeline: [%s]\n" (String.make timeline_width '-');

     

       348
       348
       +
               

     

       349
       349
       +
               sorted_emails |> List.iteri (fun i email ->

     

       350
       350
       +
                 let date = Option.value (Types.Email.received_at email) ~default:0.0 in

     

       351
       351
       +
                 let position = int_of_float (float_of_int timeline_width *. (date -. first_date) /. total_duration) in

     

       352
       352
       +
                 

     

       353
       353
       +
                 let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       354
       354
       +
                 let from = match from_list with

     

       355
       355
       +
                   | addr :: _ -> Types.Email_address.email addr

     

       356
       356
       +
                   | [] -> "(unknown)"

     

       357
       357
       +
                 in

     

       358
       358
       +
                 

     

       359
       359
       +
                 let datetime_str = ISO8601.string_of_datetime (Unix.gmtime date) in

     

       360
       360
       +
                 let date_str = String.sub datetime_str 0 (min 19 (String.length datetime_str)) in

     

       361
       361
       +
                 

     

       362
       362
       +
                 let marker = String.make timeline_width ' ' |> String.mapi (fun j c ->

     

       363
       363
       +
                   if j = position then '*' else if j < position then ' ' else c

     

       364
       364
       +
                 ) in

     

       365
       365
       +
                 

     

       366
       366
       +
                 Printf.printf "%s [%s] %s: %s\n" date_str marker from (get_snippet (Option.value (Types.Email.id email) ~default:""))

     

       367
       367
       +
               );

     

       368
       368
       +
               

     

       369
       369
       +
               Printf.printf "\n"

     

       370
       370
       +
         

     

       371
       371
       +
         | `Graph ->

     

       372
       372
       +
             Printf.printf "Thread Graph for: %s\n\n" thread_id;

     

       373
       373
       +
             

     

       374
       374
       +
             (* In a real implementation, this would build a proper thread graph based on

     

       375
       375
       +
                In-Reply-To and References headers. For this demo, we'll just show a simple tree. *)

     

       376
       376
       +
             

     

       377
       377
       +
             (* Get the first email's subject as thread subject *)

     

       378
       378
       +
             (match sorted_emails with

     

       379
       379
       +
             | first :: _ ->

     

       380
       380
       +
                 let subject = Option.value (Types.Email.subject first) ~default:"(No subject)" in

     

       381
       381
       +
                 Printf.printf "Subject: %s\n\n" subject

     

       382
       382
       +
             | [] -> Printf.printf "No emails available\n\n");

     

       383
       383
       +
             

     

       384
       384
       +
             (* Create a simple thread tree visualization *)

     

       385
       385
       +
             if sorted_emails = [] then

     

       386
       386
       +
               Printf.printf "No emails to display\n"

     

       387
       387
       +
             else

     

       388
       388
       +
               let indent level = String.make (level * 2) ' ' in

     

       389
       389
       +
               

     

       390
       390
       +
               (* Very simplified threading model - in a real implementation, 

     

       391
       391
       +
                  this would use In-Reply-To and References headers *)

     

       392
       392
       +
               sorted_emails |> List.iteri (fun i email ->

     

       393
       393
       +
                 let level = min i 4 in  (* Simplified nesting - would be based on real reply chain *)

     

       394
       394
       +
                 

     

       395
       395
       +
                 let id = Option.value (Types.Email.id email) ~default:"(unknown)" in

     

       396
       396
       +
                 

     

       397
       397
       +
                 let from_list = Option.value (Types.Email.from email) ~default:[] in

     

       398
       398
       +
                 let from = match from_list with

     

       399
       399
       +
                   | addr :: _ -> Types.Email_address.email addr

     

       400
       400
       +
                   | [] -> "(unknown)"

     

       401
       401
       +
                 in

     

       402
       402
       +
                 

     

       403
       403
       +
                 let date = match Types.Email.received_at email with

     

       404
       404
       +
                   | Some d -> 

     

       405
       405
       +
                       let datetime_str = ISO8601.string_of_datetime (Unix.gmtime d) in

     

       406
       406
       +
                       String.sub datetime_str 0 (min 19 (String.length datetime_str))

     

       407
       407
       +
                   | None -> "(unknown)"

     

       408
       408
       +
                 in

     

       409
       409
       +
                 

     

       410
       410
       +
                 Printf.printf "%s%s [%s] %s\n" 

     

       411
       411
       +
                   (indent level) 

     

       412
       412
       +
                   (if level = 0 then "+" else if level = 1 then "|-" else "|--")

     

       413
       413
       +
                   date from;

     

       414
       414
       +
                 

     

       415
       415
       +
                 Printf.printf "%s%s\n" (indent (level + 4)) (get_snippet id);

     

       416
       416
       +
               );

     

       417
       417
       +
               

     

       418
       418
       +
               Printf.printf "\n"

     

       419
       419
       +
       

     

       420
       420
       +
       (* Command implementation *)

     

       421
       421
       +
       let thread_command host user password thread_id search limit days subject 

     

       422
       422
       +
                           participant format include_body : int =

     

       423
       423
       +
         (* Pack arguments into a record for easier passing *)

     

       424
       424
       +
         let args : thread_analyzer_args = {

     

       425
       425
       +
           thread_id; search; limit; days; subject; 

     

       426
       426
       +
           participants = participant; format; include_body

     

       427
       427
       +
         } in

     

       428
       428
       +
         

     

       429
       429
       +
         (* Main workflow would be implemented here using the JMAP library *)

     

       430
       430
       +
         Printf.printf "JMAP Thread Analyzer\n";

     

       431
       431
       +
         Printf.printf "Server: %s\n" host;

     

       432
       432
       +
         Printf.printf "User: %s\n\n" user;

     

       433
       433
       +
         

     

       434
       434
       +
         (* This is where the actual JMAP calls would happen, like:

     

       435
       435
       +
         

     

       436
       436
       +
         let analyze_threads () =

     

       437
       437
       +
           let* (ctx, session) = Jmap.Unix.connect 

     

       438
       438
       +
             ~host ~username:user ~password 

     

       439
       439
       +
             ~auth_method:(Jmap.Unix.Basic(user, password)) () in

     

       440
       440
       +
           

     

       441
       441
       +
           (* Get primary account ID *)

     

       442
       442
       +
           let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       443
       443
       +
             | Ok id -> id

     

       444
       444
       +
             | Error _ -> failwith "No mail account found"

     

       445
       445
       +
           in

     

       446
       446
       +
           

     

       447
       447
       +
           match args.thread_id with

     

       448
       448
       +
           | Some id ->

     

       449
       449
       +
               (* Analyze a specific thread by ID *)

     

       450
       450
       +
               let* thread_result = Thread.get ctx

     

       451
       451
       +
                 ~account_id

     

       452
       452
       +
                 ~ids:[id] in

     

       453
       453
       +
               

     

       454
       454
       +
               (* Handle thread fetch result *)

     

       455
       455
       +
               ...

     

       456
       456
       +
               

     

       457
       457
       +
           | None ->

     

       458
       458
       +
               (* Search for threads based on criteria *)

     

       459
       459
       +
               let filter = create_thread_filter args in

     

       460
       460
       +
               

     

       461
       461
       +
               (* Email/query to find emails matching criteria *)

     

       462
       462
       +
               let* query_result = Email.query ctx

     

       463
       463
       +
                 ~account_id

     

       464
       464
       +
                 ~filter

     

       465
       465
       +
                 ~sort:[Email_sort.received_newest_first ()]

     

       466
       466
       +
                 ~collapse_threads:true

     

       467
       467
       +
                 ~limit:args.limit in

     

       468
       468
       +
               

     

       469
       469
       +
               (* Process query results to get thread IDs *)

     

       470
       470
       +
               ...

     

       471
       471
       +
         *)

     

       472
       472
       +
         

     

       473
       473
       +
         (match thread_id with

     

       474
       474
       +
         | Some id ->

     

       475
       475
       +
             Printf.printf "Analyzing thread: %s\n\n" id;

     

       476
       476
       +
             

     

       477
       477
       +
             (* Simulate a thread with some emails *)

     

       478
       478
       +
             let emails = 5 in

     

       479
       479
       +
             Printf.printf "Thread contains %d emails\n" emails;

     

       480
       480
       +
             

     

       481
       481
       +
             (* In a real implementation, we would display the actual thread data here *)

     

       482
       482
       +
             Printf.printf "Example output format would show thread details here\n"

     

       483
       483
       +
         

     

       484
       484
       +
         | None ->

     

       485
       485
       +
             if search <> None then

     

       486
       486
       +
               Printf.printf "Searching for threads containing: %s\n" (Option.get search)

     

       487
       487
       +
             else if subject <> None then

     

       488
       488
       +
               Printf.printf "Searching for threads with subject: %s\n" (Option.get subject)

     

       489
       489
       +
             else

     

       490
       490
       +
               Printf.printf "No specific thread or search criteria provided\n");

     

       491
       491
       +
             

     

       492
       492
       +
             if participant <> [] then

     

       493
       493
       +
               Printf.printf "Filtering to threads involving: %s\n" 

     

       494
       494
       +
                 (String.concat ", " participant);

     

       495
       495
       +
             

     

       496
       496
       +
             Printf.printf "Looking at threads from the past %d days\n" days;

     

       497
       497
       +
             Printf.printf "Showing up to %d threads\n\n" limit;

     

       498
       498
       +
             

     

       499
       499
       +
             (* Simulate finding some threads *)

     

       500
       500
       +
             let thread_count = min limit 3 in

     

       501
       501
       +
             Printf.printf "Found %d matching threads\n\n" thread_count;

     

       502
       502
       +
             

     

       503
       503
       +
             (* In a real implementation, we would display the actual threads here *)

     

       504
       504
       +
             for i = 1 to thread_count do

     

       505
       505
       +
               Printf.printf "Thread %d would be displayed here\n\n" i

     

       506
       506
       +
             done;

     

       507
       507
       +
         

     

       508
       508
       +
         (* Since we're only type checking, we'll exit with success *)

     

       509
       509
       +
         0

     

       510
       510
       +
       

     

       511
       511
       +
       (* Command definition *)

     

       512
       512
       +
       let thread_cmd =

     

       513
       513
       +
         let doc = "analyze email threads using JMAP" in

     

       514
       514
       +
         let man = [

     

       515
       515
       +
           `S Manpage.s_description;

     

       516
       516
       +
           `P "Analyzes email threads with detailed visualization options.";

     

       517
       517
       +
           `P "Demonstrates how to work with JMAP's thread capabilities.";

     

       518
       518
       +
           `S Manpage.s_examples;

     

       519
       519
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 -t thread123";

     

       520
       520
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --search \"project update\" --format timeline";

     

       521
       521
       +
         ] in

     

       522
       522
       +
         

     

       523
       523
       +
         let cmd =

     

       524
       524
       +
           Cmd.v

     

       525
       525
       +
             (Cmd.info "jmap-thread-analyzer" ~version:"1.0" ~doc ~man)

     

       526
       526
       +
             Term.(const thread_command $ host_arg $ user_arg $ password_arg $ 

     

       527
       527
       +
                   thread_id_arg $ search_arg $ limit_arg $ days_arg $ 

     

       528
       528
       +
                   subject_arg $ participant_arg $ format_arg $ include_body_arg)

     

       529
       529
       +
         in

     

       530
       530
       +
         cmd

     

       531
       531
       +
       

     

       532
       532
       +
       (* Main entry point *)

     

       533
       533
       +
       let () = exit (Cmd.eval' thread_cmd)

+406

bin/jmap_vacation_manager.ml

···

       1
       1
       +
       (*

     

       2
       2
       +
        * jmap_vacation_manager.ml - Manage vacation/out-of-office auto-responses

     

       3
       3
       +
        *

     

       4
       4
       +
        * This binary demonstrates JMAP's vacation response capabilities for setting

     

       5
       5
       +
        * up and managing automatic email responses.

     

       6
       6
       +
        *

     

       7
       7
       +
        * For step 2, we're only testing type checking. No implementations required.

     

       8
       8
       +
        *)

     

       9
       9
       +
       

     

       10
       10
       +
       open Cmdliner

     

       11
       11
       +
       

     

       12
       12
       +
       (** Vacation response actions **)

     

       13
       13
       +
       type vacation_action = 

     

       14
       14
       +
         | Show

     

       15
       15
       +
         | Enable of vacation_config

     

       16
       16
       +
         | Disable

     

       17
       17
       +
         | Update of vacation_config

     

       18
       18
       +
       

     

       19
       19
       +
       and vacation_config = {

     

       20
       20
       +
         subject : string option;

     

       21
       21
       +
         text_body : string;

     

       22
       22
       +
         html_body : string option;

     

       23
       23
       +
         from_date : float option;

     

       24
       24
       +
         to_date : float option;

     

       25
       25
       +
         exclude_addresses : string list;

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

       28
       28
       +
       (** Command-line arguments **)

     

       29
       29
       +
       

     

       30
       30
       +
       let host_arg =

     

       31
       31
       +
         Arg.(required & opt (some string) None & info ["h"; "host"] 

     

       32
       32
       +
              ~docv:"HOST" ~doc:"JMAP server hostname")

     

       33
       33
       +
       

     

       34
       34
       +
       let user_arg =

     

       35
       35
       +
         Arg.(required & opt (some string) None & info ["u"; "user"] 

     

       36
       36
       +
              ~docv:"USERNAME" ~doc:"Username for authentication")

     

       37
       37
       +
       

     

       38
       38
       +
       let password_arg =

     

       39
       39
       +
         Arg.(required & opt (some string) None & info ["p"; "password"] 

     

       40
       40
       +
              ~docv:"PASSWORD" ~doc:"Password for authentication")

     

       41
       41
       +
       

     

       42
       42
       +
       let enable_arg =

     

       43
       43
       +
         Arg.(value & flag & info ["e"; "enable"] 

     

       44
       44
       +
              ~doc:"Enable vacation response")

     

       45
       45
       +
       

     

       46
       46
       +
       let disable_arg =

     

       47
       47
       +
         Arg.(value & flag & info ["d"; "disable"] 

     

       48
       48
       +
              ~doc:"Disable vacation response")

     

       49
       49
       +
       

     

       50
       50
       +
       let show_arg =

     

       51
       51
       +
         Arg.(value & flag & info ["s"; "show"] 

     

       52
       52
       +
              ~doc:"Show current vacation settings")

     

       53
       53
       +
       

     

       54
       54
       +
       let subject_arg =

     

       55
       55
       +
         Arg.(value & opt (some string) None & info ["subject"] 

     

       56
       56
       +
              ~docv:"SUBJECT" ~doc:"Vacation email subject line")

     

       57
       57
       +
       

     

       58
       58
       +
       let message_arg =

     

       59
       59
       +
         Arg.(value & opt (some string) None & info ["m"; "message"] 

     

       60
       60
       +
              ~docv:"TEXT" ~doc:"Vacation message text")

     

       61
       61
       +
       

     

       62
       62
       +
       let message_file_arg =

     

       63
       63
       +
         Arg.(value & opt (some string) None & info ["message-file"] 

     

       64
       64
       +
              ~docv:"FILE" ~doc:"Read vacation message from file")

     

       65
       65
       +
       

     

       66
       66
       +
       let html_message_arg =

     

       67
       67
       +
         Arg.(value & opt (some string) None & info ["html-message"] 

     

       68
       68
       +
              ~docv:"HTML" ~doc:"HTML vacation message")

     

       69
       69
       +
       

     

       70
       70
       +
       let from_date_arg =

     

       71
       71
       +
         Arg.(value & opt (some string) None & info ["from-date"] 

     

       72
       72
       +
              ~docv:"DATE" ~doc:"Start date for vacation (YYYY-MM-DD)")

     

       73
       73
       +
       

     

       74
       74
       +
       let to_date_arg =

     

       75
       75
       +
         Arg.(value & opt (some string) None & info ["to-date"] 

     

       76
       76
       +
              ~docv:"DATE" ~doc:"End date for vacation (YYYY-MM-DD)")

     

       77
       77
       +
       

     

       78
       78
       +
       let exclude_arg =

     

       79
       79
       +
         Arg.(value & opt_all string [] & info ["exclude"] 

     

       80
       80
       +
              ~docv:"EMAIL" ~doc:"Email address to exclude from auto-response")

     

       81
       81
       +
       

     

       82
       82
       +
       (** Helper functions **)

     

       83
       83
       +
       

     

       84
       84
       +
       (* Parse date string to Unix timestamp *)

     

       85
       85
       +
       let parse_date date_str =

     

       86
       86
       +
         try

     

       87
       87
       +
           let (year, month, day) = Scanf.sscanf date_str "%d-%d-%d" (fun y m d -> (y, m, d)) in

     

       88
       88
       +
           let tm = Unix.{ tm_sec = 0; tm_min = 0; tm_hour = 0;

     

       89
       89
       +
                           tm_mday = day; tm_mon = month - 1; tm_year = year - 1900;

     

       90
       90
       +
                           tm_wday = 0; tm_yday = 0; tm_isdst = false } in

     

       91
       91
       +
           Some (Unix.mktime tm |> fst)

     

       92
       92
       +
         with _ ->

     

       93
       93
       +
           Printf.eprintf "Invalid date format: %s (use YYYY-MM-DD)\n" date_str;

     

       94
       94
       +
           None

     

       95
       95
       +
       

     

       96
       96
       +
       (* Format Unix timestamp as date string *)

     

       97
       97
       +
       let format_date timestamp =

     

       98
       98
       +
         let tm = Unix.localtime timestamp in

     

       99
       99
       +
         Printf.sprintf "%04d-%02d-%02d"

     

       100
       100
       +
           (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday

     

       101
       101
       +
       

     

       102
       102
       +
       (* Read file contents *)

     

       103
       103
       +
       let read_file filename =

     

       104
       104
       +
         let ic = open_in filename in

     

       105
       105
       +
         let len = in_channel_length ic in

     

       106
       106
       +
         let content = really_input_string ic len in

     

       107
       107
       +
         close_in ic;

     

       108
       108
       +
         content

     

       109
       109
       +
       

     

       110
       110
       +
       (* Display vacation response settings *)

     

       111
       111
       +
       let show_vacation_response vacation =

     

       112
       112
       +
         Printf.printf "\nVacation Response Settings:\n";

     

       113
       113
       +
         Printf.printf "==========================\n\n";

     

       114
       114
       +
         

     

       115
       115
       +
         Printf.printf "Status: %s\n" 

     

       116
       116
       +
           (if Jmap_email.Vacation.Vacation_response.is_enabled vacation then "ENABLED" else "DISABLED");

     

       117
       117
       +
         

     

       118
       118
       +
         (match Jmap_email.Vacation.Vacation_response.subject vacation with

     

       119
       119
       +
         | Some subj -> Printf.printf "Subject: %s\n" subj

     

       120
       120
       +
         | None -> Printf.printf "Subject: (default)\n");

     

       121
       121
       +
         

     

       122
       122
       +
         (match Jmap_email.Vacation.Vacation_response.text_body vacation with

     

       123
       123
       +
         | Some body -> 

     

       124
       124
       +
             Printf.printf "\nMessage:\n";

     

       125
       125
       +
             Printf.printf "--------\n";

     

       126
       126
       +
             Printf.printf "%s\n" body;

     

       127
       127
       +
             Printf.printf "--------\n"

     

       128
       128
       +
         | None -> Printf.printf "\nMessage: (none set)\n");

     

       129
       129
       +
         

     

       130
       130
       +
         (match Jmap_email.Vacation.Vacation_response.from_date vacation with

     

       131
       131
       +
         | Some date -> Printf.printf "\nActive from: %s\n" (format_date date)

     

       132
       132
       +
         | None -> ());

     

       133
       133
       +
         

     

       134
       134
       +
         (match Jmap_email.Vacation.Vacation_response.to_date vacation with

     

       135
       135
       +
         | Some date -> Printf.printf "Active until: %s\n" (format_date date)

     

       136
       136
       +
         | None -> ());

     

       137
       137
       +
         

     

       138
       138
       +
         let excluded = match Jmap_email.Vacation.Vacation_response.id vacation with

     

       139
       139
       +
           | _ -> []  (* exclude_addresses not available in interface *) in

     

       140
       140
       +
         if excluded <> [] then (

     

       141
       141
       +
           Printf.printf "\nExcluded addresses:\n";

     

       142
       142
       +
           List.iter (Printf.printf "  - %s\n") excluded

     

       143
       143
       +
         )

     

       144
       144
       +
       

     

       145
       145
       +
       (* Get current vacation response *)

     

       146
       146
       +
       let get_vacation_response ctx session account_id =

     

       147
       147
       +
         let get_args = Jmap.Methods.Get_args.v

     

       148
       148
       +
           ~account_id

     

       149
       149
       +
           ~properties:["isEnabled"; "subject"; "textBody"; "htmlBody"; 

     

       150
       150
       +
                        "fromDate"; "toDate"; "excludeAddresses"]

     

       151
       151
       +
           () in

     

       152
       152
       +
           

     

       153
       153
       +
         let invocation = Jmap.Wire.Invocation.v

     

       154
       154
       +
           ~method_name:"VacationResponse/get"

     

       155
       155
       +
           ~arguments:(`Assoc []) (* Would serialize get_args *)

     

       156
       156
       +
           ~method_call_id:"get1"

     

       157
       157
       +
           () in

     

       158
       158
       +
           

     

       159
       159
       +
         let request = Jmap.Wire.Request.v

     

       160
       160
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]

     

       161
       161
       +
           ~method_calls:[invocation]

     

       162
       162
       +
           () in

     

       163
       163
       +
           

     

       164
       164
       +
         match Jmap_unix.request ctx request with

     

       165
       165
       +
         | Ok _ ->

     

       166
       166
       +
             (* Would extract from response - for now create a sample *)

     

       167
       167
       +
             Ok (Jmap_email.Vacation.Vacation_response.v

     

       168
       168
       +
               ~id:"vacation1"

     

       169
       169
       +
               ~is_enabled:false

     

       170
       170
       +
               ~subject:"Out of Office"

     

       171
       171
       +
               ~text_body:"I am currently out of the office and will respond when I return."

     

       172
       172
       +
               ())

     

       173
       173
       +
         | Error e -> Error e

     

       174
       174
       +
       

     

       175
       175
       +
       (* Update vacation response *)

     

       176
       176
       +
       let update_vacation_response ctx session account_id vacation_id updates =

     

       177
       177
       +
         let update_map = Hashtbl.create 1 in

     

       178
       178
       +
         Hashtbl.add update_map vacation_id updates;

     

       179
       179
       +
         

     

       180
       180
       +
         let set_args = Jmap.Methods.Set_args.v

     

       181
       181
       +
           ~account_id

     

       182
       182
       +
           ~update:update_map

     

       183
       183
       +
           () in

     

       184
       184
       +
           

     

       185
       185
       +
         let invocation = Jmap.Wire.Invocation.v

     

       186
       186
       +
           ~method_name:"VacationResponse/set"

     

       187
       187
       +
           ~arguments:(`Assoc []) (* Would serialize set_args *)

     

       188
       188
       +
           ~method_call_id:"set1"

     

       189
       189
       +
           () in

     

       190
       190
       +
           

     

       191
       191
       +
         let request = Jmap.Wire.Request.v

     

       192
       192
       +
           ~using:[Jmap.capability_core; Jmap_email.capability_mail; Jmap_email.capability_vacationresponse]

     

       193
       193
       +
           ~method_calls:[invocation]

     

       194
       194
       +
           () in

     

       195
       195
       +
           

     

       196
       196
       +
         match Jmap_unix.request ctx request with

     

       197
       197
       +
         | Ok _ -> Ok ()

     

       198
       198
       +
         | Error e -> Error e

     

       199
       199
       +
       

     

       200
       200
       +
       (* Process vacation action *)

     

       201
       201
       +
       let process_vacation_action ctx session account_id action =

     

       202
       202
       +
         match action with

     

       203
       203
       +
         | Show ->

     

       204
       204
       +
             (match get_vacation_response ctx session account_id with

     

       205
       205
       +
             | Ok vacation ->

     

       206
       206
       +
                 show_vacation_response vacation;

     

       207
       207
       +
                 0

     

       208
       208
       +
             | Error e ->

     

       209
       209
       +
                 Printf.eprintf "Failed to get vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       210
       210
       +
                 1)

     

       211
       211
       +
             

     

       212
       212
       +
         | Enable config ->

     

       213
       213
       +
             Printf.printf "Enabling vacation response...\n";

     

       214
       214
       +
             

     

       215
       215
       +
             (* Build the vacation response object *)

     

       216
       216
       +
             let vacation = Jmap_email.Vacation.Vacation_response.v

     

       217
       217
       +
               ~id:"singleton"

     

       218
       218
       +
               ~is_enabled:true

     

       219
       219
       +
               ?subject:config.subject

     

       220
       220
       +
               ~text_body:config.text_body

     

       221
       221
       +
               ?html_body:config.html_body

     

       222
       222
       +
               ?from_date:config.from_date

     

       223
       223
       +
               ?to_date:config.to_date

     

       224
       224
       +
               () in

     

       225
       225
       +
               

     

       226
       226
       +
             (match update_vacation_response ctx session account_id "singleton" vacation with

     

       227
       227
       +
             | Ok () ->

     

       228
       228
       +
                 Printf.printf "\nVacation response enabled successfully!\n";

     

       229
       229
       +
                 

     

       230
       230
       +
                 (* Show what was set *)

     

       231
       231
       +
                 show_vacation_response vacation;

     

       232
       232
       +
                 0

     

       233
       233
       +
             | Error e ->

     

       234
       234
       +
                 Printf.eprintf "Failed to enable vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       235
       235
       +
                 1)

     

       236
       236
       +
             

     

       237
       237
       +
         | Disable ->

     

       238
       238
       +
             Printf.printf "Disabling vacation response...\n";

     

       239
       239
       +
             

     

       240
       240
       +
             let updates = Jmap_email.Vacation.Vacation_response.v

     

       241
       241
       +
               ~id:"singleton"

     

       242
       242
       +
               ~is_enabled:false

     

       243
       243
       +
               () in

     

       244
       244
       +
               

     

       245
       245
       +
             (match update_vacation_response ctx session account_id "singleton" updates with

     

       246
       246
       +
             | Ok () ->

     

       247
       247
       +
                 Printf.printf "Vacation response disabled successfully!\n";

     

       248
       248
       +
                 0

     

       249
       249
       +
             | Error e ->

     

       250
       250
       +
                 Printf.eprintf "Failed to disable vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       251
       251
       +
                 1)

     

       252
       252
       +
             

     

       253
       253
       +
         | Update config ->

     

       254
       254
       +
             Printf.printf "Updating vacation response...\n";

     

       255
       255
       +
             

     

       256
       256
       +
             (* Only update specified fields *)

     

       257
       257
       +
             let vacation = Jmap_email.Vacation.Vacation_response.v

     

       258
       258
       +
               ~id:"singleton"

     

       259
       259
       +
               ?subject:config.subject

     

       260
       260
       +
               ~text_body:config.text_body

     

       261
       261
       +
               ?html_body:config.html_body

     

       262
       262
       +
               ?from_date:config.from_date

     

       263
       263
       +
               ?to_date:config.to_date

     

       264
       264
       +
               () in

     

       265
       265
       +
               

     

       266
       266
       +
             (match update_vacation_response ctx session account_id "singleton" vacation with

     

       267
       267
       +
             | Ok () ->

     

       268
       268
       +
                 Printf.printf "Vacation response updated successfully!\n";

     

       269
       269
       +
                 

     

       270
       270
       +
                 (* Show current settings *)

     

       271
       271
       +
                 (match get_vacation_response ctx session account_id with

     

       272
       272
       +
                 | Ok current -> show_vacation_response current

     

       273
       273
       +
                 | Error _ -> ());

     

       274
       274
       +
                 0

     

       275
       275
       +
             | Error e ->

     

       276
       276
       +
                 Printf.eprintf "Failed to update vacation response: %s\n" (Jmap.Error.error_to_string e);

     

       277
       277
       +
                 1)

     

       278
       278
       +
       

     

       279
       279
       +
       (* Command implementation *)

     

       280
       280
       +
       let vacation_command host user password enable disable show subject message 

     

       281
       281
       +
                            message_file html_message from_date to_date exclude : int =

     

       282
       282
       +
         Printf.printf "JMAP Vacation Manager\n";

     

       283
       283
       +
         Printf.printf "Server: %s\n" host;

     

       284
       284
       +
         Printf.printf "User: %s\n\n" user;

     

       285
       285
       +
         

     

       286
       286
       +
         (* Determine action *)

     

       287
       287
       +
         let action_count = (if enable then 1 else 0) + 

     

       288
       288
       +
                            (if disable then 1 else 0) + 

     

       289
       289
       +
                            (if show then 1 else 0) in

     

       290
       290
       +
                            

     

       291
       291
       +
         if action_count = 0 then (

     

       292
       292
       +
           Printf.eprintf "Error: Must specify an action: --enable, --disable, or --show\n";

     

       293
       293
       +
           exit 1

     

       294
       294
       +
         );

     

       295
       295
       +
         

     

       296
       296
       +
         if action_count > 1 then (

     

       297
       297
       +
           Printf.eprintf "Error: Can only specify one action at a time\n";

     

       298
       298
       +
           exit 1

     

       299
       299
       +
         );

     

       300
       300
       +
         

     

       301
       301
       +
         (* Build vacation config if enabling or updating *)

     

       302
       302
       +
         let config = if enable || (not disable && not show) then

     

       303
       303
       +
           (* Read message content *)

     

       304
       304
       +
           let text_body = match message, message_file with

     

       305
       305
       +
             | Some text, _ -> text

     

       306
       306
       +
             | None, Some file -> read_file file

     

       307
       307
       +
             | None, None ->

     

       308
       308
       +
                 if enable then (

     

       309
       309
       +
                   Printf.eprintf "Error: Must provide vacation message (--message or --message-file)\n";

     

       310
       310
       +
                   exit 1

     

       311
       311
       +
                 ) else ""

     

       312
       312
       +
           in

     

       313
       313
       +
           

     

       314
       314
       +
           (* Parse dates *)

     

       315
       315
       +
           let from_date = match from_date with

     

       316
       316
       +
             | Some date_str -> parse_date date_str

     

       317
       317
       +
             | None -> None

     

       318
       318
       +
           in

     

       319
       319
       +
           

     

       320
       320
       +
           let to_date = match to_date with

     

       321
       321
       +
             | Some date_str -> parse_date date_str

     

       322
       322
       +
             | None -> None

     

       323
       323
       +
           in

     

       324
       324
       +
           

     

       325
       325
       +
           Some {

     

       326
       326
       +
             subject;

     

       327
       327
       +
             text_body;

     

       328
       328
       +
             html_body = html_message;

     

       329
       329
       +
             from_date;

     

       330
       330
       +
             to_date;

     

       331
       331
       +
             exclude_addresses = exclude;

     

       332
       332
       +
           }

     

       333
       333
       +
         else

     

       334
       334
       +
           None

     

       335
       335
       +
         in

     

       336
       336
       +
         

     

       337
       337
       +
         (* Determine action *)

     

       338
       338
       +
         let action = 

     

       339
       339
       +
           if show then Show

     

       340
       340
       +
           else if disable then Disable

     

       341
       341
       +
           else if enable then Enable (Option.get config)

     

       342
       342
       +
           else Update (Option.get config)

     

       343
       343
       +
         in

     

       344
       344
       +
         

     

       345
       345
       +
         (* Connect to server *)

     

       346
       346
       +
         let ctx = Jmap_unix.create_client () in

     

       347
       347
       +
         let result = Jmap_unix.quick_connect ~host ~username:user ~password in

     

       348
       348
       +
         

     

       349
       349
       +
         let (ctx, session) = match result with

     

       350
       350
       +
           | Ok (ctx, session) -> (ctx, session)

     

       351
       351
       +
           | Error e -> 

     

       352
       352
       +
               Printf.eprintf "Connection failed: %s\n" (Jmap.Error.error_to_string e);

     

       353
       353
       +
               exit 1

     

       354
       354
       +
         in

     

       355
       355
       +
         

     

       356
       356
       +
         (* Check vacation capability *)

     

       357
       357
       +
         (* Note: has_capability not available in interface, assuming server supports it *)

     

       358
       358
       +
         

     

       359
       359
       +
         (* Get the primary account ID *)

     

       360
       360
       +
         let account_id = match Jmap.get_primary_account session Jmap_email.capability_mail with

     

       361
       361
       +
           | Ok id -> id

     

       362
       362
       +
           | Error e -> 

     

       363
       363
       +
               Printf.eprintf "No mail account found: %s\n" (Jmap.Error.error_to_string e);

     

       364
       364
       +
               exit 1

     

       365
       365
       +
         in

     

       366
       366
       +
         

     

       367
       367
       +
         (* Process the action *)

     

       368
       368
       +
         process_vacation_action ctx session account_id action

     

       369
       369
       +
       

     

       370
       370
       +
       (* Command definition *)

     

       371
       371
       +
       let vacation_cmd =

     

       372
       372
       +
         let doc = "manage vacation/out-of-office auto-responses" in

     

       373
       373
       +
         let man = [

     

       374
       374
       +
           `S Manpage.s_description;

     

       375
       375
       +
           `P "Manage vacation responses (out-of-office auto-replies) via JMAP.";

     

       376
       376
       +
           `P "Configure automatic email responses for when you're away.";

     

       377
       377
       +
           `S Manpage.s_examples;

     

       378
       378
       +
           `P "Show current vacation settings:";

     

       379
       379
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --show";

     

       380
       380
       +
           `P "";

     

       381
       381
       +
           `P "Enable vacation response:";

     

       382
       382
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --enable \\";

     

       383
       383
       +
           `P "    --subject \"Out of Office\" \\";

     

       384
       384
       +
           `P "    --message \"I am currently out of the office and will return on Monday.\"";

     

       385
       385
       +
           `P "";

     

       386
       386
       +
           `P "Enable with date range:";

     

       387
       387
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --enable \\";

     

       388
       388
       +
           `P "    --message-file vacation.txt \\";

     

       389
       389
       +
           `P "    --from-date 2024-07-01 --to-date 2024-07-15";

     

       390
       390
       +
           `P "";

     

       391
       391
       +
           `P "Disable vacation response:";

     

       392
       392
       +
           `P "  $(mname) -h jmap.example.com -u user@example.com -p secret123 --disable";

     

       393
       393
       +
         ] in

     

       394
       394
       +
         

     

       395
       395
       +
         let cmd =

     

       396
       396
       +
           Cmd.v

     

       397
       397
       +
             (Cmd.info "jmap-vacation-manager" ~version:"1.0" ~doc ~man)

     

       398
       398
       +
             Term.(const vacation_command $ host_arg $ user_arg $ password_arg $ 

     

       399
       399
       +
                   enable_arg $ disable_arg $ show_arg $ subject_arg $ message_arg $

     

       400
       400
       +
                   message_file_arg $ html_message_arg $ from_date_arg $ to_date_arg $

     

       401
       401
       +
                   exclude_arg)

     

       402
       402
       +
         in

     

       403
       403
       +
         cmd

     

       404
       404
       +
       

     

       405
       405
       +
       (* Main entry point *)

     

       406
       406
       +
       let () = exit (Cmd.eval' vacation_cmd)

-1

dune

···

       1
       1
       -
       (dirs jmap jmap-email)

+2 -1

jmap-unix/dune

···

       2
       2
        
        (name jmap_unix)

     

       3
       3
        
        (public_name jmap-unix)

     

       4
       4
        
        (libraries jmap jmap-email yojson uri unix)

     

       5
       5
       -
        (modules jmap_unix))
     

       5
       5
       +
        (modules_without_implementation jmap_unix)

     

       6
       6
       +
        (modules jmap_unix))