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
|
(* global useful functions *)
let config_dir create =
let confdir = Filename.concat (Glib.get_user_config_dir ()) "Serika" in
if create then (
try
Unix.mkdir confdir 0o700
with Unix.Unix_error (Unix.EEXIST, _, _) -> ()
);
confdir
(* init GTK and create objects *)
let _ = GtkMain.Main.init ()
let win = new Gui.mainwin ()
let _ = win#show
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)
(* global API callbacks *)
let _ =
api#set_linefunc (Some (fun sent str ->
win#add_debuglog (if sent then `write else `read)
(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
));
api#set_disconnectfunc (Some win#set_loggedout)
(* login functions and callbacks *)
let login_read () =
let fn = Filename.concat (config_dir false) "login.json" in
let fd = open_in fn in
let obj = Json.json_of_channel fd in
close_in_noerr fd;
win#login#set_defaults (
Json.get_bool (Json.get_value obj "anonymous"),
Json.get_string (Json.get_value obj "username"),
Json.get_string (Json.get_value obj "password"),
Json.get_string (Json.get_value obj "server"),
int_of_string (Json.get_int (Json.get_value obj "port")),
Json.get_bool (Json.get_value obj "remember"),
Json.get_bool (Json.get_value obj "autoconnect")
)
let login_write anon user pass serv port remem auto =
let fn = Filename.concat (config_dir true) "login.json" in
if remem then (
let obj = Json.Object [
("anonymous", Json.Bool anon);
("username", Json.String user);
("password", Json.String (if anon || not auto then "" else pass));
("server", Json.String serv);
("port", Json.Int (string_of_int port));
("remember", Json.Bool remem);
("autoconnect", Json.Bool auto)
] in
let fd = open_out fn in
output_string fd (Json.string_of_json obj);
close_out_noerr fd;
Unix.chmod fn 0o600
) else
Unix.unlink fn
let _ =
(try login_read () with _ -> ());
win#login#apply_defaults;
win#login#set_on_connect (fun (anon, user, pass, serv, port, remem, auto) ->
(try login_write anon user pass serv port remem auto with _ -> ());
api#set_host serv;
api#set_port port;
api#connect (fun ip port ->
win#add_debuglog `status ("Connected to " ^ (Unix.string_of_inet_addr ip) ^ ":" ^ (string_of_int port));
win#login#set_connected;
let u = if anon = true then VndbApi.Anonymous else VndbApi.User (user, pass) in
let du = if anon = true then "Anon" else user in
api#login u (fun r ->
match r with
| VndbApi.ROK -> win#set_loggedin du
| VndbApi.RError ("auth", msg, _) ->
win#login#failed ("Login failed: "^msg);
api#disconnect
| _ ->
win#login#failed "Login failed for some odd reason. :(";
api#disconnect
)
) (fun _ _ msg -> win#login#failed ("Connection failed: "^msg))
);
win#login#do_connect
(* running custom commands *)
let _ =
win#set_on_debug_cmd (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.")
| _ -> ()
)
)
(* enter the mainloop *)
let _ = GMain.Main.main ()
(* 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 ();;
*)
|
