75 |
|
|
76 |
(*************************************************************************) |
(*************************************************************************) |
77 |
(* *) |
(* *) |
78 |
|
(* server_num *) |
79 |
|
(* *) |
80 |
|
(*************************************************************************) |
81 |
|
|
82 |
|
let server_num key = |
83 |
|
try int_of_string key with _ -> raise Not_found |
84 |
|
|
85 |
|
(*************************************************************************) |
86 |
|
(* *) |
87 |
|
(* server_of_key *) |
88 |
|
(* *) |
89 |
|
(*************************************************************************) |
90 |
|
|
91 |
|
let server_of_key key = |
92 |
|
try |
93 |
|
let num = server_num key in |
94 |
|
Hashtbl.find G.servers num |
95 |
|
with _ -> raise Not_found |
96 |
|
|
97 |
|
(*************************************************************************) |
98 |
|
(* *) |
99 |
|
(* keys_to_servers *) |
100 |
|
(* *) |
101 |
|
(*************************************************************************) |
102 |
|
|
103 |
|
let keys_to_servers keys = |
104 |
|
let l = ref [] in |
105 |
|
List.iter (fun k -> |
106 |
|
try |
107 |
|
let s = server_of_key k in |
108 |
|
l := s :: !l |
109 |
|
with _ -> ()) keys; |
110 |
|
!l |
111 |
|
|
112 |
|
(*************************************************************************) |
113 |
|
(* *) |
114 |
|
(* server_key *) |
115 |
|
(* *) |
116 |
|
(*************************************************************************) |
117 |
|
|
118 |
|
let server_key server_num = |
119 |
|
Printf.sprintf "%d" server_num |
120 |
|
|
121 |
|
(*************************************************************************) |
122 |
|
(* *) |
123 |
(* Templates *) |
(* Templates *) |
124 |
(* *) |
(* *) |
125 |
(*************************************************************************) |
(*************************************************************************) |
140 |
module Column = GuiColumns.Server |
module Column = GuiColumns.Server |
141 |
|
|
142 |
type item = server_info |
type item = server_info |
|
type key = int |
|
143 |
|
|
144 |
let columns = O.servers_columns |
let columns = O.servers_columns |
145 |
let get_key = (fun s -> s.server_num) |
let get_key = (fun s -> server_key s.server_num) |
146 |
let module_name = "Servers" |
let module_name = "Servers" |
147 |
|
|
148 |
end) |
end) |
276 |
(fun path name -> |
(fun path name -> |
277 |
try |
try |
278 |
let iter = self#get_iter path in |
let iter = self#get_iter path in |
279 |
let s = self#get_item iter in |
let k = self#find_model_key iter in |
280 |
GuiCom.send (ServerRename (s.server_num, name)); |
let s = server_of_key k in |
281 |
|
GuiCom.send (ServerRename (server_num k, name)); |
282 |
let row = self#convert_iter_to_child_iter iter in |
let row = self#convert_iter_to_child_iter iter in |
283 |
store#set ~row ~column:server_name s.server_name |
store#set ~row ~column:server_name s.server_name |
284 |
with _ -> () |
with _ -> () |
353 |
(fun path -> |
(fun path -> |
354 |
try |
try |
355 |
let iter = self#get_iter path in |
let iter = self#get_iter path in |
356 |
let s = self#get_item iter in |
let k = self#find_key iter in |
357 |
GuiCom.send (ServerSetPreferred (s.server_num, not s.server_preferred)); |
let s = server_of_key k in |
358 |
|
GuiCom.send (ServerSetPreferred (server_num k, not s.server_preferred)); |
359 |
let row = self#convert_iter_to_child_iter iter in |
let row = self#convert_iter_to_child_iter iter in |
360 |
store#set ~row ~column:server_preferred s.server_preferred |
store#set ~row ~column:server_preferred s.server_preferred |
361 |
with _ -> () |
with _ -> () |
368 |
(* *) |
(* *) |
369 |
(*************************************************************************) |
(*************************************************************************) |
370 |
|
|
371 |
method sort_items c s1 s2 = |
method sort_items c k1 k2 = |
372 |
match c with |
try |
373 |
|
let s1 = server_of_key k1 in |
374 |
|
let s2 = server_of_key k2 in |
375 |
|
match c with |
376 |
Col_server_address -> |
Col_server_address -> |
377 |
begin |
begin |
378 |
let i = compare s1.server_addr s2.server_addr in |
let i = compare s1.server_addr s2.server_addr in |
392 |
(String.lowercase s2.server_name) |
(String.lowercase s2.server_name) |
393 |
| Col_server_tags -> compare s1.server_tags s2.server_tags |
| Col_server_tags -> compare s1.server_tags s2.server_tags |
394 |
| Col_server_preferred -> compare s1.server_preferred s2.server_preferred |
| Col_server_preferred -> compare s1.server_preferred s2.server_preferred |
395 |
|
with _ -> 0 |
396 |
|
|
397 |
(*************************************************************************) |
(*************************************************************************) |
398 |
(* *) |
(* *) |
401 |
(*************************************************************************) |
(*************************************************************************) |
402 |
|
|
403 |
method force_update_icons () = |
method force_update_icons () = |
404 |
List.iter (fun s -> |
List.iter (fun k -> |
405 |
try |
try |
406 |
let (row, _) = self#find_item s.server_num in |
let row = self#find_row k in |
407 |
|
let s = server_of_key k in |
408 |
store#set ~row ~column:server_network_pixb (Mi.network_pixb s.server_network ~size:A.SMALL ()); |
store#set ~row ~column:server_network_pixb (Mi.network_pixb s.server_network ~size:A.SMALL ()); |
409 |
store#set ~row ~column:server_state_pixb (Mi.server_state_of_server s.server_network s.server_state ~size:A.SMALL) |
store#set ~row ~column:server_state_pixb (Mi.server_state_of_server s.server_network s.server_state ~size:A.SMALL) |
410 |
with _ -> () |
with _ -> () |
460 |
(*************************************************************************) |
(*************************************************************************) |
461 |
|
|
462 |
let remove sel () = |
let remove sel () = |
463 |
|
let l = keys_to_servers sel in |
464 |
List.iter (fun s -> |
List.iter (fun s -> |
465 |
GuiCom.send (RemoveServer_query s.server_num) |
GuiCom.send (RemoveServer_query s.server_num) |
466 |
) sel |
) l |
467 |
|
|
468 |
let connect_to sel () = |
let connect_to sel () = |
469 |
|
let l = keys_to_servers sel in |
470 |
List.iter (fun s -> |
List.iter (fun s -> |
471 |
GuiCom.send (ConnectServer s.server_num) |
GuiCom.send (ConnectServer s.server_num) |
472 |
) sel |
) l |
473 |
|
|
474 |
let disconnect sel () = |
let disconnect sel () = |
475 |
|
let l = keys_to_servers sel in |
476 |
List.iter (fun s -> |
List.iter (fun s -> |
477 |
GuiCom.send (DisconnectServer s.server_num) |
GuiCom.send (DisconnectServer s.server_num) |
478 |
) sel |
) l |
479 |
|
|
480 |
let view_users sel () = |
let view_users sel () = |
481 |
|
let l = keys_to_servers sel in |
482 |
List.iter (fun s -> |
List.iter (fun s -> |
483 |
GuiCom.send (ViewUsers s.server_num) |
GuiCom.send (ViewUsers s.server_num) |
484 |
) sel |
) l |
485 |
|
|
486 |
let add_new_server entry_addr entry_port () = |
let add_new_server entry_addr entry_port () = |
487 |
try |
try |
498 |
GuiCom.send CleanOldServers |
GuiCom.send CleanOldServers |
499 |
|
|
500 |
let clear_users sel () = |
let clear_users sel () = |
501 |
|
let l = keys_to_servers sel in |
502 |
List.iter (fun s -> |
List.iter (fun s -> |
503 |
match s.server_users with |
match s.server_users with |
504 |
None -> () |
None -> () |
507 |
List.iter (fun user_num -> |
List.iter (fun user_num -> |
508 |
Hashtbl.remove G.users user_num |
Hashtbl.remove G.users user_num |
509 |
) l; |
) l; |
510 |
let (row, s) = serverstore#find_item s.server_num in |
s.server_users <- None |
|
serverstore#update_item row s {s with server_users = None} |
|
511 |
end |
end |
512 |
) sel; |
) l; |
513 |
userstore#clear (); (* if we call clear_users there is a good chance that some users are currently displaied *) |
userstore#clear (); (* if we call clear_users there is a good chance that some users are currently displaied *) |
514 |
update_users_label () |
update_users_label () |
515 |
|
|
517 |
GuiCom.send (GetUser_info user_num) |
GuiCom.send (GetUser_info user_num) |
518 |
|
|
519 |
let server_set_preferred sel b () = |
let server_set_preferred sel b () = |
520 |
|
let l = keys_to_servers sel in |
521 |
List.iter (fun s -> |
List.iter (fun s -> |
522 |
GuiCom.send (ServerSetPreferred (s.server_num, b)) |
GuiCom.send (ServerSetPreferred (s.server_num, b)) |
523 |
) sel |
) l |
524 |
|
|
525 |
let server_rename s name () = |
let server_rename s name () = |
526 |
GuiCom.send (ServerRename (s.server_num, name)) |
GuiCom.send (ServerRename (s.server_num, name)) |
531 |
(* *) |
(* *) |
532 |
(*************************************************************************) |
(*************************************************************************) |
533 |
|
|
534 |
let server_menu (sel : server_info list) = |
let server_menu sel = |
535 |
let l = |
let l = |
536 |
match sel with |
match sel with |
537 |
[] -> [] |
[] -> [] |
557 |
(* *) |
(* *) |
558 |
(*************************************************************************) |
(*************************************************************************) |
559 |
|
|
560 |
let on_select_server (sel : server_info list) = |
let on_select_server sel = |
561 |
userstore#clear (); |
userstore#clear (); |
562 |
update_users_label (); |
update_users_label (); |
563 |
match sel with |
match sel with |
564 |
[] -> () |
[] -> () |
565 |
| s :: tail -> |
| k :: tail -> |
566 |
begin |
begin |
567 |
match s.server_users with |
try |
568 |
None -> (if !!verbose then lprintf' "No user for server %s\n" s.server_name) |
let s = server_of_key k in |
569 |
|
match s.server_users with |
570 |
| Some l -> |
None -> (if !!verbose then lprintf' "No user for server %s\n" s.server_name) |
571 |
begin |
| Some l -> |
572 |
List.iter (fun user_num -> |
begin |
573 |
try |
List.iter (fun user_num -> |
574 |
(if !!verbose then lprintf' "Add user %d to list of server %s\n" user_num s.server_name); |
try |
575 |
let u = Hashtbl.find G.users user_num in |
(if !!verbose then lprintf' "Add user %d to list of server %s\n" user_num s.server_name); |
576 |
ignore (userstore#add_item u) |
let u = Hashtbl.find G.users user_num in |
577 |
with _ -> get_user_info user_num |
ignore (userstore#add_item u) |
578 |
) l; |
with _ -> get_user_info user_num |
579 |
update_users_label () |
) l; |
580 |
end |
update_users_label () |
581 |
|
end |
582 |
|
with _ -> () |
583 |
end |
end |
584 |
|
|
585 |
(*************************************************************************) |
(*************************************************************************) |
590 |
|
|
591 |
let filter_disconnected_servers = ref false |
let filter_disconnected_servers = ref false |
592 |
|
|
593 |
let filter_server s = not ( |
let filter_server k = |
594 |
(!filter_disconnected_servers && (match s.server_state with |
try |
595 |
NotConnected _ |
let s = server_of_key k in |
596 |
| NewHost -> true | _ -> false)) || |
not ((!filter_disconnected_servers && |
597 |
List.memq s.server_network !G.networks_filtered |
(match s.server_state with |
598 |
) |
NotConnected _ |
599 |
|
| NewHost -> true | _ -> false)) || |
600 |
|
List.memq s.server_network !G.networks_filtered) |
601 |
|
with _ -> true |
602 |
|
|
603 |
(*************************************************************************) |
(*************************************************************************) |
604 |
(* *) |
(* *) |
629 |
(* *) |
(* *) |
630 |
(*************************************************************************) |
(*************************************************************************) |
631 |
|
|
632 |
|
let hashtbl_server_update s s_new = |
633 |
|
s.server_addr <- s_new.server_addr; |
634 |
|
s.server_port <- s_new.server_port; |
635 |
|
s.server_realport <- s_new.server_realport; |
636 |
|
s.server_score <- s_new.server_score; |
637 |
|
s.server_tags <- s_new.server_tags; |
638 |
|
s.server_nusers <- s_new.server_nusers; |
639 |
|
s.server_nfiles <- s_new.server_nfiles; |
640 |
|
s.server_state <- s_new.server_state; |
641 |
|
s.server_name <- s_new.server_name; |
642 |
|
s.server_description <- s_new.server_description; |
643 |
|
s.server_users <- s_new.server_users; |
644 |
|
s.server_banner <- s_new.server_banner; |
645 |
|
s.server_preferred <- s_new.server_preferred |
646 |
|
|
647 |
let remove_server server_num = |
let remove_server server_num = |
648 |
try |
try |
649 |
let (_, s) = serverstore#find_item server_num in |
let s = Hashtbl.find G.servers server_num in |
650 |
let _ = |
let _ = |
651 |
match s.server_users with |
match s.server_users with |
652 |
None -> () |
None -> () |
655 |
Hashtbl.remove G.users user_num |
Hashtbl.remove G.users user_num |
656 |
) l |
) l |
657 |
in |
in |
658 |
serverstore#remove_item s; |
Hashtbl.remove G.servers server_num; |
659 |
|
serverstore#remove_item (server_key server_num); |
660 |
decr G.nservers; |
decr G.nservers; |
661 |
update_servers_labels () |
update_servers_labels () |
662 |
with _ -> () |
with _ -> () |
663 |
|
|
664 |
let update_server serv = |
let update_server serv = |
665 |
try |
try |
666 |
let (row, s) = serverstore#find_item serv.server_num in |
let s = Hashtbl.find G.servers serv.server_num in |
667 |
|
let row = serverstore#find_row (server_key serv.server_num) in |
668 |
let s_new = {serv with server_users = s.server_users} in |
let s_new = {serv with server_users = s.server_users} in |
669 |
let _ = |
let _ = |
670 |
match Mi.is_connected s_new.server_state, Mi.is_connected s.server_state with |
match Mi.is_connected s_new.server_state, Mi.is_connected s.server_state with |
673 |
| _ -> () |
| _ -> () |
674 |
in |
in |
675 |
serverstore#update_item row s s_new; |
serverstore#update_item row s s_new; |
676 |
|
hashtbl_server_update s s_new; |
677 |
update_servers_labels () |
update_servers_labels () |
678 |
with Not_found -> |
with Not_found -> |
679 |
begin |
begin |
683 |
incr G.nconnected_servers |
incr G.nconnected_servers |
684 |
end; |
end; |
685 |
incr G.nservers; |
incr G.nservers; |
686 |
|
Hashtbl.add G.servers serv.server_num serv; |
687 |
update_servers_labels () |
update_servers_labels () |
688 |
end |
end |
689 |
|
|
695 |
| _ -> |
| _ -> |
696 |
update_server s |
update_server s |
697 |
|
|
698 |
let h_server_update_state num state = |
let h_server_update_state server_num state = |
699 |
try |
try |
700 |
let (row, s) = serverstore#find_item num in |
let s = Hashtbl.find G.servers server_num in |
701 |
|
let row = serverstore#find_row (server_key server_num) in |
702 |
if state = RemovedHost |
if state = RemovedHost |
703 |
then remove_server s.server_num |
then remove_server server_num |
704 |
else begin |
else begin |
705 |
let s_new = {s with server_state = state} in |
let s_new = {s with server_state = state} in |
706 |
let _ = |
let _ = |
710 |
| _ -> () |
| _ -> () |
711 |
in |
in |
712 |
serverstore#update_item row s s_new; |
serverstore#update_item row s s_new; |
713 |
|
s.server_state <- s_new.server_state; |
714 |
update_servers_labels () |
update_servers_labels () |
715 |
end |
end |
716 |
|
|
717 |
with Not_found -> GuiCom.send (GetServer_info num) |
with Not_found -> GuiCom.send (GetServer_info server_num) |
718 |
|
|
719 |
let h_server_busy num nusers nfiles = |
let h_server_busy server_num nusers nfiles = |
720 |
try |
try |
721 |
let (row, s) = serverstore#find_item num in |
let s = Hashtbl.find G.servers server_num in |
722 |
|
let row = serverstore#find_row (server_key server_num) in |
723 |
let s_new = {s with server_nusers = nusers; |
let s_new = {s with server_nusers = nusers; |
724 |
server_nfiles = nfiles} |
server_nfiles = nfiles} |
725 |
in |
in |
726 |
serverstore#update_item row s s_new |
serverstore#update_item row s s_new; |
727 |
|
s.server_nusers <- s_new.server_nusers; |
728 |
with Not_found -> GuiCom.send (GetServer_info num) |
s.server_nfiles <- s_new.server_nfiles |
729 |
|
with Not_found -> GuiCom.send (GetServer_info server_num) |
730 |
|
|
731 |
let h_server_update_users num user = |
let h_server_update_users server_num user = |
732 |
try |
try |
733 |
let (row, s) = serverstore#find_item num in |
let s = Hashtbl.find G.servers server_num in |
734 |
|
let row = serverstore#find_row (server_key server_num) in |
735 |
match s.server_users with |
match s.server_users with |
736 |
None -> |
None -> |
737 |
begin |
begin |
738 |
let s_new = {s with server_users = Some [user]} in |
s.server_users <- Some [user] |
|
serverstore#update_item row s s_new |
|
739 |
end |
end |
740 |
| Some list -> |
| Some list -> |
741 |
if not (List.mem user list) |
if not (List.mem user list) |
742 |
then begin |
then begin |
743 |
let s_new = {s with server_users = Some (user :: list)} in |
s.server_users <- Some (user :: list) |
|
serverstore#update_item row s s_new |
|
744 |
end |
end |
745 |
|
|
746 |
with Not_found -> |
with Not_found -> |
747 |
if num <> 0 |
if server_num <> 0 |
748 |
then begin |
then begin |
749 |
Hashtbl.remove G.users num; (* Anyway remove the user. Will be sent back by the core *) |
Hashtbl.remove G.users user; (* Anyway remove the user. Will be sent back by the core *) |
750 |
GuiCom.send (GetServer_info num); |
GuiCom.send (GetServer_info server_num); |
751 |
GuiCom.send (GetServer_users num) |
GuiCom.send (GetServer_users server_num) |
752 |
end |
end |
753 |
|
|
754 |
let clean_servers_table servers = |
let clean_servers_table servers = |
755 |
let l = serverstore#all_items () in |
let l = serverstore#all_items () in |
756 |
(if !!verbose then lprintf' "Cleaning servers\n servers table : %d\n new servers : %d\n" |
(if !!verbose then lprintf' "Cleaning servers\n servers table : %d\n new servers : %d\n" |
757 |
(List.length l) (List.length servers)); |
(List.length l) (List.length servers)); |
758 |
List.iter (fun s -> (* the core sends more servers than what the GUI displays. |
List.iter (fun k -> (* the core sends more servers than what the GUI displays. |
759 |
* better to do it this way. |
* better to do it this way. |
760 |
*) |
*) |
761 |
if not (List.mem s.server_num servers) |
try |
762 |
then remove_server s.server_num |
let s = server_of_key k in |
763 |
|
if not (List.mem s.server_num servers) |
764 |
|
then remove_server s.server_num |
765 |
|
with _ -> () |
766 |
) l; |
) l; |
767 |
if !!verbose |
if !!verbose |
768 |
then begin |
then begin |
776 |
(* *) |
(* *) |
777 |
(*************************************************************************) |
(*************************************************************************) |
778 |
|
|
779 |
let clean_servers num net_enabled = |
let clean_servers net_num net_enabled = |
780 |
if not net_enabled |
if not net_enabled |
781 |
then begin |
then begin |
782 |
let l = serverstore#all_items () in |
let l = serverstore#all_items () in |
783 |
List.iter (fun s -> |
List.iter (fun k -> |
784 |
if s.server_network = num |
try |
785 |
then remove_server s.server_num |
let s = server_of_key k in |
786 |
|
if s.server_network = net_num |
787 |
|
then remove_server s.server_num |
788 |
|
with _ -> () |
789 |
) l |
) l |
790 |
end |
end |
791 |
|
|