diff options
| -rw-r--r-- | gui.ml | 117 | ||||
| -rw-r--r-- | main.ml | 66 | ||||
| -rw-r--r-- | vndbApi.ml | 29 |
3 files changed, 164 insertions, 48 deletions
@@ -1,9 +1,80 @@ type debuglog_type = [`read | `write | `status] + + +class loginwin mainwin = + (* window & layout *) + let g_win = GWindow.window ~modal:true ~type_hint:`DIALOG ~position:`CENTER + ~title:"Serika Login" ~border_width:5 ~width:400 ~resizable:false () in + let _ = g_win#set_transient_for mainwin in + let _ = g_win#set_destroy_with_parent true in + let g_hbox = GPack.hbox ~packing:g_win#add () in + let _ = GMisc.image ~stock:`DIALOG_AUTHENTICATION ~icon_size:`DIALOG ~yalign:0.2 ~packing:(g_hbox#pack ~expand:false) () in + 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 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_pas#set_visibility false 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 + + (* buttons *) + let g_but = GPack.button_box `HORIZONTAL ~spacing:10 ~layout:`END ~packing:(g_vbox#pack ~expand:false) () in + let g_but_con = GButton.button ~stock:`CONNECT ~packing:g_but#add () in + let g_but_can = GButton.button ~stock:`CANCEL ~packing:g_but#add () in + let _ = g_but_can#connect#clicked g_win#misc#hide in + let _ = g_but_con#misc#set_can_default true in + let _ = g_but_con#misc#grab_default () in + + (* set user/pass sensitivity *) + let _ = g_frm_ano#connect#toggled (fun () -> + g_frm_usr#misc#set_sensitive (not g_frm_ano#active); + g_frm_ulb#misc#set_sensitive (not g_frm_ano#active); + g_frm_pas#misc#set_sensitive (not g_frm_ano#active); + g_frm_plb#misc#set_sensitive (not g_frm_ano#active) + ) in + + (* the object *) + object (self) + method private statusmsg img msg = + g_nfo_img#set_stock img; + g_nfo_lbl#set_text msg + 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 (); + g_win#show () + ) + method hide = g_win#misc#hide () + 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 + )) + 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; + g_frm#misc#set_sensitive true; + g_frm_usr#misc#grab_focus () + end + + + class mainwin () = (* main window layout *) - let g_win = GWindow.window ~wm_name:"Serika" ~wm_class:"serika" ~position:`CENTER () in + let g_win = GWindow.window ~title:"Serika" ~position:`CENTER () in let _ = g_win#connect#destroy GMain.Main.quit in let _ = g_win#set_default_width 640 and _ = g_win#set_default_height 480 in let g_vbox = GPack.vbox ~packing:g_win#add () in @@ -21,28 +92,52 @@ class mainwin () = (* status bar *) let g_status = GMisc.statusbar ~packing:(g_vbox#pack ~expand:false) () in let g_statuscontext = g_status#new_context ~name:"Meh" in - let g_bandwidth = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~width:70 ~text:"0.0 kB" () in - let g_cmd_count = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~width:25 ~text:"0" () in + let g_bandwidth = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~width:80 ~text:"0.0 kB" () in + let g_cmd_count = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~width:30 ~text:"0" () in + let g_loggedinusr = GMisc.label ~packing:(g_status#pack ~from:`END ~expand:false) ~xalign:1.0 ~text:"-" () in (* coloring and marking for the debug textview *) - let _ = g_debug#buffer#create_tag ~name:"read" [`FOREGROUND "#cc6666"] in - let _ = g_debug#buffer#create_tag ~name:"write" [`FOREGROUND "#6666cc"] in - let _ = g_debug#buffer#create_tag ~name:"prefix" [`WEIGHT `LIGHT] in + let _ = g_debug#buffer#create_tag ~name:"read" [`FOREGROUND "#cc6666"] in + let _ = g_debug#buffer#create_tag ~name:"write" [`FOREGROUND "#6666cc"] in + let _ = g_debug#buffer#create_tag ~name:"prefix" [`WEIGHT `LIGHT] in let _ = g_debug#buffer#create_mark ~name:"end" ~left_gravity:false g_debug#buffer#end_iter in + (* login window *) + let login = new loginwin g_win#as_window in + (* the object *) object (self) val mutable bandwidth = 0 val mutable cmd_count = 0 - val mutable laststatusmsg = g_statuscontext#push "Welcome to Serika!" + val mutable laststatusmsg = g_statuscontext#push "Not connected." - method show = g_win#show () + method show = + self#set_sensitive false; + g_win#show (); + login#show - method set_debug_docmd f = + method set_on_debug_cmd f = ignore (g_debug_send#connect#clicked (fun () -> f (g_debug_cmd#text) )) + method login = login + + method set_sensitive b = + g_debug_send#misc#set_sensitive b + + method set_loggedin user = + login#hide; + self#statusmsg "Login successful."; + g_loggedinusr#set_text user; + self#set_sensitive true + + method set_loggedout () = + login#show; + self#statusmsg "Not connected."; + g_loggedinusr#set_text "-"; + self#set_sensitive false + method statusmsg str = let msg = g_statuscontext#push str in g_statuscontext#remove laststatusmsg; @@ -72,11 +167,11 @@ class mainwin () = method set_throttled sec (cb : (unit -> unit)) = let togo = ref sec in - g_debug_send#misc#set_sensitive false; + self#set_sensitive false; let secfunc () = togo := !togo - 1; if !togo < 1 then ( - g_debug_send#misc#set_sensitive true; + self#set_sensitive true; cb (); false ) else ( @@ -9,43 +9,46 @@ let pollfunc sock read 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 _ = + 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 -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 :(" - ) + 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); -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#login#set_on_connect (fun anon user pass -> + 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#set_debug_docmd (fun str -> + win#set_on_debug_cmd (fun str -> win#statusmsg "Executing custom command..."; api#addcmd str (fun r -> win#statusmsg "Custom command finished."; @@ -58,5 +61,6 @@ let _ = ) ); + win#show; GMain.Main.main () @@ -9,6 +9,11 @@ type reply = | RError of (string * string * Json.json) (* id, msg, json obj *) +type user = + Anonymous + | User of (string * string) + + class connection (pollfunc : file_descr -> bool -> (unit -> unit) -> unit) (waitfunc : int -> (unit -> unit) -> unit) @@ -18,6 +23,7 @@ class connection val mutable s_port = 19534 val mutable s_addr = (None : inet_addr option) val mutable linefunc = (None : (bool -> string -> unit) option) + val mutable disconnectfunc = (None : (unit -> unit) option) val cmd_queue = (Queue.create () : (string * (reply -> unit)) Queue.t) val mutable cmd_running = false @@ -28,6 +34,7 @@ class connection method set_port p = s_port <- p method get_addr = s_addr method set_linefunc f = linefunc <- f + method set_disconnectfunc f = disconnectfunc <- f method connected = match s_sock with None -> false | Some _ -> true @@ -84,6 +91,7 @@ class connection (* Not throttled, so consider this command as finished *) | _ -> ignore (Queue.pop cmd_queue); + cmd_running <- false; self#docmd (); recvcb preply in @@ -145,14 +153,23 @@ class connection | Unix_error (a, b, c) -> failure a b c - method login user pass recvcb = - let o = Json.Object [ + method disconnect = + match s_sock with None -> () | Some s -> close s; s_sock <- None; + match disconnectfunc with None -> () | Some f -> f () + + + method login user recvcb = + let cr = match user with + | Anonymous -> [] + | User (n, p) -> [ + ("username", Json.String n); + ("password", Json.String p) + ] in + let o = Json.Object (cr @ [ ("protocol", Json.Int "1"); ("client", Json.String "Serika"); - ("clientver", Json.Number "0.1"); - ("username", Json.String user); - ("password", Json.String pass) - ] in + ("clientver", Json.Number "0.1") + ]) in self#addcmd ("login " ^ (Json.string_of_json o)) recvcb end |