File: mbox_list.ml

package info (click to toggle)
ocamlnet 4.1.2-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 51,764 kB
  • ctags: 16,446
  • sloc: ml: 148,419; ansic: 10,989; sh: 1,885; makefile: 1,355
file content (146 lines) | stat: -rw-r--r-- 4,036 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
(* Copyright (c) 2000 Patrick Doane.
 * For conditions of distribution and use, see copyright notice in LICENSE, *)

open Netchannels
open Printf

module U = Unix

let () =
  Nettls_gnutls.init()

let bracket
    (before : 'a -> 'b)
    (after : 'b -> unit)
    (f : 'b -> 'c)
    (init : 'a) =
  let x = before init in
  let res =
    try f x with exn -> after x; raise exn
  in
  after x;
  res

let prompt ?(echo=true) s =
  output_string stdout s;
  flush stdout;
  if echo then
    input_line stdin
  else
    let fd = U.descr_of_in_channel stdin in
    let tio = U.tcgetattr fd in
    let old_echo = tio.U.c_echo in
    bracket
      (fun () ->
	(* Modify terminal settings to turn echo off *)
	tio.U.c_echo <- false;
	U.tcsetattr fd U.TCSADRAIN tio)
      (fun () ->
	(* Restore terminal settings *)
	tio.U.c_echo <- old_echo;
	U.tcsetattr fd U.TCSADRAIN tio;
	output_char stdout '\n';
	flush stdout)
      (fun _ ->
	(* Get password from stdin *)
	input_line stdin
      ) ()

let connect_to (server, port) =
  let inet_addr = (U.gethostbyname server).U.h_addr_list.(0) in
  let addr = U.ADDR_INET (inet_addr, port) in
  U.open_connection addr

let close_connection (ic,oc) =
  U.shutdown_connection ic;
  close_out oc

let make_connection server port f =
  bracket connect_to close_connection f (server,port)

let pop3_session =
  bracket 
    (fun (ic,oc) -> new Netpop.client
      (new input_channel ic) (new output_channel oc))
    (fun sess -> 
      printf "Closing mailbox...\n"; flush stdout; 
      sess#quit ())

let main () =
  let user = Netsaslprep.saslprep (prompt "User: ") in
  let server = prompt "Hostname: " in
  let passwd = Netsaslprep.saslprep (prompt ~echo:false "Password: ") in
  let tls_config = 
    Netsys_tls.create_x509_config
      ~system_trust:true
      ~peer_auth:`Required    (* try `None if TLS does not work *)
      (Netsys_crypto.current_tls()) in
  try
    make_connection server Netpop.tcp_port (pop3_session
      (fun sess ->
        printf "Trying to start TLS...\n%!";
        Netpop.authenticate
          ~tls_config
          ~tls_peer:server
          sess;
        if sess#tls_endpoint <> None then
          printf "TLS succeeded\n%!"
        else
          printf "No TLS\n%!";
	printf "Attempting authentication...\n%!";
        ( try
            Netpop.authenticate
              ~sasl_mechs:[ (module Netmech_scram_sasl.SCRAM_SHA1);
                            (module Netmech_digest_sasl.DIGEST_MD5);
                            (module Netmech_crammd5_sasl.CRAM_MD5);
                            (module Netmech_plain_sasl.PLAIN);
                          ]
              ~user
              ~creds:[ "password", passwd, [] ]
              ~sasl_params:[ "secure", 
                             string_of_bool (sess#tls_endpoint = None),
                             true ]
              (* i.e. if there is no TLS, disallow insecure SASL mechs *)
              sess;
          with
            | Netpop.Authentication_error ->
                 printf "SASL failed, trying APOP\n%!";
                 ( try
	           sess#apop user passwd;
	           with _ when sess#tls_endpoint <> None ->
	             printf "APOP failed, trying plaintext password.\n%!";
	             sess#user user; 
	             sess#pass passwd;
                 )
        );
	printf "Successfully opened mailbox!\n%!";
	
	let count,_,_ = sess#stat () in
	printf "Mailbox has %d messages\n%!" count;
	
	for i = 1 to count do
	  printf "message %d\n" i;
	  let hdr = sess#top i () in
	  let hdr = (string_of_in_obj_channel hdr) ^ "\n" in
	  let fields, _ = 
	    Netmime_string.scan_header hdr 0 (String.length hdr)
	  in
	  List.iter (fun (name,body) ->
	    printf "%s: %s\n" name body;
	    flush stdout
          ) fields
	done;
	
	flush stdout;
      )
    )
  with
    | Not_found ->
         printf "Error finding host %s\n%!" server
    | Netpop.Authentication_error ->
         printf "Cannot authenticate\n%!"
;;

(* Netpop.Debug.enable := true;; *)

U.handle_unix_error main ()