diff options
author | Yorhel <git@yorhel.nl> | 2010-12-07 18:40:29 +0100 |
---|---|---|
committer | Yorhel <git@yorhel.nl> | 2010-12-07 18:40:29 +0100 |
commit | 3a1c620f279d6df1fd5c89d5e02c08b8e9b888de (patch) | |
tree | 14c0852fb5abf5d13a084cdc6b2896d8e5ba2e8c /main.ml | |
parent | 44bf4252f35e028d7fa462465ea0f2a4ad40714a (diff) |
Expanded login window with advanced settings and remember config option
And various other things.
Diffstat (limited to 'main.ml')
-rw-r--r-- | main.ml | 112 |
1 files changed, 90 insertions, 22 deletions
@@ -1,35 +1,82 @@ -(* 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 ();; -*) +(* 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 -let _ = - ignore (GtkMain.Main.init ()); - let win = new Gui.mainwin () in - 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) - in +(* 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 *) - api#set_disconnectfunc (Some win#set_loggedout); +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") + ) - win#login#set_on_connect (fun anon user pass -> +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; @@ -47,7 +94,12 @@ let _ = ) ) (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 -> @@ -59,8 +111,24 @@ let _ = "and error messages.") | _ -> () ) - ); + ) + + + +(* enter the mainloop *) +let _ = GMain.Main.main () + + + + - win#show; - 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 ();; +*) |