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

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

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

revision 1.13 by spiralvoice, Thu Jul 7 00:25:46 2005 UTC revision 1.14 by spiralvoice, Sun Jul 10 23:19:16 2005 UTC
# Line 33  open BTGlobals Line 33  open BTGlobals
33  open Bencode  open Bencode
34    
35    
36  open Gettext    open Gettext
37  let _s x = _s "BTTracker" x  let _s x = _s "BTTracker" x
38  let _b x = _b "BTTracker" x  let _b x = _b "BTTracker" x
39    
40  (*  (*
41    
42  We could have a a-la-edonkey tracker: it would connect back to incoming  We could have a a-la-edonkey tracker: it would connect back to incoming
43    client, and check whether they are accessible from the outside world,    client, and check whether they are accessible from the outside world,
# Line 65  type tracker_peer = { Line 65  type tracker_peer = {
65      mutable peer_port : int;      mutable peer_port : int;
66      mutable peer_active : int;      mutable peer_active : int;
67    }    }
68      
69  type tracker = {  type tracker = {
70      tracker_id : Sha1.t;      tracker_id : Sha1.t;
71      mutable tracker_table : (Sha1.t, tracker_peer) Hashtbl.t;      mutable tracker_table : (Sha1.t, tracker_peer) Hashtbl.t;
# Line 73  type tracker = { Line 73  type tracker = {
73      mutable tracker_message_content : string;      mutable tracker_message_content : string;
74      mutable tracker_message_time : int;      mutable tracker_message_time : int;
75    }    }
76        
77  let tracker_sock = ref None    let tracker_sock = ref None
78  let tracked_files = Hashtbl.create 13  let tracked_files = Hashtbl.create 13
79  let ntracked_files = ref 0  let ntracked_files = ref 0
80      
81  let tracker_port = define_option bittorrent_section ["tracker_port"]  let tracker_port = define_option bittorrent_section ["tracker_port"]
82    "The port to bind the tracker to"    "The port to bind the tracker to"
83      int_option 6881      int_option 6881
84      
85  let max_tracked_files = define_option bittorrent_section ["max_tracked_files"]  let max_tracked_files = define_option bittorrent_section ["max_tracked_files"]
86    "The maximal number of tracked files (to prevend saturation attack)"    "The maximal number of tracked files (to prevend saturation attack)"
87      int_option 100      int_option 100
88      
89  let max_tracker_reply = define_option bittorrent_section ["max_tracker_reply"]  let max_tracker_reply = define_option bittorrent_section ["max_tracker_reply"]
90    "The maximal number of peers returned by the tracker"    "The maximal number of peers returned by the tracker"
91      int_option 20      int_option 20
92    
93      
     
94  let int64_of_string v =  let int64_of_string v =
95    try    try
96      Int64.of_string v      Int64.of_string v
97    with e ->    with e ->
98        lprintf "Exception %s in int64_of_string [%s]\n"        lprintf "Exception %s in int64_of_string [%s]\n"
99          (Printexc2.to_string e) v;          (Printexc2.to_string e) v;
100        raise e        raise e
101      
102  let int_of_string v =  let int_of_string v =
103    try    try
104      int_of_string v      int_of_string v
105    with e ->    with e ->
106        lprintf "Exception %s in int_of_string [%s]\n"        lprintf "Exception %s in int_of_string [%s]\n"
107          (Printexc2.to_string e) v;          (Printexc2.to_string e) v;
108        raise e        raise e
109    
# Line 117  let void_message = Bencode.encode ( Line 116  let void_message = Bencode.encode (
116    
117  let reply_has_tracker r info_hash peer_id peer_port peer_event =  let reply_has_tracker r info_hash peer_id peer_port peer_event =
118    
119    lprintf "tracker contacted for %s\n" (Sha1.to_string info_hash);    lprintf_nl "[BT]: tracker contacted for %s" (Sha1.to_string info_hash);
120    let tracker = try    let tracker = try
121        Hashtbl.find tracked_files info_hash        Hashtbl.find tracked_files info_hash
122      with Not_found ->      with Not_found ->
123          lprintf "Need new tracker\n";          lprintf_nl "[BT]: Need new tracker";
124          if !ntracked_files < !!max_tracked_files then          if !ntracked_files < !!max_tracked_files then
125            let tracker = {            let tracker = {
126                tracker_id = info_hash;                tracker_id = info_hash;
# Line 133  let reply_has_tracker r info_hash peer_i Line 132  let reply_has_tracker r info_hash peer_i
132            incr ntracked_files;            incr ntracked_files;
133            Hashtbl.add tracked_files info_hash tracker;            Hashtbl.add tracked_files info_hash tracker;
134            tracker            tracker
135          else          else
136            failwith "Too many tracked files"            failwith "BT]: Too many tracked files"
137    in    in
138      
139    let peer =    let peer =
140      try      try
141        let peer =        let peer =
142          Hashtbl.find tracker.tracker_table peer_id          Hashtbl.find tracker.tracker_table peer_id
143        in        in
144        peer.peer_ip <- fst (TcpBufferedSocket.peer_addr r.sock);        peer.peer_ip <- fst (TcpBufferedSocket.peer_addr r.sock);
145        peer.peer_port <- peer_port;        peer.peer_port <- peer_port;
146        peer.peer_active <- last_time ();        peer.peer_active <- last_time ();
147        peer        peer
148      with _ ->      with _ ->
149          let peer =          let peer =
150            {            {
151              peer_id = peer_id;              peer_id = peer_id;
152              peer_ip = fst (TcpBufferedSocket.peer_addr r.sock);              peer_ip = fst (TcpBufferedSocket.peer_addr r.sock);
153              peer_port = peer_port;              peer_port = peer_port;
154              peer_active = last_time ();              peer_active = last_time ();
155            } in            } in
156          lprintf "adding new peer\n";          lprintf_nl "BT]: adding new peer";
157          Hashtbl.add tracker.tracker_table peer_id peer;          Hashtbl.add tracker.tracker_table peer_id peer;
158          Fifo.put tracker.tracker_peers peer;          Fifo.put tracker.tracker_peers peer;
159          peer          peer
160    in    in
161    let message =    let message =
162      match peer_event with      match peer_event with
163        "completed" -> void_message        "completed" ->
164            void_message
165  (* Reply with clients that could not connect to this tracker otherwise *)  (* Reply with clients that could not connect to this tracker otherwise *)
166      | "stopped" -> void_message      | "stopped" ->
167            void_message
168  (* Don't return anything *)  (* Don't return anything *)
169      | _ ->      | _ ->
170  (* Return the 20 best peers. In fact, we should only return peers if  (* Return the 20 best peers. In fact, we should only return peers if
171    this peer is behind a firewall. *)    this peer is behind a firewall. *)
172            
173          if tracker.tracker_message_time < last_time () then          if tracker.tracker_message_time < last_time () then
174              
175            let list = ref [] in            let list = ref [] in
176            lprintf "Tracker collecting peers:\n";            lprintf_nl "BT]: Tracker collecting peers:";
177            (try            (try
178                for i = 1 to !!max_tracker_reply do                for i = 1 to !!max_tracker_reply do
179                  let peer = Fifo.take tracker.tracker_peers in                  let peer = Fifo.take tracker.tracker_peers in
180                  lprintf "   %s:%d\n" (Ip.to_string peer.peer_ip)peer.peer_port;                  lprintf_nl "   %s:%d" (Ip.to_string peer.peer_ip)peer.peer_port;
181                  list := peer :: !list                  list := peer :: !list
182                done                done
183              with _ -> ());              with _ -> ());
184                        
185            lprintf "Tracker sending %d peers\n" (List.length !list);            lprintf "Tracker sending %d peers\n" (List.length !list);
186            List.iter (fun p ->            List.iter (fun p ->
187                lprintf "Tracker send: %s:%d\n"                lprintf "Tracker send: %s:%d\n"
# Line 189  let reply_has_tracker r info_hash peer_i Line 190  let reply_has_tracker r info_hash peer_i
190            ) !list;            ) !list;
191    
192  (* reply by sending [head] *)  (* reply by sending [head] *)
193              
194            let message =            let message =
195              Dictionary [              Dictionary [
196                String "interval", Int (Int64.of_int 600);                String "interval", Int (Int64.of_int 600);
197                String "peers", List                String "peers", List
198                  (List.map (fun p ->                  (List.map (fun p ->
199                      Dictionary [                      Dictionary [
200                        String "peer id", String                        String "peer id", String
201                          (Sha1.direct_to_string p.peer_id);                          (Sha1.direct_to_string p.peer_id);
202                        String "ip", String (Ip.to_string p.peer_ip);                        String "ip", String (Ip.to_string p.peer_ip);
203                        String "port",                        String "port",
204                        Int (Int64.of_int p.peer_port);                        Int (Int64.of_int p.peer_port);
205                      ]                      ]
206                  ) !list)                  ) !list)
207              ]              ]
208            in            in
209            let m = Bencode.encode message in            let m = Bencode.encode message in
210              
211  (* We cache the reply for one minute if we sent enough replies. *)  (* We cache the reply for one minute if we sent enough replies. *)
212            if List.length !list = !!max_tracker_reply then begin            if List.length !list = !!max_tracker_reply then begin
213                tracker.tracker_message_time <- last_time () + 60;                tracker.tracker_message_time <- last_time () + 60;
214                tracker.tracker_message_content <- m;                tracker.tracker_message_content <- m;
215              end;              end;
216            m            m
217          else          else
218            tracker.tracker_message_content            tracker.tracker_message_content
219    in    in
220      
221    r.reply_content <-  message    r.reply_content <- message
222      
223  let http_handler t r =  let http_handler t r =
224    try    try
225      add_reply_header r "Server" "MLdonkey";      add_reply_header r "Server" "MLdonkey";
226      add_reply_header r "Connection" "close";      add_reply_header r "Connection" "close";
227      add_reply_header r "Content-Type" "application/x-bittorrent";      add_reply_header r "Content-Type" "application/x-bittorrent";
228        
229      match r.get_url.Url.short_file with      match r.get_url.Url.short_file with
230        "/tracker" ->        "/tracker" ->
231            
232          let args = r.get_url.Url.args in          let args = r.get_url.Url.args in
233          let info_hash = ref Sha1.null in          let info_hash = ref Sha1.null in
234          let peer_id = ref Sha1.null in          let peer_id = ref Sha1.null in
# Line 243  let http_handler t r = Line 244  let http_handler t r =
244              | "port" -> port := int_of_string arg              | "port" -> port := int_of_string arg
245              | "uploaded" -> uploaded := int64_of_string arg              | "uploaded" -> uploaded := int64_of_string arg
246              | "downloaded" -> downloaded := int64_of_string arg              | "downloaded" -> downloaded := int64_of_string arg
247              | "left" -> left  := int64_of_string arg              | "left" -> left := int64_of_string arg
248              | "event" -> event := arg              | "event" -> event := arg
249              | _ -> lprintf "BTTracker: Unexpected [%s=%s]\n" name arg              | _ -> lprintf_nl "BT]: BTTracker: Unexpected [%s=%s]" name arg
250          ) args;          ) args;
251            
252          lprintf "Connection received by tracker: \n";          lprintf_nl "[BT]: Connection received by tracker:";
253          lprintf "    info_hash: %s\n" (Sha1.to_string !info_hash);          lprintf_nl "    info_hash: %s" (Sha1.to_string !info_hash);
254          lprintf "    event: %s\n" !event;          lprintf_nl "    event: %s" !event;
255                    lprintf_nl "    downloaded: %d" (Int64.to_int !downloaded);
256          reply_has_tracker r !info_hash !peer_id !port !event                    lprintf_nl "    uploaded: %d" (Int64.to_int !uploaded);
257        
258            reply_has_tracker r !info_hash !peer_id !port !event
259    
260      | filename ->      | filename ->
261    
262          lprintf "Request for .torrent [%s]\n" filename;          lprintf_nl "BT]: Request for .torrent [%s]" filename;
263          if (Filename2.last_extension filename <> ".torrent") then          if (Filename2.last_extension filename <> ".torrent") then
264            failwith "Incorrect filename 1";            failwith "Incorrect filename 1";
265          for i = 1 to String.length filename - 1 do          for i = 1 to String.length filename - 1 do
# Line 268  let http_handler t r = Line 271  let http_handler t r =
271  (* Try to find the .torrent file, normally in torrents/, but maybe  (* Try to find the .torrent file, normally in torrents/, but maybe
272  in sub-directories in former versions. *)  in sub-directories in former versions. *)
273    
274          let filename =          let filename =
275            let file_name = Filename.concat old_torrents_directory filename in            let file_name = Filename.concat old_torrents_directory filename in
276  (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)  (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)
277            if Sys.file_exists file_name then file_name else            if Sys.file_exists file_name then file_name else
# Line 278  in sub-directories in former versions. * Line 281  in sub-directories in former versions. *
281            let file_name = Filename.concat tracked_directory filename in            let file_name = Filename.concat tracked_directory filename in
282  (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)  (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)
283            if Sys.file_exists file_name then file_name else            if Sys.file_exists file_name then file_name else
284            let file_name = Filename.concat seeded_directory filename in            let file_name = Filename.concat seeded_directory filename in
285  (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)  (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)
286            if Sys.file_exists file_name then file_name else            if Sys.file_exists file_name then file_name else
287              failwith              failwith
288                (Printf.sprintf "Tracker HTTPD: torrent [%s] not found" filename)                (Printf.sprintf "Tracker HTTPD: torrent [%s] not found" filename)
289          in          in
290          r.reply_content <- File.to_string filename          r.reply_content <- File.to_string filename
# Line 305  let scan_tracked_directory _ = Line 308  let scan_tracked_directory _ =
308        try        try
309          let s = File.to_string filename in          let s = File.to_string filename in
310          let (info_hash : Sha1.t), torrent = decode_torrent s in          let (info_hash : Sha1.t), torrent = decode_torrent s in
311          let tracker =          let tracker =
312            try            try
313              Hashtbl.find old_tracked_files info_hash              Hashtbl.find old_tracked_files info_hash
314            with Not_found ->            with Not_found ->
# Line 321  let scan_tracked_directory _ = Line 324  let scan_tracked_directory _ =
324    ) filenames    ) filenames
325      *)      *)
326    
327  let start_tracker () =  let start_tracker () =
328    if !!tracker_port <> 0 then    if !!tracker_port <> 0 then
329      let config = {      let config = {
330          bind_addr = Unix.inet_addr_any ;          bind_addr = Unix.inet_addr_any ;
# Line 329  let start_tracker () = Line 332  let start_tracker () =
332          requests = [];          requests = [];
333          addrs = [ Ip.of_string "255.255.255.255" ];          addrs = [ Ip.of_string "255.255.255.255" ];
334          base_ref = "";          base_ref = "";
335          default = http_handler;                default = http_handler;
336        } in        } in
337      let sock = TcpServerSocket.create "BT tracker"      let sock = TcpServerSocket.create "BT tracker"
338          (Ip.to_inet_addr !!client_bind_addr)          (Ip.to_inet_addr !!client_bind_addr)
339        !!tracker_port (Http_server.handler config) in        !!tracker_port (Http_server.handler config) in
340      tracker_sock := Some sock;      tracker_sock := Some sock;
341      ()      ()
342        
343  let stop_tracker () =  let stop_tracker () =
344    match !tracker_sock with    match !tracker_sock with
345      None -> ()      None -> ()

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

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