summaryrefslogtreecommitdiff
path: root/main.ml
blob: 6bb531393cfc597e96aa72bf09791c76fe70e0ab (plain)
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

(* blocking pollfunc, useful for testing the vndbApi outside of GTK *
let pollfunc sock read cb =
  let _,_,_ = Unix.select
    (if read then [sock] else [])
    (if read then [] else [sock])
    [] (-.1.0) in
  cb ();;
*)


let _ = ignore (GtkMain.Main.init ())
let win = new Gui.mainwin ()
let api = new VndbApi.connection
  (fun sock read cb ->
    ignore (GMain.Io.add_watch ~cond:[if read then `IN else `OUT]
      ~callback:(fun _ -> cb (); false) (Glib.Io.channel_of_descr sock)))
  (fun sec cb -> win#set_throttled (sec+5) cb)


let debugline sent str =
  win#add_debuglog (if sent then `write else `read) str;
    (Str.replace_first (Str.regexp "\\(\"password\"[\r\n\t ]*:[\r\n\t ]*\"\\)[^\"]+\"") "\\1<secret>\"" str);
  win#add_bandwidth ((String.length str)+1);
  if not sent then win#incr_cmd_count


let apiconnected ip port =
  win#statusmsg ("Connected to " ^ (Unix.string_of_inet_addr ip) ^ ":" ^ (string_of_int port));
  api#login "user" "pass" (fun r ->
    match r with
    | VndbApi.ROK -> win#statusmsg "Login successful."
    | VndbApi.RError ("auth", msg, _) -> win#statusmsg ("Login failed: "^msg)
    | _ -> win#statusmsg "Login failed :("
  )


let _ =
  win#show;
  win#statusmsg "Welcome to the Serika Testing Grounds!";

  api#set_linefunc (Some debugline);
  api#connect apiconnected (fun _ _ msg ->
    print_endline ("Connection failed: "^msg);
    exit 1
  );

  win#set_debug_docmd (fun str ->
    win#statusmsg "Executing custom command...";
    api#addcmd str (fun r ->
      win#statusmsg "Custom command finished.";
      match r with
      | VndbApi.RError _ ->
        win#add_debuglog `status ("Server replied with an error. You may want "^
        "to check http://vndb.org/d11 for information on the available commands "^
        "and error messages.")
      | _ -> ()
    )
  );

  GMain.Main.main ()