/[mldonkey]/mldonkey/src/networks/bittorrent/bTClients.ml
ViewVC logotype

Diff of /mldonkey/src/networks/bittorrent/bTClients.ml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.39 by spiralvoice, Thu Jun 2 17:43:03 2005 UTC revision 1.40 by spiralvoice, Thu Jul 7 00:25:46 2005 UTC
# Line 21  Line 21 
21  (** Functions used in client<->client communication    (** Functions used in client<->client communication  
22  *)  *)
23    
   
24  (** A peer (or client) is always a remote peer in this file.  (** A peer (or client) is always a remote peer in this file.
25    A Piece is a portion of the file associated with a hash (sha1).    A Piece is a portion of the file associated with a hash (sha1).
26    In mldonkey a piece is referred as a block inside the swarming system.    In mldonkey a piece is referred as a block inside the swarming system.
# Line 30  Line 29 
29    In mldonkey a SubPiece is referred as a range inside the swarming system.    In mldonkey a SubPiece is referred as a range inside the swarming system.
30    @see  <http://wiki.theory.org/index.php/BitTorrentSpecification> wiki for some    @see  <http://wiki.theory.org/index.php/BitTorrentSpecification> wiki for some
31    unofficial (but more detailed) specs.    unofficial (but more detailed) specs.
32  *)  *)
33    
34  open Int64ops  open Int64ops
35  open AnyEndian  open AnyEndian
# Line 53  open CommonTypes Line 52  open CommonTypes
52  open CommonFile  open CommonFile
53  open CommonSwarming  open CommonSwarming
54  open CommonGlobals  open CommonGlobals
55  open CommonDownloads    open CommonDownloads
56      
57  open BTRate  open BTRate
58  open BTTypes  open BTTypes
59  open BTProtocol  open BTProtocol
# Line 88  let current_uploaders = ref ([] : BTType Line 87  let current_uploaders = ref ([] : BTType
87     get_sources_from_tracker for an example)     get_sources_from_tracker for an example)
88  *)  *)
89  let connect_trackers file event f =  let connect_trackers file event f =
90      
91    let args,must_check_delay, downloaded, left =    let args,must_check_delay, downloaded, left =
92        
93      match file.file_swarmer with      match file.file_swarmer with
94        None ->        None ->
95          begin          begin
96            match event with            match event with
97            | "started" -> [("event", "started")],true,zero,zero            | "started" -> [("event", "started")],true,zero,zero
98            | "stopped" -> [("event", "stopped")],false,zero,zero            | "stopped" -> [("event", "stopped")],false,zero,zero
99            | _ -> [],true, zero, zero            | _ -> [],true, zero, zero
100          end          end
101        
102      | Some swarmer ->      | Some swarmer ->
103          let local_downloaded = Int64Swarmer.downloaded swarmer in          let local_downloaded = Int64Swarmer.downloaded swarmer in
104          let left = file_size file -- local_downloaded in          let left = file_size file -- local_downloaded in
# Line 109  let connect_trackers file event f = Line 108  let connect_trackers file event f =
108          | "stopped" -> [("event", "stopped")],false,local_downloaded, left          | "stopped" -> [("event", "stopped")],false,local_downloaded, left
109          | _ -> [],true,local_downloaded, left          | _ -> [],true,local_downloaded, left
110    in    in
111      
112    let args =    let args =
113      ("info_hash", Sha1.direct_to_string file.file_id) ::      ("info_hash", Sha1.direct_to_string file.file_id) ::
114      ("peer_id", Sha1.direct_to_string !!client_uid) ::      ("peer_id", Sha1.direct_to_string !!client_uid) ::
115      ("port", string_of_int !!client_port) ::      ("port", string_of_int !!client_port) ::
# Line 240  let disconnect_client c reason = Line 239  let disconnect_client c reason =
239            c.client_new_chunks <- [];            c.client_new_chunks <- [];
240            c.client_interesting <- false;            c.client_interesting <- false;
241            c.client_alrd_sent_interested <- false;            c.client_alrd_sent_interested <- false;
242              -------------------^^^^^--------------------*)      -------------------^^^^^--------------------*)
243            if (c.client_registered_bitfield) then            if (c.client_registered_bitfield) then
244              begin              begin
245                match c.client_uploader with                match c.client_uploader with
246                  None -> ()                  None -> ()
247                | Some up ->                | Some up ->
248                    c.client_uploader <- None;                    c.client_uploader <- None;
249  (* If the client registered a bitfield then                    (* If the client registered a bitfield then
250                  we must unregister him to update the swarmer                       we must unregister him to update the swarmer
251                  (Useful for availability)                       (Useful for availability)
252                *)                    *)
253                    Int64Swarmer.unregister_uploader up                    Int64Swarmer.unregister_uploader up
254  (*            c.client_registered_bitfield <- false;  (*            c.client_registered_bitfield <- false;
255            for i = 0 to String.length c.client_bitmap - 1 do            for i = 0 to String.length c.client_bitmap - 1 do
256              c.client_bitmap.[0] <- '0';              c.client_bitmap.[0] <- '0';
257                                done*)            done*)
258              end;              end;
259  (* Don't test if a client have an upload slot because            (* Don't test if a client have an upload slot because
260            it don't have one (removed during earlier in               it don't have one (removed during earlier in
261              set_client_disconnected c reason) *)            set_client_disconnected c reason)
262              *)
263            if (List.mem c !current_uploaders) then            if (List.mem c !current_uploaders) then
264              begin              begin
265  (*BTGlobals.remove_client*)  (*BTGlobals.remove_client*)
# Line 270  let disconnect_client c reason = Line 270  let disconnect_client c reason =
270              remove_client c;              remove_client c;
271          with _ -> ()          with _ -> ()
272    end    end
     
       
273    
274          
275  (** Disconnect all clients of a file  (** Disconnect all clients of a file
276    @param file The file to which we must disconnects all clients    @param file The file to which we must disconnects all clients
277  *)    *)
278  let disconnect_clients file =  let disconnect_clients file =
279    let must_keep = ref true in    let must_keep = ref true in
280      (match file_state file with      (match file_state file with
281         | FilePaused | FileCancelled -> must_keep:=false         | FilePaused | FileCancelled -> must_keep:=false
282         | _-> ()         | _-> ()
283      );      );
284    Hashtbl.iter (fun _ c ->    Hashtbl.iter (fun _ c ->
285    if not ( !must_keep && (client_has_a_slot (as_client c) || c.client_interested)) then    if not ( !must_keep && (client_has_a_slot (as_client c) || c.client_interested)) then
286      begin      begin
287        if !verbose_msg_clients then        if !verbose_msg_clients then
288          lprintf "disconnect since download is finished\n";          lprintf_nl "disconnect since download is finished";
289        disconnect_client c Closed_by_user        disconnect_client c Closed_by_user
290      end      end
291    ) file.file_clients    ) file.file_clients
             
   
292    
293    
294  (** What to do when a file is finished  (** What to do when a file is finished
295    @param file the finished file    @param file the finished file
296  *)  *)
297  let download_finished file =  let download_finished file =
298      if List.memq file !current_files then      if List.memq file !current_files then
299        begin        begin
300          connect_trackers file "completed" (fun _ _ -> ()); (*must be called before swarmer gets removed from file*)          connect_trackers file "completed" (fun _ _ -> ()); (*must be called before swarmer gets removed from file*)
# Line 315  let download_finished file = Line 311  let download_finished file =
311    A file is finished if all blocks are verified.    A file is finished if all blocks are verified.
312    @param file The file to check status    @param file The file to check status
313  *)  *)
314  let check_finished swarmer file =  let check_finished swarmer file =
315    if Int64Swarmer.check_finished swarmer then    if Int64Swarmer.check_finished swarmer then
316        download_finished file        download_finished file
         
       
317    
   
       
318  let bits = [| 128; 64; 32;16;8;4;2;1 |]  let bits = [| 128; 64; 32;16;8;4;2;1 |]
319  (* Official client seems to use max_range_request 5 and max_range_len 2^14 *)  (* Official client seems to use max_range_request 5 and max_range_len 2^14 *)
320  (* How much requests in the 'pipeline' *)  (* How much requests in the 'pipeline' *)
321  let max_range_requests = 5  let max_range_requests = 5
322  (* How much bytes we can request in one Piece *)  (* How much bytes we can request in one Piece *)
323    
       
   
324    
325  (** A wrapper to send Interested message to a client.  (** A wrapper to send Interested message to a client.
326    (Send interested only if needed)    (Send interested only if needed)
327    @param c The client to send Interested    @param c The client to send Interested
328  *)      *)    
329  let send_interested c =  let send_interested c =
330    if c.client_interesting && (not c.client_alrd_sent_interested) then    if c.client_interesting && (not c.client_alrd_sent_interested) then
331      begin      begin
332        c.client_alrd_sent_interested <- true;        c.client_alrd_sent_interested <- true;
# Line 344  let send_interested c = Line 334  let send_interested c =
334      end      end
335    
336    
   
   
337  (** Send a Bitfield message to a client.  (** Send a Bitfield message to a client.
338    @param c The client to send the Bitfield message    @param c The client to send the Bitfield message
339  *)      *)
340  let send_bitfield c =  let send_bitfield c =
341    let bitmap =    let bitmap =
342      match c.client_file.file_swarmer with      match c.client_file.file_swarmer with
343        None ->        None ->
344  (* This must be a seeded file... *)  (* This must be a seeded file... *)
345          String.make (Array.length c.client_file.file_chunks) '3'          String.make (Array.length c.client_file.file_chunks) '3'
346      | Some swarmer ->      | Some swarmer ->
347          Int64Swarmer.verified_bitmap swarmer          Int64Swarmer.verified_bitmap swarmer
348    in    in
349      
350    if !verbose then begin    if !verbose then lprintf_nl "SENDING Verified bitmap: [%s]" bitmap;
351        lprintf "SENDING Verified bitmap: [%s]\n" bitmap;  
352        end;    send_client c (BitField
   send_client c (BitField  
353        (                (        
354        let nchunks = String.length bitmap in        let nchunks = String.length bitmap in
355        let len = (nchunks+7)/8 in        let len = (nchunks+7)/8 in
# Line 378  let send_bitfield c = Line 365  let send_bitfield c =
365        done;        done;
366        s        s
367      ))      ))
     
   
     
   
368    
   
     
369  let counter = ref 0  let counter = ref 0
370    
371    
372    (** This function is called to parse the first message that
 (** This function is called to parse the first message that  
373    a client send.    a client send.
374    @param counter Don't know what it is    @param counter client num
375    @param cc Expected client (probably useless now that we don't save any client)    @param cc Expected client (probably useless now that we don't save any client)
376    @param init_sent A boolean to know if we sent this client the handshake message    @param init_sent A boolean to know if we sent this client the handshake message
377    @param gconn Don't know    @param gconn Don't know
378    @param sock The socket we use for this client    @param sock The socket we use for this client
379    @param proto Not used???    @param proto Unused (required by tuple type?)
380    @param file_id The file hash (sha1) of the file involved in this exchange    @param file_id The file hash (sha1) of the file involved in this exchange
381  *)  *)
382  (* removed: @param peer_id The hash (sha1) of the client. (Should be checked)  (* removed: @param peer_id The hash (sha1) of the client. (Should be checked)
383  *)  *)
384  let rec client_parse_header counter cc init_sent gconn sock  let rec client_parse_header counter cc init_sent gconn sock
385      (proto, file_id) =      (proto, file_id) =
386    try    try
387      set_lifetime sock 600.;      set_lifetime sock 600.;
388      if !verbose_msg_clients then      if !verbose_msg_clients then
389        lprintf "client_parse_header %d\n" counter;        lprintf_nl "client_parse_header %d" counter;
390        
391      let file = Hashtbl.find files_by_uid file_id in      let file = Hashtbl.find files_by_uid file_id in
392      if !verbose_msg_clients then      if !verbose_msg_clients then
393        lprintf "file found\n";        lprintf_nl "file found";
394      let c =      let c =
395        match !cc with        match !cc with
396          None ->          None ->
397            let c = new_client file Sha1.null (TcpBufferedSocket.peer_addr sock) in            let c = new_client file Sha1.null (TcpBufferedSocket.peer_addr sock) in
398            if !verbose_connect then lprintf "CLIENT %d: incoming CONNECTION\n" (client_num c);            if !verbose_connect then lprintf_nl "CLIENT %d: incoming CONNECTION" (client_num c);
399            cc := Some c;            cc := Some c;
400            c            c
401        | Some c ->        | Some c ->
402            (* Does it happen that this c was alread used to connect sucessfully?            (* Does it happen that this c was already used to connect successfully?
403               If yes then this must happen: *)               If yes then this must happen: *)
404            c.client_received_peer_id <- false;            c.client_received_peer_id <- false;
405            c            c
406           (* client could have had Sha1.null as peer_id/uid *)           (* client could have had Sha1.null as peer_id/uid *)
407           (* this is to be done, later           (* this is to be done, later
408           if c.client_uid <> peer_id then           if c.client_uid <> peer_id then
409            c.client_software <- (parse_software (Sha1.direct_to_string peer_id));            c.client_software <- (parse_software (Sha1.direct_to_string peer_id));
410            c            c
411           *)           *)
# Line 447  let rec client_parse_header counter cc i Line 427  let rec client_parse_header counter cc i
427                      cc := Some ccc;                      cc := Some ccc;
428                      ccc)                      ccc)
429              end else              end else
430              c       *)                c       *)
431      in      in
432        
433      if !verbose_msg_clients then begin      if !verbose_msg_clients then begin
434          let (ip,port) = c.client_host in          let (ip,port) = c.client_host in
435            lprintf "CLIENT %d: Connected (%s:%d)\n" (client_num c)            lprintf_nl "[BT]: CLIENT %d: Connected (%s:%d)" (client_num c)
436              (Ip.to_string ip) port;              (Ip.to_string ip) port;
437        end;        end;
438        
439      (match c.client_sock with      (match c.client_sock with
440          NoConnection ->          NoConnection ->
441            if !verbose_msg_clients then            if !verbose_msg_clients then
442              lprintf "Client was not connected !!!\n";              lprintf_nl "[BT]: Can't connect to client !!!";
443            c.client_sock <- Connection sock            c.client_sock <- Connection sock
444        | ConnectionWaiting token ->        | ConnectionWaiting token ->
445            cancel_token token;            cancel_token token;
446            if !verbose_msg_clients then            if !verbose_msg_clients then
447              lprintf "Client was not connected !!!\n";              lprintf_nl "[BT]: Waiting for connection to client !!!";
448            c.client_sock <- Connection sock            c.client_sock <- Connection sock
449        | Connection s when s != sock ->        | Connection s when s != sock ->
450            if !verbose_msg_clients then            if !verbose_msg_clients then
451              lprintf "CLIENT %d: IMMEDIATE RECONNECTION\n" (client_num c);              lprintf_nl "[BT]: CLIENT %d: IMMEDIATE RECONNECTION" (client_num c);
452            disconnect_client c (Closed_for_error "Reconnected");            disconnect_client c (Closed_for_error "Reconnected");
453            c.client_sock <- Connection sock;            c.client_sock <- Connection sock;
454        | Connection _  -> ()        | Connection _  -> ()
455      );      );
456        
457      set_client_state (c) (Connected (-1));      set_client_state (c) (Connected (-1));
458      if not init_sent then      if not init_sent then
459        begin        begin
460          c.client_incoming<-true;          c.client_incoming<-true;
461          send_init !!client_uid file_id sock;          send_init !!client_uid file_id sock;
462        end;        end;
463      connection_ok c.client_connection_control;      connection_ok c.client_connection_control;
464      if !verbose_msg_clients then      if !verbose_msg_clients then
465        lprintf "file and client found\n";        lprintf_nl "[BT]: file and client found";
466  (*    if not c.client_incoming then *)  (*    if not c.client_incoming then *)
467      send_bitfield c;      send_bitfield c;
468      c.client_blocks_sent <- file.file_blocks_downloaded;      c.client_blocks_sent <- file.file_blocks_downloaded;
469  (*  (*
470        TODO !!! : send interested if and only if we are interested        TODO !!! : send interested if and only if we are interested
471        -> we must recieve at least other peer bitfield.        -> we must recieve at least other peer bitfield.
472        in common swarmer -> compare : partition -> partition -> bool        in common swarmer -> compare : partition -> partition -> bool
473      *)      *)
474    
475  (*    send_client c Unchoke;  *)  (*    send_client c Unchoke;  *)
476        
477      set_rtimeout sock !!client_timeout;      set_rtimeout sock !!client_timeout;
478  (*Once parse succesfully we define the function  (*Once parse succesfully we define the function
479      client_to_client to be the function used when a message      client_to_client to be the function used when a message
480      is read*)      is read*)
481      gconn.gconn_handler <- Reader (fun gconn sock ->      gconn.gconn_handler <- Reader (fun gconn sock ->
482          bt_handler TcpMessages.parser (client_to_client c) c sock          bt_handler TcpMessages.parsing (client_to_client c) c sock
483      );      );
484        
485      ()      ()
486    with    with
487        | Not_found ->        | Not_found ->
488            let (ip,port) = (TcpBufferedSocket.peer_addr sock) in            let (ip,port) = (TcpBufferedSocket.peer_addr sock) in
489            if !verbose_unexpected_messages then            if !verbose_unexpected_messages then
490              lprintf "BT: %s:%d requested a file that is not shared [%s]\n"              lprintf_nl "[BT]: %s:%d requested a file that is not shared [%s]"
491                (Ip.to_string ip) port (Sha1.to_hexa file_id)                (Ip.to_string ip) port (Sha1.to_hexa file_id)
492        | e ->        | e ->
493            lprintf "Exception %s in client_parse_header\n" (Printexc2.to_string e);            lprintf_nl "[BT]: Exception %s in client_parse_header" (Printexc2.to_string e);
494        close sock (Closed_for_exception e);        close sock (Closed_for_exception e);
495        raise e        raise e
496    
497    
   
   
   
498  (** Update the bitmap of a client. Unclear if it is still useful.  (** Update the bitmap of a client. Unclear if it is still useful.
499    @param c The client which we want to update.    @param c The client which we want to update.
500  *)  *)
# Line 526  and update_client_bitmap c = Line 503  and update_client_bitmap c =
503    let swarmer = match file.file_swarmer with    let swarmer = match file.file_swarmer with
504        None -> assert false        None -> assert false
505      | Some swarmer -> swarmer in      | Some swarmer -> swarmer in
506    let up =    let up =
507      match c.client_uploader with      match c.client_uploader with
508        None ->        None ->
509          let up = Int64Swarmer.register_uploader swarmer (as_client c)          let up = Int64Swarmer.register_uploader swarmer (as_client c)
# Line 536  and update_client_bitmap c = Line 513  and update_client_bitmap c =
513      | Some up ->      | Some up ->
514          up          up
515    in    in
516      
517    let bitmap = match c.client_bitmap with    let bitmap = match c.client_bitmap with
518        None ->        None ->
519          let len = Int64Swarmer.partition_size swarmer in          let len = Int64Swarmer.partition_size swarmer in
520          let bitmap = String.make (len*8) '0' in          let bitmap = String.make (len*8) '0' in
521          c.client_bitmap <- Some bitmap;          c.client_bitmap <- Some bitmap;
522          bitmap          bitmap
523      | Some bitmap -> bitmap      | Some bitmap -> bitmap
524    in    in
525      
526    if c.client_new_chunks <> [] then    if c.client_new_chunks <> [] then
527      let chunks = c.client_new_chunks in      let chunks = c.client_new_chunks in
528      c.client_new_chunks <- [];      c.client_new_chunks <- [];
# Line 553  and update_client_bitmap c = Line 530  and update_client_bitmap c =
530      List.iter (fun n -> bitmap.[n] <- '1') chunks;      List.iter (fun n -> bitmap.[n] <- '1') chunks;
531      Int64Swarmer.update_uploader up (AvailableCharBitmap bitmap)      Int64Swarmer.update_uploader up (AvailableCharBitmap bitmap)
532    
533    
534  (** In this function we decide which piece we must request from client.  (** In this function we decide which piece we must request from client.
535    @param sock Socket of the client    @param sock Socket of the client
536    @param c The client    @param c The client
# Line 562  and get_from_client sock (c: client) = Line 540  and get_from_client sock (c: client) =
540  (*Check if there's not enough requests in the 'pipeline'  (*Check if there's not enough requests in the 'pipeline'
541      and if a request can be send (not choked and file is downloading) *)      and if a request can be send (not choked and file is downloading) *)
542    if List.length c.client_ranges_sent < max_range_requests &&    if List.length c.client_ranges_sent < max_range_requests &&
543      file_state file = FileDownloading && (c.client_choked == false)  then      file_state file = FileDownloading && (c.client_choked == false) then
544  (*num is the number of the piece, x and y are the position  (*num is the number of the piece, x and y are the position
545  of the subpiece in the piece(!), r is a (CommonSwarmer) range *)  of the subpiece in the piece(!), r is a (CommonSwarmer) range *)
546        
       
547      let up = match c.client_uploader with      let up = match c.client_uploader with
548          None -> assert false          None -> assert false
549        | Some up -> up in        | Some up -> up in
550      let swarmer = Int64Swarmer.uploader_swarmer up in            let swarmer = Int64Swarmer.uploader_swarmer up in
551        
552    try    try
553      let num, x,y, r =      let num, x,y, r =
554        if !verbose_msg_clients then begin        if !verbose_msg_clients then begin
555            lprintf "CLIENT %d: Finding new range to send\n" (client_num c);            lprintf_nl "[BT]: CLIENT %d: Finding new range to send" (client_num c);
556          end;          end;
557          
558        if !verbose_swarming then begin        if !verbose_swarming then begin
559            lprintf "Current download:\n  Current chunks: ";            lprintf_nl "[BT]: Current download:\n  Current chunks: ";
560            List.iter (fun (x,y) -> lprintf "%Ld-%Ld " x y) c.client_chunks;            List.iter (fun (x,y) -> lprintf "%Ld-%Ld " x y) c.client_chunks;
561            lprintf "\n  Current ranges: ";            lprintf_nl "\n[BT]: Current ranges: ";
562            List.iter (fun (p1,p2, r) ->            List.iter (fun (p1,p2, r) ->
563                let (x,y) = Int64Swarmer.range_range r                let (x,y) = Int64Swarmer.range_range r
564                in                in
565                lprintf "%Ld-%Ld[%Ld-%Ld] " p1 p2 x y) c.client_ranges_sent;                lprintf "%Ld-%Ld[%Ld-%Ld] " p1 p2 x y) c.client_ranges_sent;
566            (match c.client_range_waiting with            (match c.client_range_waiting with
567                None -> ()                None -> ()
568              | Some (x,y,r) -> lprintf "Waiting %Ld-%Ld\n" x y);              | Some (x,y,r) -> lprintf "Waiting %Ld-%Ld\n" x y);
569            lprintf "\n  Current block: ";            lprintf_nl "\nBT: Current block: ";
570            (match c.client_block with            (match c.client_block with
571                None -> lprintf "none\n"                None -> lprintf_nl "none"
572              | Some b -> Int64Swarmer.print_block b);              | Some b -> Int64Swarmer.print_block b);
573            lprintf "\n\nFinding Range: \n";            lprintf_nl "\nBT: Finding Range:";
574          end;          end;
575        try        try
576  (*We must find a block to request first, and then          (*We must find a block to request first, and then
577          some range inside this block*)            some range inside this block
578            *)
579          let rec iter () =          let rec iter () =
580            match c.client_block with            match c.client_block with
581              None ->              None ->
582                if !verbose_swarming then                if !verbose_swarming then
583                  lprintf "No block\n";                  lprintf_nl "No block";
584                update_client_bitmap c;                update_client_bitmap c;
585                (try Int64Swarmer.verify_one_chunk swarmer with _ -> ());                (try Int64Swarmer.verify_one_chunk swarmer with _ -> ());
586  (*Find a free block in the swarmer*)                (*Find a free block in the swarmer*)
587                let b = Int64Swarmer.find_block up in                let b = Int64Swarmer.find_block up in
588                if !verbose_swarming then begin                if !verbose_swarming then begin
589                    lprintf "Block Found: "; Int64Swarmer.print_block b;                    lprintf "[BT]: Block Found: "; Int64Swarmer.print_block b;
590                  end;                  end;
591                c.client_block <- Some b;                c.client_block <- Some b;
592  (*We put the found block in client_block to               (*We put the found block in client_block to
593                  request range in this block. (Useful for                 request range in this block. (Useful for
594                  not searching each time a new block)                 not searching each time a new block)
595                *)                              *)
596                iter ()                iter ()
597            | Some b ->            | Some b ->
598                if !verbose_swarming then begin                if !verbose_swarming then begin
599                    lprintf "Current Block: "; Int64Swarmer.print_block b;                    lprintf "[BT]: Current Block: "; Int64Swarmer.print_block b;
600                  end;                  end;
601                try                try
602  (*Given a block find a range inside*)                  (*Given a block find a range inside*)
603                  let (x,y,r) =                  let (x,y,r) =
604                    match c.client_range_waiting with                    match c.client_range_waiting with
605                      Some (x,y,r) ->                      Some (x,y,r) ->
606                        c.client_range_waiting <- None;                        c.client_range_waiting <- None;
607                        (x,y,r)                        (x,y,r)
608                    | None -> Int64Swarmer.find_range up in                    | None -> Int64Swarmer.find_range up in
609                    
610                  let (x,y,r) =                  let (x,y,r) =
611                    if y -- x > max_range_len then begin                    if y -- x > max_range_len then begin
612                        c.client_range_waiting <- Some (x ++ max_range_len, y, r);                        c.client_range_waiting <- Some (x ++ max_range_len, y, r);
# Line 638  of the subpiece in the piece(!), r is a Line 616  of the subpiece in the piece(!), r is a
616  (*                Int64Swarmer.alloc_range r; *)  (*                Int64Swarmer.alloc_range r; *)
617                  let num = Int64Swarmer.block_num swarmer b in                  let num = Int64Swarmer.block_num swarmer b in
618                  if !verbose_swarming then                  if !verbose_swarming then
619                    lprintf "Asking %d For Range %Ld-%Ld\n" num x y;                    lprintf_nl "[BT]: Asking %d For Range %Ld-%Ld" num x y;
620                    
621                  num, x -- file.file_piece_size ** Int64.of_int num, y -- x, r                  num, x -- file.file_piece_size ** Int64.of_int num, y -- x, r
622                with Not_found ->                with Not_found ->
623  (*If we don't find a range to request inside the block,                    (*If we don't find a range to request inside the block,
624                  iter to choose another block*)                      iter to choose another block*)
625                    if !verbose_swarming then                    if !verbose_swarming then
626                      lprintf "Could not find range in current block\n";                      lprintf_nl "[BT]: Could not find range in current block";
627  (*                  c.client_blocks <- List2.removeq b c.client_blocks; *)  (*                  c.client_blocks <- List2.removeq b c.client_blocks; *)
628                    c.client_block <- None;                    c.client_block <- None;
629                    iter ()                    iter ()
630          in          in
631          iter ()          iter ()
632        with Not_found ->        with Not_found ->
633  (*If we don't find a block to request we can check if the            (*If we don't find a block to request we can check if the
634            file is finished (if there's missing pieces we can't decide              file is finished (if there's missing pieces we can't decide
635            that the file is finished because we didn't found              that the file is finished because we didn't found
636            a block to ask)*)              a block to ask)
637                        *)
638            if !verbose_swarming then            if !verbose_swarming then
639              lprintf "Unable to get a block !!\n";              lprintf_nl "[BT]: Unable to get a block !!";
640            Int64Swarmer.compute_bitmap swarmer;            Int64Swarmer.compute_bitmap swarmer;
641            check_finished swarmer file;            check_finished swarmer file;
642            raise Not_found            raise Not_found
643      in      in
644      send_client c (Request (num,x,y));      send_client c (Request (num,x,y));
645      if !verbose_msg_clients then      if !verbose_msg_clients then
646        lprintf "CLIENT %d: Asking %s For Range %Ld-%Ld\n"        lprintf_nl "[BT]: CLIENT %d: Asking %s For Range %Ld-%Ld"
647          (client_num c)          (client_num c)
648        (Sha1.to_string c.client_uid)        (Sha1.to_string c.client_uid)
649        x y        x y
650    with Not_found ->    with Not_found ->
651          if not (Int64Swarmer.check_finished swarmer) && !verbose_hidden_errors then          if not (Int64Swarmer.check_finished swarmer) && !verbose_hidden_errors then
652            lprintf "BTClient.get_from_client ERROR: can't find a block to download and file is not yet finished...\n"            lprintf_nl "[BT]: BTClient.get_from_client ERROR: can't find a block to download and file is not yet finished..."
   
653    
654    
655  (** In this function we match a message sent by a client  (** In this function we match a message sent by a client
# Line 772  and client_to_client c sock msg = Line 749  and client_to_client c sock msg =
749          if (List.length !current_uploaders < (!!max_uploaders_per_torrent-1)) &&          if (List.length !current_uploaders < (!!max_uploaders_per_torrent-1)) &&
750            (List.mem c (!current_uploaders)) == false && c.client_interested then            (List.mem c (!current_uploaders)) == false && c.client_interested then
751            begin            begin
752  (*we are probably an optimistic uploaders for this client              (*we are probably an optimistic uploaders for this client
753               don't miss the oportunity if we can*)                don't miss the oportunity if we can
754                *)
755              current_uploaders := c::(!current_uploaders);              current_uploaders := c::(!current_uploaders);
756              c.client_sent_choke <- false;              c.client_sent_choke <- false;
757              set_client_has_a_slot (as_client c) true;              set_client_has_a_slot (as_client c) true;
# Line 808  and client_to_client c sock msg = Line 786  and client_to_client c sock msg =
786                        bitmap.[i*8+j] <- '1';                        bitmap.[i*8+j] <- '1';
787                      end                      end
788                    else                    else
789                      bitmap.[i*8+j] <- '0';                                bitmap.[i*8+j] <- '0';
790                  done;                  done;
791                done;                done;
792    
793                update_client_bitmap c;                update_client_bitmap c;
794                  
795                let verified = Int64Swarmer.verified_bitmap swarmer in                        let verified = Int64Swarmer.verified_bitmap swarmer in
796                let npieces = Int64Swarmer.partition_size swarmer in                let npieces = Int64Swarmer.partition_size swarmer in
797                for i = 0 to npieces -1  do                for i = 0 to npieces -1  do
798                    (* lprintf "bitmap: %c, verified: %c" bitmap.[i] verified.[i]; *)
799                  if bitmap.[i] = '1' && verified.[i] < '2' then                  if bitmap.[i] = '1' && verified.[i] < '2' then
800                    c.client_interesting <- true;                    c.client_interesting <- true;
801                done;                done;
802                                
803                if !verbose_msg_clients then                if !verbose_msg_clients then
804                  lprintf "BitField translated\n";                  lprintf_nl "[BT]: BitField translated";
805                if !verbose_msg_clients then                if !verbose_msg_clients then
806                  lprintf "Old BitField Unregistered\n";                  lprintf_nl "[BT]: Old BitField Unregistered";
807                (match c.client_uploader with                (match c.client_uploader with
808                    None -> assert false                    None -> assert false
809                  | Some up ->                  | Some up ->
810                      Int64Swarmer.update_uploader up                      Int64Swarmer.update_uploader up
811                        (AvailableCharBitmap bitmap));                        (AvailableCharBitmap bitmap));
812                c.client_registered_bitfield <- true;                      c.client_registered_bitfield <- true;
813                c.client_bitmap <- Some bitmap;                c.client_bitmap <- Some bitmap;
814                send_interested c;                send_interested c;
815                if !verbose_msg_clients then                if !verbose_msg_clients then
816                  lprintf "New BitField Registered\n";                  lprintf_nl "[BT]: New BitField Registered";
817  (*        for i = 1 to max_range_requests - List.length c.client_ranges do  (*        for i = 1 to max_range_requests - List.length c.client_ranges do
818            (try get_from_client sock c with _ -> ())            (try get_from_client sock c with _ -> ())
819          done*)          done*)
820          end;          end;
821          (*a bitfield must only be sent after the handshake and befor everything else: NOT here          (*a bitfield must only be sent after the handshake and before everything else: NOT here
822          if c.client_incoming then send_bitfield c;*)            if c.client_incoming then send_bitfield c;
823                *)
824    
825      | Have n ->      | Have n ->
826  (*A client can send a Have without sending a Bitfield*)  (*A client can send a "Have" without sending a Bitfield*)
827          begin          begin
828            match c.client_file.file_swarmer with            match c.client_file.file_swarmer with
829              None -> ()              None -> ()
830            | Some swarmer ->            | Some swarmer ->
831                let n = Int64.to_int n in                let n = Int64.to_int n in
832                let verified = Int64Swarmer.verified_bitmap swarmer in                let verified = Int64Swarmer.verified_bitmap swarmer in
833                  (* lprintf_nl "verified: %c;" verified.[n]; *)
834                if verified.[n] < '2' then begin                if verified.[n] < '2' then begin
835                    c.client_interesting <- true;                    c.client_interesting <- true;
836                    send_interested c;                      send_interested c;
837                    c.client_new_chunks <- n :: c.client_new_chunks;                    c.client_new_chunks <- n :: c.client_new_chunks;
838                    update_client_bitmap c;                    update_client_bitmap c;
839                  end;                  end;
840    
   
841  (*        begin  (*        begin
842            match c.client_bitmap, c.client_uploader with            match c.client_bitmap, c.client_uploader with
843              Some bitmap, Some up ->              Some bitmap, Some up ->
# Line 878  and client_to_client c sock msg = Line 858  and client_to_client c sock msg =
858                    done*)                    done*)
859                        end                        end
860                    end                    end
861            | None, Some _ -> lprintf "no bitmap but client_uploader\n";            | None, Some _ -> lprintf "[BT]: no bitmap but client_uploader\n";
862            | Some _ , None ->lprintf "bitmap but no client_uploader\n";            | Some _ , None ->lprintf "[BT]: bitmap but no client_uploader\n";
863            | None, None -> lprintf "no bitmap no client_uploader\n";            | None, None -> lprintf "[BT]: no bitmap no client_uploader\n";
864          end          end
865  *)        *)      
866          end          end
867            
868      | Interested ->      | Interested ->
869          c.client_interested <- true;          c.client_interested <- true;
870        
871      | Choke ->      | Choke ->
872          begin          begin
873            set_client_state (c) (Connected (-1));            set_client_state (c) (Connected (-1));
874            (*remote peer will clear the list of range we sent*)            (* remote peer will clear the list of range we sent *)
875            begin            begin
876             match c.client_uploader with             match c.client_uploader with
877                None ->                None ->
878                  (* Afaik this is no protocolviolation and happens if the client                  (* Afaik this is no protocol violation and happens if the client
879                     didn't send a client bitmap after the handshake. *)                     didn't send a client bitmap after the handshake. *)
880                  let (ip,port) = c.client_host in                  let (ip,port) = c.client_host in
881                    if !verbose_msg_clients then lprintf "BT: %s:%d with software %s : Choke send, but no client bitmap\n"                    if !verbose_msg_clients then lprintf_nl "[BT]: %s:%d with software %s : Choke send, but no client bitmap"
882                      (Ip.to_string ip) port (c.client_software)                      (Ip.to_string ip) port (c.client_software)
883              | Some up ->              | Some up ->
884                  Int64Swarmer.clear_uploader_ranges up                  Int64Swarmer.clear_uploader_ranges up
# Line 907  and client_to_client c sock msg = Line 887  and client_to_client c sock msg =
887            c.client_range_waiting <- None;            c.client_range_waiting <- None;
888            c.client_choked <- true;            c.client_choked <- true;
889          end          end
890        
891      | NotInterested ->      | NotInterested ->
892          c.client_interested <- false;          c.client_interested <- false;
893        
894      | Unchoke ->      | Unchoke ->
895          begin          begin
896            c.client_choked <- false;            c.client_choked <- false;
897  (*remote peer cleared our request : re-request*)            (* remote peer cleared our request : re-request *)
898            for i = 1 to max_range_requests -            for i = 1 to max_range_requests -
899              List.length c.client_ranges_sent do              List.length c.client_ranges_sent do
900              (try get_from_client sock c with _ -> ())              (try get_from_client sock c with _ -> ())
901            done            done
902          end          end
903        
       
904      | Request (n, pos, len) ->      | Request (n, pos, len) ->
905          if len > max_request_len then begin          if len > max_request_len then begin
906              close sock (Closed_for_error "Request longer than 1<<16");              close sock (Closed_for_error "Request longer than 1<<16");
907              raise Exit              raise Exit
908            end;            end;
909            
910          if !CommonUploads.has_upload = 0 then          if !CommonUploads.has_upload = 0 then
911            begin            begin
912              if client_has_a_slot (as_client c) then              if client_has_a_slot (as_client c) then
# Line 937  and client_to_client c sock msg = Line 916  and client_to_client c sock msg =
916                    [] ->                    [] ->
917                        CommonUploads.ready_for_upload (as_client c);                        CommonUploads.ready_for_upload (as_client c);
918                    | _ -> ());                    | _ -> ());
919                  c.client_upload_requests <-                  c.client_upload_requests <-
920                    c.client_upload_requests @ [n,pos,len];                    c.client_upload_requests @ [n,pos,len];
921                  let file = c.client_file in                  let file = c.client_file in
922                  match file.file_shared with                  match file.file_shared with
# Line 952  and client_to_client c sock msg = Line 931  and client_to_client c sock msg =
931                begin                begin
932                  send_client c Choke;                  send_client c Choke;
933                  c.client_sent_choke <- true;                  c.client_sent_choke <- true;
934                  c.client_upload_requests <- [];                                  c.client_upload_requests <- [];
935                end                end
936            end;            end;
937            
       
938      | Ping -> ()      | Ping -> ()
939          (*We don't 'generate' a Ping message on a Ping.*)          (*We don't 'generate' a Ping message on a Ping.*)
940        
941      | Cancel _ -> ()      | Cancel _ -> ()
942    with e ->    with e ->
943        lprintf "Error %s while handling MESSAGE: %s\n" (Printexc2.to_string e) (TcpMessages.to_string msg)        lprintf_nl "[BT]: Error %s while handling MESSAGE: %s" (Printexc2.to_string e) (TcpMessages.to_string msg)
         
944    
945    
946  (** The function used to connect to a client.  (** The function used to connect to a client.
947  The connection is not immediately initiated. It will  The connection is not immediately initiated. It will
948  be put in a fifo and dequeud according to  be put in a fifo and dequeued according to
949  !!max_connections_per_second. (@see commonGlobals.ml)  !!max_connections_per_second. (@see commonGlobals.ml)
950  @param c The client we must connect  @param c The client we must connect
951  *)        *)      
952  let connect_client c =  let connect_client c =
953    if can_open_connection connection_manager &&    if can_open_connection connection_manager &&
954          (let (ip,port) = c.client_host in match Ip_set.match_ip !Ip_set.bl ip with      (let (ip,port) = c.client_host in
955               None -> true       match Ip_set.match_ip !Ip_set.bl ip with
956             | Some br ->         None -> true
957                 if !verbose_connect then       | Some br ->
958                   lprintf "%s:%d blocked: %s\n"           if !verbose_connect then
959                     (Ip.to_string ip) port br.blocking_description;             lprintf_nl "[BT]: %s:%d blocked: %s"
960                 false)                         (Ip.to_string ip) port br.blocking_description;
961             false)
962    then    then
963    match c.client_sock with    match c.client_sock with
964      NoConnection ->      NoConnection ->
# Line 989  let connect_client c = Line 967  let connect_client c =
967          add_pending_connection connection_manager (fun token ->          add_pending_connection connection_manager (fun token ->
968              try              try
969                if !verbose_msg_clients then begin                if !verbose_msg_clients then begin
970                    lprintf "CLIENT %d: connect_client\n" (client_num c);                    lprintf_nl "[BT]: CLIENT %d: connect_client" (client_num c);
971                  end;                  end;
972                let (ip,port) = c.client_host in                let (ip,port) = c.client_host in
973                if !verbose_msg_clients then begin                if !verbose_msg_clients then begin
974                    lprintf "connecting %s:%d\n" (Ip.to_string ip) port;                    lprintf_nl "[BT]: connecting %s:%d" (Ip.to_string ip) port;
975                  end;                  end;
976                connection_try c.client_connection_control;                connection_try c.client_connection_control;
977                  begin                  begin
978                    let sock = connect token "bittorrent download"                    let sock = connect token "bittorrent download"
979                        (Ip.to_inet_addr ip) port                        (Ip.to_inet_addr ip) port
980                        (fun sock event ->                        (fun sock event ->
981                          match event with                          match event with
982                            BASIC_EVENT LTIMEOUT ->                            BASIC_EVENT LTIMEOUT ->
983                              if !verbose_msg_clients then                              if !verbose_msg_clients then
984                                lprintf "CLIENT %d: LIFETIME\n" (client_num c);                                lprintf_nl "[BT]: CLIENT %d: LIFETIME" (client_num c);
985                              close sock Closed_for_timeout                              close sock Closed_for_timeout
986                          | BASIC_EVENT RTIMEOUT ->                          | BASIC_EVENT RTIMEOUT ->
987                              if !verbose_msg_clients then                              if !verbose_msg_clients then
988                                lprintf "CLIENT %d: RTIMEOUT (%d)\n" (client_num c)                                lprintf_nl "[BT]: CLIENT %d: RTIMEOUT (%d)" (client_num c)
989                                (last_time ())                                (last_time ())
990                                ;                                ;
991                              close sock Closed_for_timeout                              close sock Closed_for_timeout
992                          | BASIC_EVENT (CLOSED r) ->                          | BASIC_EVENT (CLOSED r) ->
993                              begin                              begin
994                                match c.client_sock with                                match c.client_sock with
995                                | Connection s when s == sock ->                                | Connection s when s == sock ->
996                                    disconnect_client c r                                    disconnect_client c r
997                                | _ -> ()                                | _ -> ()
998                              end;                              end;
# Line 1029  let connect_client c = Line 1007  let connect_client c =
1007                    let file = c.client_file in                    let file = c.client_file in
1008                                        
1009                    if !verbose_msg_clients then begin                    if !verbose_msg_clients then begin
1010                        lprintf "READY TO DOWNLOAD FILE\n";                        lprintf_nl "[BT]: READY TO DOWNLOAD FILE";
1011                      end;                      end;
1012                      
1013                    send_init !!client_uid file.file_id sock;                    send_init !!client_uid file.file_id sock;
1014  (* Fabrice: Initialize the client bitmap and uploader fields to <> None *)  (* Fabrice: Initialize the client bitmap and uploader fields to <> None *)
1015                    update_client_bitmap c;                    update_client_bitmap c;
1016  (*              (try get_from_client sock c with _ -> ());*)  (*              (try get_from_client sock c with _ -> ());*)
1017                    incr counter;                    incr counter;
1018  (*We 'hook' the client_parse_header function to the socket                    (*We 'hook' the client_parse_header function to the socket
1019                This function will then be called when the first message will                      This function will then be called when the first message will
1020                be parsed*)                      be parsed
1021                      *)
1022                    set_bt_sock sock !verbose_msg_clients                    set_bt_sock sock !verbose_msg_clients
1023                      (BTHeader (client_parse_header !counter (ref (Some c)) true))                      (BTHeader (client_parse_header !counter (ref (Some c)) true))
1024                  end                  end
1025              with e ->              with e ->
1026                  lprintf "Exception %s while connecting to client\n"                  lprintf_nl "[BT]: Exception %s while connecting to client"
1027                    (Printexc2.to_string e);                    (Printexc2.to_string e);
1028                  disconnect_client c (Closed_for_exception e)                  disconnect_client c (Closed_for_exception e)
1029          );          );
1030  (*Since this is a pending connection put ConnectionWaiting        (*Since this is a pending connection put ConnectionWaiting
1031        in client_sock          in client_sock
1032  *)        *)
1033        in        in
1034        c.client_sock <- ConnectionWaiting token        c.client_sock <- ConnectionWaiting token
1035    | _ -> ()    | _ -> ()
1036    
1037    
   
1038  (** The Listen function (very much like in C : TCP Socket Server).  (** The Listen function (very much like in C : TCP Socket Server).
1039  Monitors client connection to us.  Monitors client connection to us.
1040  *)  *)
1041  let listen () =  let listen () =
1042    try    try
1043      let s = TcpServerSocket.create "bittorrent client server"      let s = TcpServerSocket.create "bittorrent client server"
1044          (Ip.to_inet_addr !!client_bind_addr)          (Ip.to_inet_addr !!client_bind_addr)
1045          !!client_port          !!client_port
1046          (fun sock event ->          (fun sock event ->
1047            match event with            match event with
1048              TcpServerSocket.CONNECTION (s,              TcpServerSocket.CONNECTION (s,
1049                Unix.ADDR_INET(from_ip, from_port)) ->                Unix.ADDR_INET(from_ip, from_port)) ->
1050  (*Receiving an event TcpServerSocket.CONNECTION from                (*Receiving an event TcpServerSocket.CONNECTION from
1051                the TcpServerSocket means that a new client try                  the TcpServerSocket means that a new client try
1052                  to connect to us*)                  to connect to us
1053                let ip = (Ip.of_inet_addr from_ip) in                *)
1054                if !verbose_sources > 1 then lprintf "CONNECTION RECEIVED FROM %s\n"                let ip = (Ip.of_inet_addr from_ip) in
1055                  if !verbose_sources > 1 then lprintf_nl "[BT]: CONNECTION RECEIVED FROM %s"
1056                  (Ip.to_string (Ip.of_inet_addr from_ip))                  (Ip.to_string (Ip.of_inet_addr from_ip))
1057                ;                ;
1058  (*Reject this connection if we don't want                (*Reject this connection if we don't want
1059                  to bypass the max_connection parameter*)                  to bypass the max_connection parameter
1060                if can_open_connection connection_manager &&                *)
1061                  (match Ip_set.match_ip !Ip_set.bl ip with                if can_open_connection connection_manager &&
1062                       None -> true                  (match Ip_set.match_ip !Ip_set.bl ip with
1063                     | Some br ->                     None -> true
1064                         if !verbose_connect then                   | Some br ->
1065                           lprintf "%s:%d blocked: %s\n"                       if !verbose_connect then
1066                             (Ip.to_string ip) from_port br.blocking_description;                         lprintf_nl "[BT]: %s:%d blocked: %s"
1067                         false)                                     (Ip.to_string ip) from_port br.blocking_description;
1068                then                       false)
1069                  then
1070                  begin                  begin
1071                    let token = create_token connection_manager in                    let token = create_token connection_manager in
1072                    let sock = TcpBufferedSocket.create token                    let sock = TcpBufferedSocket.create token
1073                        "bittorrent client connection" s                        "bittorrent client connection" s
1074                        (fun sock event ->                        (fun sock event ->
1075                          match event with                          match event with
1076                            BASIC_EVENT (RTIMEOUT|LTIMEOUT) ->                            BASIC_EVENT (RTIMEOUT|LTIMEOUT) ->
1077  (*monitor read and life timeout on client                            (*monitor read and life timeout on client
1078                          sockets*)                              sockets
1079                              *)
1080                              close sock Closed_for_timeout                              close sock Closed_for_timeout
1081                          | _ -> ()                          | _ -> ()
1082                      )                      )
# Line 1108  let listen () = Line 1089  let listen () =
1089                        match !c with                        match !c with
1090                          Some c ->  begin                          Some c ->  begin
1091                              match c.client_sock with                              match c.client_sock with
1092                              | Connection s when s == sock ->                              | Connection s when s == sock ->
1093                                  disconnect_client c r                                  disconnect_client c r
1094                              | _ -> ()                              | _ -> ()
1095                            end                            end
# Line 1232  for parsing the response*) Line 1213  for parsing the response*)
1213                                  port := Int64.to_int p                                  port := Int64.to_int p
1214                              | _ -> ()                              | _ -> ()
1215                          ) list;                          ) list;
1216                            
1217                          if !peer_id != Sha1.null &&                          if !peer_id != Sha1.null &&
1218                            !peer_id <> !!client_uid &&                            !peer_id <> !!client_uid &&
1219                            !peer_ip != Ip.null &&                            !peer_ip != Ip.null &&
1220                            !port <> 0 &&                            !port <> 0 &&
1221                            (match match_ip !Ip_set.bl !peer_ip with                            (match match_ip !Ip_set.bl !peer_ip with
1222                                None -> true                                None -> true
1223                              | Some br ->                              | Some br ->
1224                                  if !verbose_connect then                                  if !verbose_connect then
1225                                    lprintf "%s:%d blocked: %s\n"                                    lprintf_nl "[BT]: %s:%d blocked: %s"
1226                                      (Ip.to_string !peer_ip) !port br.blocking_description;                                      (Ip.to_string !peer_ip) !port br.blocking_description;
1227                                  false)                                  false)
1228                          then                          then
1229                            let c = new_client file !peer_id (!peer_ip,!port)                            let c = new_client file !peer_id (!peer_ip,!port)
1230                            in                            in
1231                            if !verbose_sources > 1 then lprintf "Received %s:%d\n" (Ip.to_string !peer_ip)                            if !verbose_sources > 1 then lprintf_nl "[BT]: Received %s:%d" (Ip.to_string !peer_ip)
1232                            !port;                            !port;
1233                            ()                            ()
                       
                       
1234                      | _ -> assert false                      | _ -> assert false
                   
1235                  ) list                  ) list
1236              | String "peers", String p ->              | String "peers", String p ->
1237                  let rec iter_comp s pos l =                  let rec iter_comp s pos l =
1238                    if pos < l then                    if pos < l then
1239                      let ip = Ip.of_ints (get_uint8 s pos,get_uint8 s (pos+1),                      let ip = Ip.of_ints (get_uint8 s pos,get_uint8 s (pos+1),
1240                          get_uint8 s (pos+2),get_uint8 s (pos+3))                          get_uint8 s (pos+2),get_uint8 s (pos+3))
1241                      and port = get_int16 s (pos+4)                      and port = get_int16 s (pos+4)
1242                      in                      in
1243                      ignore( new_client file Sha1.null (ip,port));                      ignore( new_client file Sha1.null (ip,port));
1244                      t.tracker_last_clients_num <- t.tracker_last_clients_num + 1;                      t.tracker_last_clients_num <- t.tracker_last_clients_num + 1;
1245                        
1246                      iter_comp s (pos+6) l                      iter_comp s (pos+6) l
1247                  in                  in
1248                  iter_comp p 0 (String.length p)                  iter_comp p 0 (String.length p)
1249              | _ -> lprintf "BT: received unknown entry in answer from tracker: %s\n" (Bencode.print key)              | String "private", Int n -> ()
1250                  (* TODO: if set to 1, disable peer exchange *)
1251    
1252                | _ -> lprintf_nl "[BT]: received unknown entry in answer from tracker: %s : %s" (Bencode.print key) (Bencode.print value)
1253          ) list;          ) list;
1254  (*Now, that we have added new clients to a file, it's time         (*Now, that we have added new clients to a file, it's time
1255          to connect to them*)           to connect to them*)
1256          if !verbose_sources > 0 then          if !verbose_sources > 0 then
1257            lprintf "get_sources_from_tracker: got %i sources for file %s\n"            lprintf_nl "[BT]: get_sources_from_tracker: got %i source(s) for file %s"
1258              t.tracker_last_clients_num file.file_name;              t.tracker_last_clients_num file.file_name;
1259          resume_clients file          resume_clients file
1260        
1261      | _ -> assert false          | _ -> assert false
1262    in    in
1263    let event =    let event =
1264      if file.file_tracker_connected then ""      if file.file_tracker_connected then ""
1265      else "started"      else "started"
1266    in    in
1267    connect_trackers file event f    connect_trackers file event f
1268        
       
     
1269    
1270  (** Check to see if file is finished, if not  (** Check to see if file is finished, if not
1271    try to get sources for it    try to get sources for it
1272  *)    *)
1273  let recover_files () =  let recover_files () =
1274    List.iter (fun file ->    List.iter (fun file ->
1275        match file.file_swarmer with        match file.file_swarmer with
# Line 1304  let recover_files () = Line 1283  let recover_files () =
1283                (try                (try
1284                    connect_trackers file "" (fun _ _ -> ()) with _ -> ())                    connect_trackers file "" (fun _ _ -> ()) with _ -> ())
1285            | FilePaused -> () (*when we are paused we do nothing, not even logging this vvvv*)            | FilePaused -> () (*when we are paused we do nothing, not even logging this vvvv*)
1286            | s -> lprintf "Other state %s!!\n" (string_of_state s)            | s -> lprintf_nl "[BT]: Other state %s!!" (string_of_state s)
1287        ) !current_files        ) !current_files
1288          
1289  let upload_buffer = String.create 100000  let upload_buffer = String.create 100000
1290      
1291    
1292  (**  (**
1293    Send a Piece message    Send a Piece message
# Line 1316  let upload_buffer = String.create 100000 Line 1295  let upload_buffer = String.create 100000
1295    @param sock The socket of the client    @param sock The socket of the client
1296    @param c The client    @param c The client
1297  *)    *)  
1298  let rec iter_upload sock c =  let rec iter_upload sock c =
1299    match c.client_upload_requests with    match c.client_upload_requests with
1300      [] -> ()      [] -> ()
1301    | (num, pos, len) :: tail ->    | (num, pos, len) :: tail ->
# Line 1379  let client_can_upload c allowed = Line 1358  let client_can_upload c allowed =
1358    )    )
1359    
1360    
   
1361  (** Probably useless now  (** Probably useless now
1362  *)  *)
1363  let file_resume file =  let file_resume file =
1364  (* useless with no saving of sources    (*useless with no saving of sources
1365    resume_clients file;       resume_clients file;
1366  *)    *)
1367    (try get_sources_from_tracker file  with _ -> ())    (try get_sources_from_tracker file  with _ -> ())
1368    
1369    
1370    
   
   
1371  (**  (**
1372    Send info to tracker when stopping a file.    Send info to tracker when stopping a file.
1373    @param file the file we want to stop    @param file the file we want to stop
1374  *)  *)
1375  let file_stop file =  let file_stop file =
1376      if file.file_tracker_connected then      if file.file_tracker_connected then
1377      begin      begin
1378        connect_trackers file "stopped" (fun _ _ ->        connect_trackers file "stopped" (fun _ _ ->
1379            lprintf "BT-Tracker return: stopped %s\n" file.file_name;            lprintf_nl "[BT]: BT-Tracker return: stopped %s" file.file_name;
1380            file.file_tracker_connected <- false)            file.file_tracker_connected <- false)
1381      end      end
1382          
1383  (**  (**
1384    Create the 'hooks'    Create the 'hooks'
1385  *)              *)
1386  let _ =  let _ =
1387    client_ops.op_client_can_upload <- client_can_upload;    client_ops.op_client_can_upload <- client_can_upload;
1388    file_ops.op_file_resume <- file_resume;    file_ops.op_file_resume <- file_resume;
1389    file_ops.op_file_recover <- file_resume;    file_ops.op_file_recover <- file_resume;
1390    file_ops.op_file_pause <- (fun file ->    file_ops.op_file_pause <- (fun file ->
1391        Hashtbl.iter (fun _ c ->        Hashtbl.iter (fun _ c ->
1392            match c.client_sock with            match c.client_sock with
1393              Connection sock -> close sock Closed_by_user              Connection sock -> close sock Closed_by_user
# Line 1422  let _ = Line 1398  let _ =
1398    );    );
1399    client_ops.op_client_enter_upload_queue <- (fun c ->    client_ops.op_client_enter_upload_queue <- (fun c ->
1400        if !verbose_msg_clients then        if !verbose_msg_clients then
1401          lprintf "CLIENT %d: client_enter_upload_queue\n" (client_num c);          lprintf_nl "[BT]: CLIENT %d: client_enter_upload_queue" (client_num c);
1402        ready_for_upload (as_client c));        ready_for_upload (as_client c));
1403    network.op_network_connected_servers <- (fun _ -> []);    network.op_network_connected_servers <- (fun _ -> []);
   
     

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.40

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26