summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2010-12-07 18:40:29 +0100
committerYorhel <git@yorhel.nl>2010-12-07 18:40:29 +0100
commit3a1c620f279d6df1fd5c89d5e02c08b8e9b888de (patch)
tree14c0852fb5abf5d13a084cdc6b2896d8e5ba2e8c
parent44bf4252f35e028d7fa462465ea0f2a4ad40714a (diff)
Expanded login window with advanced settings and remember config option
And various other things.
-rw-r--r--gui.ml91
-rw-r--r--main.ml112
-rw-r--r--vndbApi.ml2
3 files changed, 174 insertions, 31 deletions
diff --git a/gui.ml b/gui.ml
index 5c1c84c..5cf2fab 100644
--- a/gui.ml
+++ b/gui.ml
@@ -14,18 +14,32 @@ class loginwin mainwin =
let g_vbox = GPack.vbox ~packing:g_hbox#add () in
(* input fields *)
- let g_frm = GPack.table ~rows:3 ~columns:2 ~col_spacings:3 ~packing:g_vbox#add () in
+ let inputfield (tbl:GPack.table) top label entry =
+ let align = GBin.alignment ~xscale:0.0 ~xalign:0.0 ~packing:(tbl#attach ~left:1 ~top:top ~expand:`X ~fill:`X) () in
+ let lbl = GMisc.label ~width:80 ~text:label ~xalign:1.0 ~mnemonic_widget:entry ~packing:(tbl#attach ~left:0 ~top:top ~expand:`NONE) () in
+ align#add entry#coerce;
+ (entry, lbl)
+ in
+ let g_frm = GPack.table ~rows:4 ~columns:2 ~col_spacings:3 ~packing:g_vbox#add () in
let g_frm_ano = GButton.check_button ~label:"Connect anonymously" ~packing:(g_frm#attach ~left:0 ~top:0 ~right:2) () in
- let g_frm_usr = GEdit.entry ~activates_default:true ~packing:(g_frm#attach ~left:1 ~top:1 ~expand:`NONE) () in
- let g_frm_ulb = GMisc.label ~text:"Username:" ~xalign:1.0 ~mnemonic_widget:g_frm_usr ~packing:(g_frm#attach ~left:0 ~top:1 ~expand:`NONE) () in
- let g_frm_pas = GEdit.entry ~activates_default:true ~packing:(g_frm#attach ~left:1 ~top:2 ~expand:`NONE) () in
- let g_frm_plb = GMisc.label ~text:"Password:" ~xalign:1.0 ~mnemonic_widget:g_frm_pas ~packing:(g_frm#attach ~left:0 ~top:2 ~expand:`NONE) () in
+ let (g_frm_usr, g_frm_ulb) = inputfield g_frm 1 "Username:" (GEdit.entry ~activates_default:true ()) in
+ let (g_frm_pas, g_frm_plb) = inputfield g_frm 2 "Password:" (GEdit.entry ~activates_default:true ~visibility:false ()) in
+ (* advanced *)
+ let g_frm_exp = GBin.expander ~expanded:false ~label:"Advanced" ~packing:(g_frm#attach ~left:0 ~top:3 ~right:2 ~ypadding:5) () in
+ let g_frm_atb = GPack.table ~rows:4 ~columns:2 ~col_spacings:3 ~packing:g_frm_exp#add () in
+ let (g_frm_ser, _) = inputfield g_frm_atb 0 "Server:" (GEdit.entry ~activates_default:true ()) in
+ let (g_frm_por, _) = inputfield g_frm_atb 1 "Port:" (GEdit.spin_button ~snap_to_ticks:true ()) in
+ let g_frm_rem = GButton.check_button ~label:"Remember login settings (except password)" ~packing:(g_frm_atb#attach ~left:0 ~top:2 ~right:2) () in
+ let g_frm_aut = GButton.check_button ~label:"Automatically login on startup" ~packing:(g_frm_atb#attach ~left:0 ~top:3 ~right:2) () in
+ (* some input settings *)
let _ = g_frm_pas#set_visibility false in
+ let g_frm_port = g_frm_por#adjustment in
+ let _ = g_frm_port#set_bounds ~lower:1.0 ~upper:65535.0 ~step_incr:1.0 () in
(* info part *)
let g_nfo = GPack.hbox ~spacing:5 ~packing:(g_vbox#pack ~expand:false ~padding:5) () in
let g_nfo_img = GMisc.image ~stock:`DIALOG_WARNING ~packing:(g_nfo#pack ~expand:false) () in
- let g_nfo_lbl = GMisc.label ~line_wrap:true ~xalign:0.0 ~packing:(g_nfo#pack ~expand:true) () in
+ let g_nfo_lbl = GMisc.label ~line_wrap:true ~selectable:true ~xalign:0.0 ~packing:(g_nfo#pack ~expand:true ~fill:true) () in
(* buttons *)
let g_but = GPack.button_box `HORIZONTAL ~spacing:10 ~layout:`END ~packing:(g_vbox#pack ~expand:false) () in
@@ -43,26 +57,87 @@ class loginwin mainwin =
g_frm_plb#misc#set_sensitive (not g_frm_ano#active)
) in
+ (* set autologin sensitivity *)
+ let _ = g_frm_aut#misc#set_sensitive false in
+ let _ = g_frm_rem#connect#toggled (fun () ->
+ g_frm_aut#misc#set_sensitive g_frm_rem#active;
+ if not g_frm_rem#active then g_frm_aut#set_active false
+ ) in
+
+ (* warn about saving password *)
+ let g_warnpass_d = GWindow.message_dialog ~message:("Your password will be"
+ ^" saved without encryption and could possibly be read by other users on"
+ ^" this computer. Are you sure you want to enable auto-connect?")
+ ~title:"Confirm saving your password" ~buttons:GWindow.Buttons.yes_no
+ ~parent:g_win ~message_type:`WARNING () in
+ let g_warnpass_block = ref false in
+ let g_warnpass () =
+ if not !g_warnpass_block && g_frm_aut#active && not g_frm_ano#active then (
+ g_warnpass_block := true;
+ g_frm_aut#set_active ((g_warnpass_d#run ()) = `YES);
+ g_warnpass_block := false;
+ g_warnpass_d#misc#hide ()
+ )
+ in
+ let _ = g_frm_aut#connect#toggled g_warnpass in
+ let _ = g_frm_ano#connect#toggled g_warnpass in
+
(* the object *)
object (self)
+ val mutable defaults = (false, "", "", "api.vndb.org", 19534, false, false)
+
method private statusmsg img msg =
g_nfo_img#set_stock img;
g_nfo_lbl#set_text msg
+
+ method set_defaults d = defaults <- d
+
+ method apply_defaults =
+ match defaults with
+ | (anon, user, pass, serv, port, remem, auto) ->
+ g_warnpass_block := true;
+ g_frm_ano#set_active anon;
+ g_frm_usr#set_text user;
+ g_frm_pas#set_text pass;
+ g_frm_ser#set_text serv;
+ g_frm_port#set_value (float port);
+ g_frm_rem#set_active remem;
+ g_frm_aut#set_active auto;
+ g_warnpass_block := false
+
method show =
if not g_win#misc#visible then (
self#statusmsg `DIALOG_WARNING "Note: The application might hang while connecting. Feel free to kill it when it takes too long.";
- g_frm_usr#misc#grab_focus ();
+ if String.length g_frm_usr#text = 0 then
+ g_frm_usr#misc#grab_focus ()
+ else
+ g_frm_pas#misc#grab_focus ();
g_win#show ()
)
+
method hide = g_win#misc#hide ()
+
+ method do_connect =
+ match defaults with
+ | (_,_,_,_,_,_,true) -> g_but_con#clicked ()
+ | _ -> ()
+
method set_on_connect f =
ignore (g_but_con#connect#clicked (fun () ->
g_but_con#misc#set_sensitive false;
g_frm#misc#set_sensitive false;
ignore (self#statusmsg `DIALOG_INFO "Connecting...");
- f g_frm_ano#active g_frm_usr#text g_frm_pas#text
+ f (g_frm_ano#active,
+ g_frm_usr#text,
+ g_frm_pas#text,
+ g_frm_ser#text,
+ (int_of_float g_frm_port#value),
+ g_frm_rem#active,
+ g_frm_aut#active)
))
+
method set_connected = self#statusmsg `DIALOG_INFO "Connected, logging in..."
+
method failed msg =
self#statusmsg `DIALOG_ERROR msg;
g_but_con#misc#set_sensitive true;
diff --git a/main.ml b/main.ml
index 6f4f9ae..a449195 100644
--- a/main.ml
+++ b/main.ml
@@ -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 ();;
+*)
diff --git a/vndbApi.ml b/vndbApi.ml
index 713c22b..f837b16 100644
--- a/vndbApi.ml
+++ b/vndbApi.ml
@@ -29,7 +29,7 @@ class connection
method get_host = s_host
- method set_host h = s_host <- h
+ method set_host h = s_host <- h; s_addr <- None
method get_port = s_port
method set_port p = s_port <- p
method get_addr = s_addr