src/networks/soulseek/slskClients.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 open Printf2
  21 open CommonDownloads.Basic
  22 open CommonInteractive
  23 open SlskComplexOptions
  24 open CommonOptions
  25 open BasicSocket
  26 open TcpBufferedSocket
  27 open CommonSearch
  28 open SlskProtocol
  29 open CommonResult
  30 open CommonGlobals
  31 open CommonTypes
  32 open CommonClient
  33 open CommonComplexOptions
  34 open GuiProto
  35 open Options
  36 open CommonFile
  37 open CommonUser
  38 open CommonRoom
  39 open CommonTypes
  40 open CommonShared
  41 open CommonServer
  42 open SlskTypes
  43 open SlskOptions
  44 open SlskGlobals
  45 open SlskProtocol
  46
  47 let requests = ref 0
  48
  49
  50 let listen () = ()
  51
  52 let disconnect_peer c reason =
  53   match c.client_peer_sock with
  54     NoConnection -> ()
  55   | ConnectionWaiting token ->
  56       cancel_token token;
  57       c.client_peer_sock <- NoConnection
  58   | Connection sock ->
  59       lprintf "DISCONNECTED FROM PEER"; lprint_newline ();
  60       close sock reason;
  61       c.client_peer_sock <- NoConnection;
  62       c.client_requests <- []
  63
  64 let disconnect_result c sock =
  65   lprintf "DISCONNECTED FROM RESULT"; lprint_newline ();
  66   close sock Closed_by_user;
  67   c.client_result_socks <- List2.removeq sock c.client_result_socks
  68
  69 module Download = CommonDownloads.Basic.Make(struct
  70
  71       type c = client
  72       type f = file
  73
  74       let file file = as_file file.file_file
  75       let client client = as_client client.client_client
  76
  77       let client_disconnected d =
  78         lprintf "DISCONNECTED FROM SOURCE"; lprint_newline ();
  79         let c = d.download_client in
  80         c.client_downloads <- List2.removeq d c.client_downloads
  81
  82
  83       let download_finished d =
  84         let file = d.download_file in
  85         if List.memq file !current_files then begin
  86             current_files := List2.removeq file !current_files;
  87             old_files =:= (file_best_name (as_file file.file_file),
  88               file_size file) :: !!old_files;
  89             List.iter (fun c ->
  90                 c.client_files <- List.remove_assoc file c.client_files
  91             ) file.file_clients
  92           end
  93
  94     end)
  95
  96 let connect_download c file req =
  97   try
  98     match c.client_addr with
  99       None -> ()
 100     | Some (ip,port) ->
 101         let token = add_pending_connection connection_manager (fun token ->
 102               connection_try c.client_connection_control;
 103               let sock = connect token "client download"
 104                   (Ip.to_inet_addr ip) port
 105                   (fun _ _ -> ())
 106               in
 107               let d = Download.new_download sock c file 1 in
 108               set_reader sock (Download.download_reader d);
 109               set_client_state c (Connected_downloading (file_num file));
 110               init_download_connection sock file (local_login()) req
 111                 d.download_pos;
 112           )
 113         in
 114         ()
 115
 116   with e ->
 117       lprintf "Exception %s while connecting to client"
 118         (Printexc2.to_string e);
 119       lprint_newline ()
 120
 121 let client_to_client c t sock =
 122   if !verbose_msg_clients then begin
 123       lprintf "MESSAGE FROM PEER"; lprint_newline ();
 124       C2C.print t;
 125       lprint_newline ();
 126     end;
 127
 128   match t with
 129   | C2C.FileSearchResultReq t ->
 130       begin
 131         let module SR = C2C.FileSearchResult in
 132         let u = new_user t.SR.user in
 133         try
 134           let q = List.assoc t.SR.id !SlskGlobals.searches in
 135           List.iter (fun file ->
 136               try
 137                 let basename = Filename2.basename file.C2C.file_name in
 138                 let r = new_result basename file.C2C.file_size in
 139                 add_result_source r u file.C2C.file_name;
 140                 search_add_result true q r
 141               with e ->
 142                   lprintf "Exception %s for file %s"
 143                     (Printexc2.to_string e) file.C2C.file_name;
 144                   lprint_newline ();
 145             ) t.SR.files;
 146             ()
 147       with Not_found ->
 148           lprintf "******* NO SEARCH ASSOCIATED WITH %d ******"
 149             t.SR.id; lprint_newline ();
 150       end
 151
 152   | C2C.TransferRequestReq (false, req_id, file_name, size) ->
 153 (* Someone wants to upload to us !! *)
 154       begin
 155         try
 156           let file = Hashtbl.find files_by_key (String.lowercase file_name) in
 157
 158           lprintf "File Found"; lprint_newline ();
 159           if size <> file_size file then begin
 160               lprintf "Bad file size"; lprint_newline ();
 161               raise Exit
 162             end;
 163           if file_state file = FileDownloading then begin
 164               client_send sock (C2C.TransferOKReplyReq (req_id,
 165                   file_size file));
 166               connect_download c file req_id
 167
 168             end else begin
 169               incr requests;
 170               client_send sock (C2C.TransferFailedReplyReq (!requests,
 171                 "Not needed anymore"))
 172             end
 173
 174         with e ->
 175             lprintf "Exception %s for TransferRequestReq Upload %s:%Ld"
 176               (Printexc2.to_string e) file_name size; lprint_newline ();
 177       end
 178
 179   | C2C.SharedFileListReq files ->
 180       List.iter (fun (dir, files) ->
 181           List.iter (fun f ->
 182               let r = new_result f.C2C.file_name f.C2C.file_size in
 183               add_result_source r c.client_user (Filename.concat dir f.C2C.file_name);
 184               client_new_file (as_client c.client_client) dir r
 185           ) files
 186       ) files
 187
 188   | C2C.TransferOKReplyReq (req, filesize) ->
 189       begin
 190         try
 191           let file = List.assoc req c.client_requests in
 192           c.client_requests <- List.remove_assoc req c.client_requests;
 193           connect_download c file req
 194         with
 195           Not_found ->
 196             lprintf "req %d not found !" req; lprint_newline ();
 197       end
 198
 199   | C2C.TransferFailedReplyReq (req, reason) ->
 200       begin
 201         try
 202           let file = List.assoc req c.client_requests in
 203           c.client_requests <- List.remove_assoc req c.client_requests;
 204           let reason =  String.lowercase reason in
 205           if reason = "queued" then
 206             set_client_state c (Connected 0)
 207           else
 208             update_file_state (file.file_file) (FileAborted reason)
 209         with
 210           Not_found ->
 211             lprintf "req %d not found !" req; lprint_newline ();
 212       end
 213
 214   | _ ->
 215       lprintf "Unused message from client:"; lprint_newline ();
 216       SlskProtocol.C2C.print t;
 217       lprint_newline ()
 218
 219 let connect_peer c token msgs =
 220   if !verbose_msg_clients then begin
 221       lprintf "CONNECT PEER"; lprint_newline ();
 222     end;
 223   match c.client_peer_sock with
 224     Connection sock ->
 225       List.iter (fun t -> client_send sock t) msgs
 226   | ConnectionWaiting _ -> ()
 227   | NoConnection ->
 228       match c.client_addr with
 229         None ->
 230           if !verbose_msg_clients then begin
 231               lprintf "NO ADDRESS FOR CLIENT"; lprint_newline ();
 232             end;
 233           List.iter (fun s ->
 234               do_if_connected s.server_sock (fun sock ->
 235                   if !verbose_msg_servers then begin
 236                       lprintf "ASKING FOR CLIENT IP: %s"  c.client_name;
 237                       lprint_newline ();
 238                     end;
 239                   server_send sock (C2S.GetPeerAddressReq c.client_name);
 240               )
 241           ) !connected_servers
 242
 243       | Some (ip,port) ->
 244           let token =
 245             add_pending_connection connection_manager (fun ctoken ->
 246                 c.client_peer_sock <- NoConnection;
 247                 try
 248                   if !verbose_msg_clients then begin
 249                       lprintf "CONNECTING"; lprint_newline ();
 250                     end;
 251                   connection_try c.client_connection_control;
 252                   let sock = connect ctoken "peer connect"
 253                       (Ip.to_inet_addr ip) port
 254                       (fun _ _ -> ())
 255                   in
 256                   set_closer sock (fun _ r -> disconnect_peer c r);
 257                   TcpBufferedSocket.set_read_controler sock download_control;
 258                   TcpBufferedSocket.set_write_controler sock upload_control;
 259                   set_rtimeout sock 30.;
 260                   TcpBufferedSocket.set_reader sock (
 261                     soulseek_handler C2C.parse (client_to_client c));
 262                   c.client_peer_sock <- Connection sock;
 263                   init_peer_connection  sock (local_login ()) token;
 264                   List.iter (fun t -> client_send sock t) msgs
 265                 with e ->
 266                     lprintf "Exception %s while connecting to client\n"
 267                       (Printexc2.to_string e);
 268                     disconnect_peer c (Closed_for_exception e)
 269             ) in
 270           c.client_peer_sock <- ConnectionWaiting token
 271
 272 let connect_result c token =
 273   match c.client_addr with
 274     None -> ()
 275   | Some (ip,port) ->
 276       let ctoken = add_pending_connection connection_manager (fun ctoken ->
 277             try
 278               if !verbose_msg_clients then begin
 279                   lprintf "CONNECTING"; lprint_newline ();
 280                 end;
 281               connection_try c.client_connection_control;
 282               let sock = connect ctoken "peer connect"
 283                   (Ip.to_inet_addr ip) port
 284                   (fun _ _ -> ())
 285               in
 286               set_closer sock (fun _ _ -> disconnect_result c sock);
 287               TcpBufferedSocket.set_read_controler sock download_control;
 288               TcpBufferedSocket.set_write_controler sock upload_control;
 289               set_rtimeout sock 30.;
 290               TcpBufferedSocket.set_reader sock (
 291                 soulseek_handler C2C.parse (client_to_client c));
 292               c.client_result_socks <- sock :: c.client_result_socks;
 293               init_result_connection sock token
 294             with e ->
 295                 lprintf "Exception %s while connecting to client"
 296                   (Printexc2.to_string e);
 297                 lprint_newline ()
 298         ) in
 299       ()