(* Copyright (c) 2010-2011 Yoran Heling * * Permission is hereby granted, free of charge, to any person obtaining * a copy of this software and associated documentation files (the * "Software"), to deal in the Software without restriction, including * without limitation the rights to use, copy, modify, merge, publish, * distribute, sublicense, and/or sell copies of the Software, and to * permit persons to whom the Software is furnished to do so, subject to * the following conditions: * * The above copyright notice and this permission notice shall be included * in all copies or substantial portions of the Software. * * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF * MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. * IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY * CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, * TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. *) (* 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\"" str); win#add_bandwidth ((String.length str)+1); if not sent then win#incr_cmd_count )); api#set_disconnectfunc (Some win#set_loggedout) (* global gui callbacks *) let _ = win#set_on_disconnect (fun () -> api#disconnect) (* 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 ();; *)