src/gtk/newgui/gui_com.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 (** Communicating with the mldonkey client. *)
  21
  22 open Printf2
  23 open BasicSocket
  24 open TcpBufferedSocket
  25 open Options
  26 open CommonGlobals
  27 open Gettext
  28 open GuiProto
  29 module M = Gui_messages
  30 module O = Gui_options
  31 module G = Gui_global
  32
  33
  34 type gui = <
  35   clear : unit;
  36   set_connect_status : string -> unit;
  37     >
  38
  39
  40 let copy_message t =
  41   if !!Gui_options.copy_messages then
  42     Marshal.from_string (Marshal.to_string t []) 0
  43   else t
  44
  45 let when_disconnected (gui : gui) =
  46   gui#clear ;
  47   G.clear ()
  48
  49
  50 let to_gui_protocol_used = Array.create (to_gui_last_opcode+1)
  51   GuiProto.best_gui_version
  52 let from_gui_protocol_used = Array.create
  53     (from_gui_last_opcode+1)
  54   GuiProto.best_gui_version
  55
  56 module UseSocket = struct
  57
  58 let (!!) = Options.(!!)
  59
  60 let connection = ref None
  61
  62 let disconnect gui reason =
  63   match !connection with
  64     None -> ()
  65   | Some sock ->
  66       TcpBufferedSocket.close sock reason;
  67       connection := None;
  68       when_disconnected gui
  69
  70 let send t =
  71   match !connection with
  72     None ->
  73       lprintf "Message not sent since not connected\n";
  74   | Some sock ->
  75       GuiEncoding.gui_send (GuiEncoding.from_gui from_gui_protocol_used) sock t
  76
  77 let reconnect (gui : gui) value_reader arg reason =
  78   (try disconnect gui reason with _ -> ());
  79   let hostname = if !!O.hostname = "" then Unix.gethostname ()
  80     else !!O.hostname in
  81   let token = create_token unlimited_connection_manager in
  82 (*  lprintf "RECONNECTING...\n"; *)
  83   let sock = TcpBufferedSocket.connect token ""
  84       (try
  85         let h = Ip.from_name hostname in
  86         Ip.to_inet_addr h
  87       with
  88         e ->
  89           lprintf "Exception %s in gethostbyname" (Printexc2.to_string e);
  90           lprint_newline ();
  91           try
  92             Unix.inet_addr_of_string !!O.hostname
  93           with e ->
  94               lprintf "Exception %s in inet_addr_of_string"
  95                 (Printexc2.to_string e);
  96               lprint_newline ();
  97               lprint_newline ();
  98               lprintf "mlgui was unable to find the IP address of the host [%s]" !!O.hostname; lprint_newline ();
  99               lprint_newline ();
 100
 101               lprintf "Please, edit the $HOME/.mldonkey/mldonkey_gui.ini, and change the 'hostname' option\n";
 102               lprintf "to the correct IP address of the host running mldonkey.\n";
 103               raise Not_found
 104     )
 105     !!O.port
 106       (fun _ _ -> ())
 107   in
 108 (*  lprintf "CONNECTION STARTED\n"; *)
 109
 110   if not (List.mem (hostname,!!O.port) !!O.history) then
 111     begin
 112       O.history =:= (hostname, !!O.port) :: !!O.history;
 113       G.new_scanned_port := true
 114     end;
 115
 116   try
 117     connection := Some sock;
 118     TcpBufferedSocket.set_closer sock (fun _ msg ->
 119         match !connection with
 120           None -> ()
 121         | Some s ->
 122             if s == sock then begin
 123                 connection := None;
 124                 gui#set_connect_status (M.mW_lb_not_connected);
 125                 when_disconnected gui
 126               end
 127     );
 128     TcpBufferedSocket.set_max_output_buffer sock !!O.interface_buffer;
 129     TcpBufferedSocket.set_max_input_buffer sock !!O.interface_buffer;
 130     TcpBufferedSocket.set_handler sock TcpBufferedSocket.BUFFER_OVERFLOW
 131     (fun _ ->
 132         lprintf "BUFFER OVERFLOW\n";
 133         TcpBufferedSocket.close sock Closed_for_overflow);
 134     TcpBufferedSocket.set_reader sock (
 135       GuiDecoding.gui_cut_messages
 136         (fun opcode s ->
 137           try
 138             let m = GuiDecoding.to_gui to_gui_protocol_used opcode s in
 139             value_reader arg m;
 140           with e ->
 141               lprintf "Exception %s in decode/exec\n" (Printexc2.to_string e);
 142               raise e
 143       ));
 144     gui#set_connect_status (M.mW_lb_connecting);
 145     send (GuiProto.GuiProtocol GuiProto.best_gui_version)
 146   with e ->
 147       lprintf "Exception %s in connecting\n" (Printexc2.to_string e);
 148       TcpBufferedSocket.close sock (Closed_for_exception e);
 149       connection := None
 150
 151 let connected _ = !connection <> None
 152
 153 end
 154
 155 module UseFifo = struct
 156
 157     let timer_set = ref false
 158
 159     let send m = Fifo.put gui_core_fifo (copy_message m)
 160
 161     let disconnect gui reason =
 162       when_disconnected gui
 163
 164     let reconnect ( gui : gui) value_reader arg reason =
 165       disconnect gui reason;
 166       gui_reconnected := true;
 167       Fifo.clear core_gui_fifo;
 168       Fifo.clear gui_core_fifo;
 169
 170       if not !timer_set then begin
 171           timer_set := true;
 172           BasicSocket.add_infinite_timer 0.1 (fun _ ->
 173               try
 174                 while true do
 175                   while true do
 176                     let m = copy_message (Fifo.take core_gui_fifo) in
 177                     value_reader arg m
 178                   done
 179                 done
 180               with Fifo.Empty -> ()
 181               | e ->
 182                   lprintf "Exception %s in handle core message"
 183                     (Printexc2.to_string e);
 184                   lprint_newline ();
 185           );
 186         end;
 187       gui#set_connect_status (M.mW_lb_connecting);
 188       send (GuiProto.GuiProtocol GuiProto.best_gui_version)
 189
 190     let connected _ = true
 191
 192   end
 193
 194 let disconnect =
 195   if !core_included then UseFifo.disconnect
 196   else UseSocket.disconnect
 197
 198 let connected =
 199   if !core_included then UseFifo.connected
 200   else UseSocket.connected
 201
 202 let reconnect =
 203   if !core_included then UseFifo.reconnect
 204   else UseSocket.reconnect
 205
 206 let send =
 207   if !core_included then UseFifo.send
 208   else UseSocket.send
 209
 210 let scan_ports () =
 211   let hostname = if !!O.hostname = "" then Unix.gethostname () else !!O.hostname
 212   in
 213   let ip = Ip.from_name hostname in
 214   let addr = Ip.to_inet_addr ip in
 215   let rec scan_port prev_next i max =
 216     if !prev_next && i < max then
 217       let next = ref true in
 218       prev_next := false;
 219       try
 220         let token = create_token unlimited_connection_manager in
 221         let sock = TcpBufferedSocket.connect token "" addr i (fun sock e ->
 222               match e with
 223                 BASIC_EVENT (RTIMEOUT) -> close sock Closed_for_timeout
 224               | _ -> ()
 225           ) in
 226         GuiEncoding.gui_send (GuiEncoding.from_gui from_gui_protocol_used) sock
 227           (GuiProto.GuiProtocol GuiProto.best_gui_version);
 228         set_closer sock (fun _ _ ->
 229             scan_port next (i+1) max);
 230         let proto = ref 0 in
 231         let nets = ref [] in
 232         let console = ref "" in
 233         TcpBufferedSocket.set_reader sock (fun sock nread ->
 234             GuiDecoding.gui_cut_messages
 235               (fun opcode s ->
 236                 try
 237                   let m = GuiDecoding.to_gui to_gui_protocol_used
 238                       opcode s in
 239                   match m with
 240                     CoreProtocol (n,_,_) ->
 241                       lprintf "GUI version %d on port %d\n" n i;
 242                       proto := n
 243                   | Network_info n ->
 244                       nets := n.CommonTypes.network_netname :: !nets
 245                   | Console m ->
 246                       lprintf "GUI:\n proto %d\nnets:\n" !proto;
 247                       List.iter (fun n ->
 248                           lprintf "%s " n
 249                       ) !nets;
 250                       lprint_newline ();
 251                       lprintf " motd:\n%s" m;
 252                       lprint_newline ();
 253
 254                       if not (List.mem (hostname,i) !G.scanned_ports) then
 255                         begin
 256                           G.scanned_ports := (hostname, i) :: !G.scanned_ports;
 257                           G.new_scanned_port := true
 258
 259                         end
 260
 261                   | _ -> close sock Closed_by_user
 262               with e -> close sock Closed_by_user
 263             ) sock nread
 264
 265             );
 266
 267         set_rtimeout sock 0.5;
 268       with e ->
 269           scan_port next (i+1) max
 270   in
 271   scan_port (ref true) 0 10000;
 272   scan_port (ref true) 10000 20000;
 273   scan_port (ref true) 20000 30000;
 274   scan_port (ref true) 30000 40000;
 275   scan_port (ref true) 40000 50000;
 276   scan_port (ref true) 50000 60000;
 277   scan_port (ref true) 60000 65536