24 |
open Printf2 |
open Printf2 |
25 |
|
|
26 |
open BasicSocket |
open BasicSocket |
27 |
|
|
28 |
open CommonGlobals |
open CommonGlobals |
29 |
|
|
30 |
open BTOptions |
open BTOptions |
31 |
open BTTypes |
open BTTypes |
32 |
open BTGlobals |
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 |
|
|
45 |
that we can filter out immediatly sources that are not interesting for |
that we can filter out immediatly sources that are not interesting for |
46 |
them. |
them. |
47 |
*) |
*) |
48 |
|
|
49 |
(* |
(* |
50 |
|
|
51 |
torrents/: for BitTorrent |
torrents/: for BitTorrent |
57 |
|
|
58 |
*) |
*) |
59 |
|
|
|
|
|
60 |
open Http_server |
open Http_server |
61 |
|
|
62 |
type tracker_peer = { |
type tracker_peer = { |
267 |
|
|
268 |
(* Try to find the .torrent file, normally in torrents/, but maybe |
(* Try to find the .torrent file, normally in torrents/, but maybe |
269 |
in sub-directories in former versions. *) |
in sub-directories in former versions. *) |
270 |
|
|
271 |
let filename = |
let filename = |
272 |
let file_name = Filename.concat old_torrents_directory filename in |
let file_name = Filename.concat old_torrents_directory filename in |
273 |
(* lprintf " xx [%s]/[%s]\n" file_name filename; *) |
(* lprintf " xx [%s]/[%s]\n" file_name filename; *) |
285 |
(Printf.sprintf "Tracker HTTPD: torrent [%s] not found" filename) |
(Printf.sprintf "Tracker HTTPD: torrent [%s] not found" filename) |
286 |
in |
in |
287 |
r.reply_content <- File.to_string filename |
r.reply_content <- File.to_string filename |
288 |
|
|
289 |
with e -> |
with e -> |
290 |
lprintf "BTTracker: for request [%s] exception %s\n" |
lprintf_nl "[BT]: Tracker: for request [%s] exception %s" |
291 |
(Url.to_string r.get_url) (Printexc2.to_string e); |
(Url.to_string r.get_url) (Printexc2.to_string e); |
292 |
|
|
293 |
r.reply_head <- "404 Not Found" |
r.reply_head <- "404 Not Found" |
294 |
|
|
295 |
(* We came back to the "universal" tracker, i.e. a tracker for all files |
(* We came back to the "universal" tracker, i.e. a tracker for all files |
296 |
with only a limitation on the number. So, this function is not useful anymore. |
with only a limitation on the number. So, this function is not useful anymore. |
297 |
|
|
298 |
let scan_tracked_directory _ = |
let scan_tracked_directory _ = |
299 |
let filenames = Unix2.list_directory tracked_directory in |
let filenames = Unix2.list_directory tracked_directory in |
300 |
|
|
301 |
let old_tracked_files = !current_tracked_files in |
let old_tracked_files = !current_tracked_files in |
302 |
current_tracked_files := Hashtbl.create 13; |
current_tracked_files := Hashtbl.create 13; |
303 |
List.iter (fun filename -> |
List.iter (fun filename -> |
345 |
TcpServerSocket.close sock Closed_by_user; |
TcpServerSocket.close sock Closed_by_user; |
346 |
tracker_sock := None |
tracker_sock := None |
347 |
|
|
348 |
(* Every 600 seconds *) |
(* Every 600 seconds, refresh the peers list *) |
349 |
let clean_tracker_timer () = |
let clean_tracker_timer () = |
350 |
let time_threshold = last_time () - 3600 in |
let time_threshold = last_time () - 3600 in |
351 |
let trackers = ref [] in |
let trackers = ref [] in |
352 |
|
|
353 |
if !verbose_msg_servers then lprintf "clean_tracker_timer\n"; |
if !verbose_msg_servers then lprintf_nl "[BT]: clean_tracker_timer"; |
354 |
Hashtbl.iter (fun _ tracker -> |
Hashtbl.iter (fun _ tracker -> |
355 |
let list = ref [] in |
let list = ref [] in |
356 |
let old_peers = ref [] in |
let old_peers = ref [] in |
357 |
Hashtbl.iter (fun _ peer -> |
Hashtbl.iter (fun _ peer -> |
358 |
if peer.peer_active < time_threshold then |
if peer.peer_active < time_threshold then |
359 |
old_peers := peer :: !old_peers |
old_peers := peer :: !old_peers |
360 |
else |
else |
361 |
if Ip.valid peer.peer_ip && ip_reachable peer.peer_ip then |
if Ip.valid peer.peer_ip && ip_reachable peer.peer_ip then |
362 |
list := peer :: !list) |
list := peer :: !list) |
363 |
tracker.tracker_table; |
tracker.tracker_table; |
364 |
List.iter (fun p -> |
List.iter (fun p -> |
365 |
Hashtbl.remove tracker.tracker_table p.peer_id |
Hashtbl.remove tracker.tracker_table p.peer_id |
375 |
List.iter (fun t -> |
List.iter (fun t -> |
376 |
Hashtbl.add tracked_files t.tracker_id t |
Hashtbl.add tracked_files t.tracker_id t |
377 |
) !trackers |
) !trackers |
378 |
|
|
379 |
let _ = |
let _ = |
380 |
add_infinite_timer 600. clean_tracker_timer |
add_infinite_timer 600. clean_tracker_timer |
|
|
|