src/gtk/gui/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 let copy_message t =
  35   if !!Gui_options.copy_messages then
  36     Marshal.from_string (Marshal.to_string t []) 0
  37   else t
  38
  39 let when_disconnected gui =
  40   gui#clear ;
  41   G.clear ()
  42
  43
  44 let to_gui_protocol_used = Array.make (to_gui_last_opcode+1)
  45   GuiProto.best_gui_version
  46 let from_gui_protocol_used = Array.make
  47     (from_gui_last_opcode+1)
  48   GuiProto.best_gui_version
  49
  50 module UseSocket = struct
  51
  52 let (!!) = Options.(!!)
  53
  54 let connection = ref None
  55
  56 let disconnect gui reason =
  57   match !connection with
  58     None -> ()
  59   | Some sock ->
  60       TcpBufferedSocket.close sock reason;
  61       connection := None;
  62       when_disconnected gui
  63
  64 let send t =
  65   match !connection with
  66     None ->
  67       lprintf "Message not sent since not connected";
  68       lprint_newline ();
  69   | Some sock ->
  70       GuiEncoding.gui_send (GuiEncoding.from_gui from_gui_protocol_used) sock t
  71
  72 let reconnect gui value_reader reason =
  73   (try disconnect gui reason with _ -> ());
  74   let hostname = if !!O.hostname = "" then Unix.gethostname ()
  75     else !!O.hostname in
  76   let token = create_token unlimited_connection_manager in
  77   let sock = TcpBufferedSocket.connect token ""
  78       (try
  79         let h = Ip.from_name hostname in
  80         Ip.to_inet_addr h
  81       with
  82         e ->
  83           lprintf "Exception %s in gethostbyname" (Printexc2.to_string e);
  84           lprint_newline ();
  85           try
  86             Unix.inet_addr_of_string !!O.hostname
  87           with e ->
  88               lprintf "Exception %s in inet_addr_of_string"
  89                 (Printexc2.to_string e);
  90               lprint_newline ();
  91               lprint_newline ();
  92               lprintf "mlgui was unable to find the IP address of the host [%s]" !!O.hostname; lprint_newline ();
  93               lprint_newline ();
  94
  95               lprintf "Please, edit the $HOME/.mldonkey_gui.ini, and change the 'hostname' option"; lprint_newline ();
  96               lprintf "to the correct IP address of the host running mldonkey."; lprint_newline ();
  97
  98               raise Not_found
  99     )
 100     !!O.port
 101       (fun _ _ -> ())
 102   in
 103
 104
 105   if not (List.mem (hostname,!!O.port) !!O.history) then
 106     begin
 107       O.history =:= (hostname, !!O.port) :: !!O.history;
 108       G.new_scanned_port := true
 109     end;
 110
 111   try
 112     connection := Some sock;
 113     TcpBufferedSocket.set_closer sock (fun _ msg ->
 114         match !connection with
 115           None -> ()
 116         | Some s ->
 117             if s == sock then begin
 118                 connection := None;
 119                 gui#label_connect_status#set_text (gettext M.not_connected);
 120                 when_disconnected gui
 121               end
 122     );
 123     TcpBufferedSocket.set_max_input_buffer sock !!O.interface_buffer;
 124     TcpBufferedSocket.set_max_output_buffer sock !!O.interface_buffer;
 125     TcpBufferedSocket.set_handler sock TcpBufferedSocket.BUFFER_OVERFLOW
 126     (fun _ ->
 127         lprintf "BUFFER OVERFLOW"; lprint_newline ();
 128         TcpBufferedSocket.close sock Closed_for_overflow);
 129     TcpBufferedSocket.set_reader sock (
 130       GuiDecoding.gui_cut_messages
 131         (fun opcode s ->
 132           try
 133             let m = GuiDecoding.to_gui to_gui_protocol_used opcode s in
 134             value_reader gui m;
 135           with e ->
 136               lprintf "Exception %s in decode/exec" (Printexc2.to_string e);
 137               lprint_newline ();
 138               raise e
 139       ));
 140     gui#label_connect_status#set_text "Connecting";
 141     send (GuiProto.GuiProtocol GuiProto.best_gui_version)
 142   with e ->
 143       lprintf "Exception %s in connecting\n" (Printexc2.to_string e);
 144       TcpBufferedSocket.close sock (Closed_for_exception e);
 145       connection := None
 146
 147 let connected _ = !connection <> None
 148
 149 end
 150
 151 module UseFifo = struct
 152
 153     let timer_set = ref false
 154
 155     let send m = Fifo.put gui_core_fifo (copy_message m)
 156
 157     let disconnect gui reason =
 158       when_disconnected gui
 159
 160     let reconnect gui value_reader reason =
 161       disconnect gui reason;
 162       gui_reconnected := true;
 163       Fifo.clear core_gui_fifo;
 164       Fifo.clear gui_core_fifo;
 165
 166       if not !timer_set then begin
 167           timer_set := true;
 168           BasicSocket.add_infinite_timer 0.1 (fun _ ->
 169               try
 170                 while true do
 171                   while true do
 172                     let m = copy_message (Fifo.take core_gui_fifo) in
 173                     value_reader gui m
 174                   done
 175                 done
 176               with Fifo.Empty -> ()
 177               | e ->
 178                   lprintf "Exception %s in handle core message"
 179                     (Printexc2.to_string e);
 180                   lprint_newline ();
 181           );
 182         end;
 183       gui#label_connect_status#set_text "Connecting";
 184       send (GuiProto.GuiProtocol GuiProto.best_gui_version)
 185
 186     let connected _ = true
 187
 188   end
 189
 190 let disconnect =
 191   if !core_included then UseFifo.disconnect
 192   else UseSocket.disconnect
 193
 194 let connected =
 195   if !core_included then UseFifo.connected
 196   else UseSocket.connected
 197
 198 let reconnect =
 199   if !core_included then UseFifo.reconnect
 200   else UseSocket.reconnect
 201
 202 let send =
 203   if !core_included then UseFifo.send
 204   else UseSocket.send
 205
 206 let scan_ports () =
 207   let hostname = if !!O.hostname = "" then Unix.gethostname () else !!O.hostname
 208   in
 209   let ip = Ip.from_name hostname in
 210   let addr = Ip.to_inet_addr ip in
 211   let rec scan_port prev_next i max =
 212     if !prev_next && i < max then
 213       let next = ref true in
 214       prev_next := false;
 215       try
 216         let token = create_token unlimited_connection_manager in
 217         let sock = TcpBufferedSocket.connect token ""
 218               addr i
 219               (fun sock e ->
 220               match e with
 221                 BASIC_EVENT (RTIMEOUT) -> close sock Closed_for_timeout
 222               | _ -> ()
 223           ) in
 224         GuiEncoding.gui_send (GuiEncoding.from_gui from_gui_protocol_used) sock
 225           (GuiProto.GuiProtocol GuiProto.best_gui_version);
 226         set_closer sock (fun _ _ ->
 227             scan_port next (i+1) max);
 228         let proto = ref 0 in
 229         let nets = ref [] in
 230         let console = ref "" in
 231         TcpBufferedSocket.set_reader sock (fun sock nread ->
 232             GuiDecoding.gui_cut_messages
 233               (fun opcode s ->
 234                 try
 235                   let m = GuiDecoding.to_gui to_gui_protocol_used
 236                       opcode s in
 237                   match m with
 238                     CoreProtocol (n, _, _) ->
 239                       lprintf "GUI version %d on port %d" n i;
 240                       lprint_newline ();
 241                       proto := n
 242                   | Network_info n ->
 243                       nets := n.CommonTypes.network_netname :: !nets
 244                   | Console m ->
 245                       lprintf "GUI:\n proto %d\nnets:\n" !proto; lprint_newline ();
 246                       List.iter (fun n ->
 247                           lprintf "%s " n
 248                       ) !nets;
 249                       lprint_newline ();
 250                       lprintf " motd:\n%s" m;
 251                       lprint_newline ();
 252
 253                       if not (List.mem (hostname,i) !G.scanned_ports) then
 254                         begin
 255                           G.scanned_ports := (hostname, i) :: !G.scanned_ports;
 256                           G.new_scanned_port := true
 257
 258                         end
 259
 260                   | _ -> close sock Closed_by_user
 261               with e -> close sock Closed_by_user
 262             ) sock nread
 263
 264             );
 265
 266         set_rtimeout sock 0.5;
 267       with e ->
 268           scan_port next (i+1) max
 269   in
 270   scan_port (ref true) 0 10000;
 271   scan_port (ref true) 10000 20000;
 272   scan_port (ref true) 20000 30000;
 273   scan_port (ref true) 30000 40000;
 274   scan_port (ref true) 40000 50000;
 275   scan_port (ref true) 50000 60000;
 276   scan_port (ref true) 60000 65536