(************************************************************
   easy_biff.ml		Created      : Sun Mar  2 16:54:37 2003
  			Last modified: Thu Mar 06 00:43:06 2003
  Compile: ocamlc -g -thread -I +labltk str.cma /usr/local/lib/ocaml/unix.cma threads.cma labltk.cma mytcp.ml pop.ml easy_biff.ml -o easy_biff #
  FTP Directory: sources/ocaml #
************************************************************)
(**

  @author Takashi Masuyama <mamewo@dk9.so-net.ne.jp>
   パスワードを再入力できるようにした。
   そしてSTATのループ前にあらかじめチェックすることにした。
 *)

open Tk

module Unix = UnixLabels

let color_changed = `Red
let color_unchanged = `Black
let pop_port = 110
let wait_time = 60.0 *. 1.0
(*let wait_time = 20.0*)
let width = 43
let height = 19 

let get_password message passref ~window =
  let label = Label.create ~text:message window in
  let e = Entry.create ~show:'*' ~width:10 ~state:`Normal window in
  let end_function event =  
    passref := Entry.get e; destroy window in
  begin
(*    キーの名前は /usr/include/X11/keysymdef.h を参考にする*)
    bind ~events:[`KeyPressDetail("Return")] 
      ~extend:false ~action:end_function e;
    pack ~side:`Top [label];
    pack ~side:`Top [e];
  end

let wait_reconnect = 60.0 *. 3.0 

let biff ?(port = pop_port) ?(protocol = Pop.POP3) ?(account_name = "")
    sec ~user ~host ~window =
  let times = 3 in
  let password = ref "" in
  let login_f = Pop.login_function_of_protocol protocol in
  let rec try_connect () =
(*    print_endline "try_connect called"; flush stdout;*)
    try
      Mytcp.connect host port
    with Not_found ->
      begin
(*	print_endline "retry"; flush stdout;*)
	Thread.delay wait_reconnect;
	try_connect ()
      end in
  let rec login_iter n = 
    if n = 0 then
      begin
	prerr_endline "failed to login";
	exit 1
      end
    else
      let password_dialog = Toplevel.create window in
      let s = try_connect () in
      let str = Printf.sprintf "Enter password (%d chances)" n in
      begin
	Toplevel.configure ~height ~width window;
	get_password str password ~window:password_dialog;
	Tkwait.window password_dialog;
(*	if Pop.login user !password s then*)
	if login_f user !password s then
	  begin 
(*	    print_endline "login succeeded";*)
(*	    flush stdout;*)
	    Unix.close s
	  end
	else
	  begin
	    Unix.close s;
	    login_iter (n-1)
	  end
      end in
  let label = Label.create ~text:"How many mails?" window in
  let prev_n = ref 0 in
  let new_n = ref 0 in
  let rec iter () =
(*    let s = Mytcp.connect host pop_port in*)
    let s = try_connect () in
    let _ = 
      begin
(*	print_endline "connect succeeded"; flush stdout;*)
	ignore (login_f user !password s);
(*	print_endline "login succeeded in iter!!!";*)
	flush stdout;
	new_n :=  Pop.state s
      end in
    let color = 
      if !new_n = !prev_n then color_unchanged else color_changed in
    let nstr = Printf.sprintf "   %s %d   " account_name !new_n in
    let _ = Unix.close s in
    begin
      (* display n !! *)
      Label.configure ~text:nstr ~foreground:color label;
      Thread.delay sec;
      iter ()
    end in
  begin
    login_iter times;
    pack [label];
    bind ~events:[`ButtonPressDetail(1)] ~extend:false 
      ~action:(fun e -> prev_n := !new_n;
	Label.configure ~foreground:color_unchanged label)
      label;
    ignore (Thread.create (fun () -> Printexc.print iter ()) ());
  end

let _ = 
  let appname = "easy biff" in
  let counter = ref 1 in
  let nickname = ref "" in
  let user = ref None in
  let host = ref None in
  let port = ref pop_port in
  let protocol = ref Pop.POP3 in
  let specs =
    [("-nick", Arg.String(fun x -> nickname := x), "Nickname of account");
     ("-port", Arg.Int(fun x -> port := x), "Port of POP (default is 110)");
     ("-apop", Arg.Unit(fun () -> protocol := Pop.APOP), "Use apop") ] in
  let argfun x = 
    if !counter = 1 then
      user := Some x 
    else if !counter = 2 then
      host := Some x
    else ();
    counter := !counter + 1 in
  let usage_line = (Sys.argv.(0) ^ " [user] [host]") in
  let _ = Arg.parse specs argfun usage_line in
  let print_usage () = Arg.usage specs usage_line in
  let (user, host) =
    match (!user, !host) with
      (Some u, Some h) -> (u, h)
    | _ -> begin print_usage (); exit 1 end in
  let window = openTk () in
  let _ = Sys.set_signal Sys.sigint (Sys.Signal_handle (fun i -> closeTk ())) in
  begin
    appname_set appname;
    biff ~port:!port ~protocol:!protocol ~account_name:!nickname wait_time ~user ~host ~window;
    mainLoop ()
  end