src/networks/soulseek/slskGlobals.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 CommonInteractive
  21 open Printf2
  22 open Md4
  23 open Int64ops
  24 open CommonOptions
  25 open CommonResult
  26 open BasicSocket
  27 open CommonGlobals
  28 open CommonTypes
  29 open CommonClient
  30 open CommonComplexOptions
  31 open GuiProto
  32 open Options
  33 open CommonFile
  34 open CommonUser
  35 open CommonRoom
  36 open CommonTypes
  37 open CommonShared
  38 open CommonServer
  39 open CommonSwarming
  40 open SlskOptions
  41 open SlskTypes
  42
  43
  44 open CommonNetwork
  45
  46 let network = new_network "SLSK" "Soulseek"
  47     [
  48     NetworkHasServers;
  49     NetworkHasSearch;
  50     NetworkHasRooms;
  51     NetworkHasChat;
  52   ]
  53
  54 let connection_manager = network.network_connection_manager
  55
  56   (*
  57 let (result_ops : result CommonResult.result_ops) =
  58   CommonResult.new_result_ops network
  59     *)
  60
  61 let (server_ops : server CommonServer.server_ops) =
  62   CommonServer.new_server_ops network
  63
  64 let (room_ops : room CommonRoom.room_ops) =
  65   CommonRoom.new_room_ops network
  66
  67 let (user_ops : user CommonUser.user_ops) =
  68   CommonUser.new_user_ops network
  69
  70 let (file_ops : file CommonFile.file_ops) =
  71   CommonFile.new_file_ops network
  72
  73 let (client_ops : client CommonClient.client_ops) =
  74   CommonClient.new_client_ops network
  75
  76
  77
  78 let local_login () =
  79   if !!login = "" then !!CommonOptions.global_login else !!login
  80
  81 let set_server_state s state =
  82   set_server_state (as_server s.server_server) state
  83 let set_client_state s state =
  84   set_client_state (as_client s.client_client) state
  85 let set_room_state s state =
  86   set_room_state (as_room s.room_room) state
  87 let server_num s = server_num (as_server s.server_server)
  88 let file_num s = file_num (as_file s.file_file)
  89 let server_state s = server_state (as_server s.server_server)
  90 let file_state s = file_state (as_file s.file_file)
  91 let server_must_update s = server_must_update (as_server s.server_server)
  92 let file_must_update s = file_must_update (as_file s.file_file)
  93 let user_num  u = user_num  (as_user u.user_user)
  94
  95 let file_size file = file.file_file.impl_file_size
  96 let file_downloaded file = file_downloaded (as_file file.file_file)
  97 let file_age file = file.file_file.impl_file_age
  98 let file_fd file = file_fd (as_file file.file_file)
  99
 100 let client_type c =
 101   client_type (as_client c.client_client)
 102
 103 let nknown_servers = ref 0
 104 let connected_servers = ref ([] : server list)
 105
 106 let servers_by_addr = Hashtbl.create 13
 107
 108 let new_server addr port =
 109   try
 110     Hashtbl.find servers_by_addr (addr, port)
 111   with _ ->
 112       incr nknown_servers;
 113       let rec h = {
 114           server_server = server_impl;
 115           server_name = "<unknown>";
 116           server_addr = addr;
 117           server_nusers = Int64.zero;
 118           server_info = "";
 119           server_connection_control = new_connection_control ();
 120           server_sock = NoConnection;
 121           server_port = port;
 122           server_nick = 0;
 123           server_last_nick = "";
 124           server_search = None;
 125           server_search_timeout = 0.0;
 126           server_users = [];
 127         } and
 128         server_impl = {
 129           dummy_server_impl with
 130           impl_server_val = h;
 131           impl_server_ops = server_ops;
 132         }       in
 133       server_add server_impl;
 134       Hashtbl.add servers_by_addr (addr, port) h;
 135       h
 136
 137 let searches = ref ([] :  (int * CommonTypes.search) list)
 138
 139 let clients_by_name = Hashtbl.create 113
 140
 141 let users_by_name = Hashtbl.create 113
 142
 143 let results_by_file = Hashtbl.create 111
 144
 145 let new_user name =
 146   try
 147     Hashtbl.find users_by_name name
 148   with _ ->
 149       let rec user = {
 150           user_nick = name;
 151           user_user = user_impl;
 152           user_rooms = [];
 153         } and user_impl = {
 154           dummy_user_impl with
 155           impl_user_ops = user_ops;
 156           impl_user_val = user;
 157         }
 158       in
 159       Hashtbl.add users_by_name name user;
 160       user_add user_impl;
 161       user
 162
 163 let new_client name =
 164   try
 165     Hashtbl.find clients_by_name name
 166   with _ ->
 167       let u = new_user name in
 168       let rec c = {
 169           client_client = impl;
 170           client_peer_sock = NoConnection;
 171           client_downloads = [];
 172           client_result_socks = [];
 173           client_name = name;
 174           client_addr = None;
 175           client_files = [];
 176           client_all_files = None;
 177           client_receiving = Int64.zero;
 178           client_connection_control = new_connection_control ();
 179           client_user = u;
 180           client_requests = [];
 181         } and impl = {
 182           dummy_client_impl with
 183           impl_client_val = c;
 184           impl_client_ops = client_ops;
 185           impl_client_upload = None;
 186         } in
 187       new_client impl;
 188       Hashtbl.add clients_by_name name c;
 189       c
 190
 191
 192 let result_sources = Hashtbl.create 1000
 193
 194 let add_result_source r (s : user) (index : string) =
 195   let ss =
 196     try
 197       Hashtbl.find result_sources r.stored_result_num
 198     with _ ->
 199         let ss = ref [] in
 200         Hashtbl.add result_sources r.stored_result_num ss;
 201         ss
 202   in
 203   let key = (s, index) in
 204   if not (List.mem key !ss) then begin
 205       ss := key :: !ss
 206     end
 207
 208 let new_result filename filesize =
 209   let basename = Filename2.basename filename in
 210   let key = (basename, filesize) in
 211   try
 212     Hashtbl.find results_by_file key
 213   with _ ->
 214       let rec r = {
 215           dummy_result with
 216           result_names = [basename];
 217           result_size = filesize;
 218         } in
 219       let rs = update_result_num r in
 220       Hashtbl.add results_by_file key rs;
 221       rs
 222
 223 let rooms_by_name = Hashtbl.create 13
 224
 225 let new_room name =
 226   try
 227     Hashtbl.find rooms_by_name name
 228   with _ ->
 229       let rec room = {
 230           room_room = room_impl;
 231           room_name = name;
 232           room_nusers = 0;
 233           room_users = [];
 234           room_messages = [];
 235         } and
 236         room_impl = {
 237           dummy_room_impl with
 238           impl_room_val = room;
 239           impl_room_ops = room_ops;
 240           impl_room_state = RoomPaused;
 241         }
 242       in
 243       room_add room_impl;
 244       Hashtbl.add rooms_by_name name room;
 245       room
 246
 247
 248 let files_by_key = Hashtbl.create 47
 249
 250 let current_files = ref []
 251
 252 let min_range_size = megabyte
 253
 254 let new_file file_id name file_size =
 255   let file_chunk_size =
 256     max megabyte (
 257       1L ++ file_size // (max 5L (1L ++ file_size // (megabytes 5)))
 258     )
 259   in
 260   let file_temp = Filename.concat !!temp_directory
 261       (Printf.sprintf "SK-%s" (Md4.to_string file_id)) in
 262   let current_size =
 263     try
 264       Unix32.getsize file_temp
 265     with e -> Int64.zero
 266   in
 267
 268   let t = Unix32.create_rw file_temp in
 269   let rec file = {
 270       file_file = file_impl;
 271       file_id = file_id;
 272       file_clients = [];
 273       file_swarmer = None;
 274     } and file_impl =  {
 275       dummy_file_impl with
 276       impl_file_fd = Some t;
 277       impl_file_size = file_size;
 278       impl_file_val = file;
 279       impl_file_ops = file_ops;
 280       impl_file_age = last_time ();
 281       impl_file_best_name = name;
 282     }
 283   in
 284   let state =
 285     if current_size = file_size then
 286       FileDownloaded
 287     else
 288       begin
 289         let kernel = CommonSwarming.create_swarmer file_temp file_size in
 290         let swarmer = CommonSwarming.create kernel (as_file file.file_file) file_chunk_size in
 291           file.file_swarmer <- Some swarmer;
 292         CommonSwarming.set_verifier swarmer ForceVerification;
 293         CommonSwarming.set_verified swarmer (fun _ _ -> file_must_update file);
 294         current_files := file :: !current_files;
 295         FileDownloading
 296       end
 297   in
 298   file_add file_impl state;
 299   file
 300
 301 let new_file file_id name file_size =
 302   let key = String.lowercase name in
 303   try
 304     Hashtbl.find files_by_key key
 305   with _ ->
 306       let file = new_file file_id key file_size  in
 307       Hashtbl.add files_by_key key file;
 308       file
 309
 310 let find_file file_name file_size =
 311   Hashtbl.find files_by_key (String.lowercase file_name)
 312
 313
 314
 315 let add_file_client file user filename =
 316   let  c = new_client user.user_nick in
 317   if not (List.memq c file.file_clients) then begin
 318       file.file_clients <- c :: file.file_clients;
 319       c.client_files <- (file, filename) :: c.client_files;
 320       file_add_source (as_file file.file_file) (as_client c.client_client)
 321     end;
 322   c