diff --git a/Makefile b/Makefile index c9e8f78..c5adb09 100644 --- a/Makefile +++ b/Makefile @@ -28,8 +28,11 @@ NO_LIBS_opt= NO_STATIC_LIBS_opt= NO_CMXA= -LIBS_byte=-custom bigarray.cma unix.cma str.cma -LIBS_opt= bigarray.cmxa unix.cmxa str.cmxa +BITSTRING_DIR="$(shell ocamlfind query bitstring)" +#BITSTRING_DIR=/usr/lib/ocaml/bitstring + +LIBS_byte=-custom bigarray.cma unix.cma str.cma -I $(BITSTRING_DIR) bitstring.cma +LIBS_opt= bigarray.cmxa unix.cmxa str.cmxa -I $(BITSTRING_DIR) bitstring.cmxa BIGARRAY_LIBS_opt=bigarray.cmxa BIGARRAY_LIBS_byte=bigarray.cma @@ -91,7 +94,7 @@ SRC_FILETP=src/networks/fileTP SUBDIRS=$(CDK) $(LIB) $(RSS) $(XML) $(NET) tools \ $(COMMON) $(DRIVER) $(MP3) src/config/$(OS_FILES) -INCLUDES += $(foreach file, $(SUBDIRS), -I $(file)) +INCLUDES += $(foreach file, $(SUBDIRS), -I $(file)) -I $(BITSTRING_DIR) CFLAGS:=$(CFLAGS) $(CONFIG_INCLUDES) $(GTKCFLAGS) $(GD_CFLAGS) @@ -426,6 +429,7 @@ BITTORRENT_SRCS= \ $(SRC_BITTORRENT)/bTRate.ml \ $(SRC_BITTORRENT)/bTTypes.ml \ $(SRC_BITTORRENT)/bTOptions.ml \ + $(SRC_BITTORRENT)/bTUdpTracker.ml \ $(SRC_BITTORRENT)/bTProtocol.ml \ $(SRC_BITTORRENT)/bTTorrent.ml \ $(SRC_BITTORRENT)/bTGlobals.ml \ @@ -1482,11 +1486,14 @@ ZOGSOURCES += $(BITTORRENT_ZOG:.zog=.ml) MLTSOURCES += $(BITTORRENT_MLT:.mlt=.ml) MLPSOURCES += $(BITTORRENT_MLP:.mlcpp=.ml) +$(SRC_BITTORRENT)/bTUdpTracker.ml: $(SRC_BITTORRENT)/bTUdpTracker.mlp + camlp4of -I $(BITSTRING_DIR) bitstring.cma bitstring_persistent.cma pa_bitstring.cmo -impl $< -o $@ + build/mlbt.cmxa: $(BITTORRENT_OBJS) $(BITTORRENT_CMXS) - $(OCAMLOPT) -a -o $@ $(BITTORRENT_OBJS) $(LIBS_flags) $(_LIBS_flags) $(BITTORRENT_CMXS) + $(OCAMLOPT) -a -o $@ -I $(BITSTRING_DIR) $(BITTORRENT_OBJS) $(LIBS_flags) $(_LIBS_flags) $(BITTORRENT_CMXS) build/mlbt.cma: $(BITTORRENT_OBJS) $(BITTORRENT_CMOS) - $(OCAMLC) -a -o $@ $(BITTORRENT_OBJS) $(LIBS_flags) $(_LIBS_flags) $(BITTORRENT_CMOS) + $(OCAMLC) -a -o $@ -I $(BITSTRING_DIR) $(BITTORRENT_OBJS) $(LIBS_flags) $(_LIBS_flags) $(BITTORRENT_CMOS) diff --git a/src/networks/bittorrent/bTClients.ml b/src/networks/bittorrent/bTClients.ml index ff27686..d58e3d4 100644 --- a/src/networks/bittorrent/bTClients.ml +++ b/src/networks/bittorrent/bTClients.ml @@ -18,7 +18,8 @@ *) -(** Functions used in client<->client communication +(** Functions used in client<->client communication + and also client<->tracker *) (** A peer (or client) is always a remote peer in this file. @@ -73,6 +74,125 @@ let http11_ok = "HTTP/1.1 200 OK" let next_uploaders = ref ([] : BTTypes.client list) let current_uploaders = ref ([] : BTTypes.client list) +(** Check that client is valid and record it *) +let maybe_new_client file id ip port = + let cc = Geoip.get_country_code_option ip in + if id <> !!client_uid + && ip != Ip.null + && port <> 0 + && (match !Ip.banned (ip, cc) with + | None -> true + | Some reason -> + if !verbose_connect then + lprintf_file_nl (as_file file) "%s:%d blocked: %s" (Ip.to_string ip) port reason; + false) + then + ignore (new_client file id (ip,port) cc); + if !verbose_sources > 1 then + lprintf_file_nl (as_file file) "Received %s:%d" (Ip.to_string ip) port + + +let resume_clients_hook = ref (fun _ -> assert false) + +include struct + +(* open modules locally *) +open BTUdpTracker +open UdpSocket + +let string_of_event = function + | READ_DONE -> "READ_DONE" + | WRITE_DONE -> "WRITE_DONE" + | CAN_REFILL -> "CAN_REFILL" + | BASIC_EVENT e -> match e with + | CLOSED reason -> "CLOSED " ^ (string_of_reason reason) + | RTIMEOUT -> "RTIMEOUT" + | WTIMEOUT -> "WTIMEOUT" + | LTIMEOUT -> "LTIMEOUT" + | CAN_READ -> "CAN_READ" + | CAN_WRITE -> "CAN_WRITE" + +(** talk to udp tracker and parse response + except of parsing should perform everything that + talk_to_tracker's inner function does FIXME refactor both + + Better create single global udp socket and use it for all + tracker requests and distinguish trackers by txn? FIXME? + *) +let talk_to_udp_tracker host port args file t need_sources = + try + lprintf_nl "udpt start with %s:%d" host port; + let addr = try (Unix.gethostbyname host).Unix.h_addr_list.(0) with exn -> failwith ("failed to resolve " ^ host) in + let ip = Ip.of_inet_addr addr in + lprintf_nl "udpt resolved to ip %s" (Ip.to_string ip); + let socket = create Unix.inet_addr_any 0 (fun sock event -> +(* lprintf_nl "udpt got event %s for %s" (string_of_event event) host *) + match event with + | WRITE_DONE | CAN_REFILL -> () + | READ_DONE -> assert false (* set_reader prevents this *) + | BASIC_EVENT x -> match x with + | CLOSED _ -> () + | CAN_READ | CAN_WRITE -> assert false (* udpSocket implementation prevents this *) + | LTIMEOUT | WTIMEOUT | RTIMEOUT -> close sock (Closed_for_error "udpt timeout")) + in + BasicSocket.set_wtimeout (sock socket) 120.; + BasicSocket.set_rtimeout (sock socket) 120.; + let txn = Random.int32 Int32.max_int in + lprintf_nl "udpt txn %ld for %s" txn host; + write socket false (connect_request txn) ip port; + set_reader socket (fun _ -> + let p = read socket in + let conn = connect_response p.udp_content txn in + lprintf_nl "udpt connection_id %Ld for %s" conn host; + let txn = Random.int32 Int32.max_int in + lprintf_nl "udpt txn' %ld for host %s" txn host; + let int s = Int64.of_string (List.assoc s args) in + let req = announce_request conn txn + ~info_hash:(List.assoc "info_hash" args) + ~peer_id:(List.assoc "peer_id" args) + (int "downloaded",int "left",int "uploaded") + (match List.assoc "event" args with + | "completed" -> 1l + | "started" -> 2l + | "stopped" -> 3l + | "" -> 0l + | s -> lprintf_nl "udpt event %s? for %s" s host; 0l) + ~numwant:(try Int32.of_string (List.assoc "numwant" args) with _ -> -1l) + (int_of_string (List.assoc "port" args)) + in + write socket false req ip port; + set_reader socket (fun _ -> + let p = read socket in + + t.tracker_last_conn <- last_time (); + file.file_tracker_connected <- true; + t.tracker_interval <- 600; + t.tracker_min_interval <- 600; + if need_sources then t.tracker_last_clients_num <- 0; + + let (interval,clients) = announce_response p.udp_content txn in + lprintf_nl "udpt got interval %ld clients %d for host %s" interval (List.length clients) host; + if interval > 0l then + begin + t.tracker_interval <- Int32.to_int interval; + if t.tracker_min_interval > t.tracker_interval then + t.tracker_min_interval <- t.tracker_interval + end; + List.iter (fun (ip',port) -> + let ip = Ip.of_int64 (Int64.logand 0xFFFFFFFFL (Int64.of_int32 ip')) in + lprintf_nl "udpt got %s:%d" (Ip.to_string ip) port; + t.tracker_last_clients_num <- t.tracker_last_clients_num + 1; + maybe_new_client file Sha1.null ip port + ) clients; + close socket Closed_by_user; + lprintf_nl "udpt interact done for %s" host; + if need_sources then !resume_clients_hook file + )) + with + exn -> + lprintf_nl "udpt interact exn %s" (Printexc2.to_string exn) + +end (* include *) (** In this function we connect to a tracker. @@ -173,28 +293,30 @@ let connect_trackers file event f = then begin (* if we already tried to connect but failed, disable tracker, but allow re-enabling *) - if file.file_tracker_connected && t.tracker_last_clients_num = 0 && - t.tracker_last_conn < 1 then begin + (* FIXME t.tracker_last_conn < 1 only at first connect, so later failures will stay undetected! *) + if file.file_tracker_connected && t.tracker_last_clients_num = 0 && t.tracker_last_conn < 1 then + begin if !verbose_msg_servers then - lprintf_nl "Request error from tracker: disabling %s" t.tracker_url; - t.tracker_status <- Disabled (intern "MLDonkey: Request error from tracker") + lprintf_nl "Request error from tracker: disabling %s" (show_tracker_url t.tracker_url); + t.tracker_status <- Disabled (intern "MLDonkey: Request error from tracker") end (* Send request to tracker *) - else begin - let args = if String.length t.tracker_id > 0 then - ("trackerid", t.tracker_id) :: args else args - in - let args = if String.length t.tracker_key > 0 then - ("key", t.tracker_key) :: args else args - in - if !verbose_msg_servers then - lprintf_nl "get_sources_from_tracker: tracker_connected:%s id:%s key:%s last_clients:%i last_conn-last_time:%i file: %s" - (string_of_bool file.file_tracker_connected) - t.tracker_id t.tracker_key t.tracker_last_clients_num - (t.tracker_last_conn - last_time()) file.file_name; - + else + let args = if String.length t.tracker_id > 0 then + ("trackerid", t.tracker_id) :: args else args + in + let args = if String.length t.tracker_key > 0 then + ("key", t.tracker_key) :: args else args + in + if !verbose_msg_servers then + lprintf_nl "connect_trackers: connected:%s id:%s key:%s last_clients:%i last_conn-last_time:%i numwant:%s file: %s" + (string_of_bool file.file_tracker_connected) + t.tracker_id t.tracker_key t.tracker_last_clients_num + (t.tracker_last_conn - last_time()) (try List.assoc "numwant" args with _ -> "_") file.file_name; + + match t.tracker_url with + | `Http url -> let module H = Http_client in - let url = t.tracker_url in let r = { H.basic_request with H.req_url = Url.of_string ~args: args url; @@ -206,19 +328,20 @@ let connect_trackers file event f = if !verbose_msg_servers then lprintf_nl "Request sent to tracker %s for file: %s" - t.tracker_url file.file_name; + url file.file_name; H.wget r (fun fileres -> t.tracker_last_conn <- last_time (); file.file_tracker_connected <- true; f t fileres) - end + | `Other url -> assert false (* should have been disabled *) + | `Udp (host,port) -> talk_to_udp_tracker host port args file t need_sources end else if !verbose_msg_servers then lprintf_nl "Request NOT sent to tracker %s - next request in %ds for file: %s" - t.tracker_url (t.tracker_interval - (last_time () - t.tracker_last_conn)) file.file_name + (show_tracker_url t.tracker_url) (t.tracker_interval - (last_time () - t.tracker_last_conn)) file.file_name ) enabled_trackers let start_upload c = @@ -354,7 +477,9 @@ let disconnect_clients file = let download_finished file = if List.memq file !current_files then begin - connect_trackers file "completed" (fun _ _ -> ()); (*must be called before swarmer gets removed from file*) + connect_trackers file "completed" (fun _ _ -> + lprintf_file_nl (as_file file) "Tracker return: completed %s" file.file_name; + ()); (*must be called before swarmer gets removed from file*) (*CommonComplexOptions.file_completed*) file_completed (as_file file); (* Remove the swarmer for this file as it is not useful anymore... *) @@ -1304,6 +1429,9 @@ let resume_clients file = lprintf_file_nl (as_file file) "Exception %s in resume_clients" (Printexc2.to_string e) ) file.file_clients +let () = + resume_clients_hook := resume_clients + (** Check if the value replied by the tracker is correct. @param key the name of the key @param n the value to check @@ -1313,17 +1441,15 @@ let resume_clients file = let chk_keyval key n url name = let int_n = (Int64.to_int n) in if !verbose_msg_clients then - lprintf_nl "Reply from %s in file: %s has %s: %d" url name key int_n; + lprintf_nl "Reply from %s in file: %s has %s: %d" (show_tracker_url url) name key int_n; if int_n > -1 then int_n else begin - lprintf_nl "Reply from %s in file: %s has an invalid %s value: %d" url name key int_n; + lprintf_nl "Reply from %s in file: %s has an invalid %s value: %d" (show_tracker_url url) name key int_n; 0 end - -(** In this function we initiate a connection to the file tracker - to get sources. +(** In this function we interact with the tracker @param file The file for which we want some sources @param url Url of the tracker If we have less than !!ask_tracker_threshold sources @@ -1335,6 +1461,7 @@ let get_sources_from_tracker file = (*This is the function which will be called by the http client for parsing the response *) + let tracker_url = show_tracker_url t.tracker_url in let tracker_reply = try File.to_string filename @@ -1344,7 +1471,7 @@ let get_sources_from_tracker file = match tracker_reply with | "" -> if !verbose_connect then - lprintf_file_nl (as_file file) "Empty reply from tracker"; + lprintf_file_nl (as_file file) "Empty reply from tracker %s" tracker_url; Bencode.decode "" | _ -> Bencode.decode tracker_reply in @@ -1359,7 +1486,7 @@ let get_sources_from_tracker file = | _ -> (match t.tracker_status with | Disabled_failure (i, _) -> lprintf_file_nl (as_file file) "Received good message from Tracker %s in file: %s after %d bad attempts" - t.tracker_url file.file_name i + (show_tracker_url t.tracker_url) file.file_name i | _ -> ()); (* Received good message from tracker after failures, re-enable tracker *) t.tracker_status <- Enabled); @@ -1373,9 +1500,9 @@ let get_sources_from_tracker file = lprintf_file_nl (as_file file) "Failure no. %d%s from Tracker %s in file: %s Reason: %s" (match t.tracker_status with | Disabled_failure (i,_) -> i | _ -> 1) (if !!tracker_retries = 0 then "" else Printf.sprintf "/%d" !!tracker_retries) - t.tracker_url file.file_name (Charset.to_utf8 failure) + tracker_url file.file_name (Charset.to_utf8 failure) | String "warning message", String warning -> - lprintf_file_nl (as_file file) "Warning from Tracker %s in file: %s Reason: %s" t.tracker_url file.file_name warning + lprintf_file_nl (as_file file) "Warning from Tracker %s in file: %s Reason: %s" tracker_url file.file_name warning | String "interval", Int n -> t.tracker_interval <- chk_keyval (Bencode.print key) n t.tracker_url file.file_name; (* in case we don't receive "min interval" *) @@ -1406,11 +1533,11 @@ let get_sources_from_tracker file = | String "key", String n -> t.tracker_key <- n; if !verbose_msg_clients then - lprintf_file_nl (as_file file) "%s in file: %s has key: %s" t.tracker_url file.file_name n + lprintf_file_nl (as_file file) "%s in file: %s has key: %s" tracker_url file.file_name n | String "tracker id", String n -> t.tracker_id <- n; if !verbose_msg_clients then - lprintf_file_nl (as_file file) "%s in file: %s has tracker id %s" t.tracker_url file.file_name n + lprintf_file_nl (as_file file) "%s in file: %s has tracker id %s" tracker_url file.file_name n | String "peers", List list -> List.iter (fun v -> @@ -1478,6 +1605,11 @@ let get_sources_from_tracker file = lprintf_file_nl (as_file file) "get_sources_from_tracker: got %i source(s) for file %s" t.tracker_last_clients_num file.file_name; resume_clients file + (* + lprintf_file_nl (as_file file) "talk_to_tracker: got %i source(s) from %s" + t.tracker_last_clients_num tracker_url; + if need_sources then resume_clients file + *) | _ -> assert false in diff --git a/src/networks/bittorrent/bTComplexOptions.ml b/src/networks/bittorrent/bTComplexOptions.ml index 8ce1a77..566729d 100644 --- a/src/networks/bittorrent/bTComplexOptions.ml +++ b/src/networks/bittorrent/bTComplexOptions.ml @@ -219,7 +219,7 @@ let file_to_value file = "file_uploaded", int64_to_value (file.file_uploaded); "file_id", string_to_value (Sha1.to_string file.file_id); "file_trackers", (list_to_value string_to_value) - (List.map (fun t -> t.tracker_url) file.file_trackers); + (List.map (fun t -> show_tracker_url t.tracker_url) file.file_trackers); (* OK, but I still don't like the idea of forgetting all the clients. We should have a better strategy, ie rating the clients and connecting to them depending on the results of our last connections. And then, diff --git a/src/networks/bittorrent/bTGlobals.ml b/src/networks/bittorrent/bTGlobals.ml index 1f23a51..dd92e0f 100644 --- a/src/networks/bittorrent/bTGlobals.ml +++ b/src/networks/bittorrent/bTGlobals.ml @@ -230,17 +230,31 @@ let create_temp_file file_temp file_files file_state = file_temp); file_fd -let can_handle_tracker t = - String2.check_prefix (String.lowercase t.tracker_url) "http://" +let make_tracker_url url = + let url = String.lowercase url in + if String2.check_prefix url "http://" then + `Http url + else + try Scanf.sscanf url "udp://%s@:%d" (fun host port -> `Udp (host,port)) + with _ -> `Other url + +(** invariant: [make_tracker_url (show_tracker_url url) = url] *) +let show_tracker_url : tracker_url -> string = function + | `Http url | `Other url -> url + | `Udp (host,port) -> Printf.sprintf "udp://%s:%d" host port + +let can_handle_tracker = function + | `Http _ -> false + | `Udp _ -> true + | `Other _ -> false let rec set_trackers file file_trackers = match file_trackers with | [] -> () | url :: q -> - if not (List.exists (fun tracker -> - tracker.tracker_url = url - ) file.file_trackers) then - let t = { + let url = make_tracker_url url in + if not (List.exists (fun tracker -> tracker.tracker_url = url) file.file_trackers) then + let t = { tracker_url = url; tracker_interval = 600; tracker_min_interval = 600; @@ -253,12 +267,11 @@ let rec set_trackers file file_trackers = tracker_torrent_last_dl_req = 0; tracker_id = ""; tracker_key = ""; - tracker_status = Enabled - } in - if not (can_handle_tracker t) then - t.tracker_status <- Disabled_mld (intern "Tracker type not supported"); - file.file_trackers <- t :: file.file_trackers; - set_trackers file q + tracker_status = if can_handle_tracker url then Enabled + else Disabled_mld (intern "Tracker type not supported") + } in + file.file_trackers <- t :: file.file_trackers; + set_trackers file q let new_file file_id t torrent_diskname file_temp file_state user group = try @@ -867,7 +880,7 @@ let remove_client c = let remove_tracker url file = if !verbose_msg_servers then List.iter (fun tracker -> - lprintf_nl "Old tracker list :%s" tracker.tracker_url + lprintf_nl "Old tracker list: %s" (show_tracker_url tracker.tracker_url) ) file.file_trackers; List.iter (fun bad_tracker -> if bad_tracker.tracker_url = url then @@ -875,7 +888,7 @@ let remove_tracker url file = ) file.file_trackers; if !verbose_msg_servers then List.iter (fun tracker -> - lprintf_nl "New tracker list :%s" tracker.tracker_url + lprintf_nl "New tracker list: %s" (show_tracker_url tracker.tracker_url) ) file.file_trackers let tracker_is_enabled t = diff --git a/src/networks/bittorrent/bTInteractive.ml b/src/networks/bittorrent/bTInteractive.ml index d7930e2..70c02e8 100644 --- a/src/networks/bittorrent/bTInteractive.ml +++ b/src/networks/bittorrent/bTInteractive.ml @@ -193,14 +193,15 @@ let op_file_print file o = Printf.bprintf buf "\\\\" (html_mods_cntr ()); let tracker_header_printed = ref false in List.iter (fun tracker -> + let tracker_url = show_tracker_url tracker.tracker_url in let tracker_text = match tracker.tracker_status with | Disabled s | Disabled_mld s -> - Printf.sprintf "\\disabled: %s\\\\--error: %s\\" tracker.tracker_url s + Printf.sprintf "\\disabled: %s\\\\--error: %s\\" tracker_url s | Disabled_failure (i,s) -> - Printf.sprintf "\\disabled: %s\\\\--error: %s (try %d)\\" tracker.tracker_url s i + Printf.sprintf "\\disabled: %s\\\\--error: %s (try %d)\\" tracker_url s i | _ -> - Printf.sprintf "enabled: %s" tracker.tracker_url + Printf.sprintf "enabled: %s" tracker_url in html_mods_td buf [ @@ -209,7 +210,7 @@ let op_file_print file o = else ("", "sr br", "") ); - (tracker.tracker_url, "sr", tracker_text)]; + (tracker_url, "sr", tracker_text)]; Printf.bprintf buf "\\\\" (html_mods_cntr ()); tracker_header_printed := true; ) file.file_trackers; @@ -370,12 +371,13 @@ let op_file_print file o = Printf.bprintf buf "Trackers:\n"; List.iter (fun tracker -> + let tracker_url = show_tracker_url tracker.tracker_url in match tracker.tracker_status with | Disabled s | Disabled_mld s -> - Printf.bprintf buf "%s, disabled: %s\n" tracker.tracker_url s + Printf.bprintf buf "%s, disabled: %s\n" tracker_url s | Disabled_failure (i,s) -> - Printf.bprintf buf "%s, disabled (try %d): %s\n" tracker.tracker_url i s - | _ -> Printf.bprintf buf "%s\n" tracker.tracker_url + Printf.bprintf buf "%s, disabled (try %d): %s\n" tracker_url i s + | _ -> Printf.bprintf buf "%s\n" tracker_url ) file.file_trackers; if file.file_torrent_diskname <> "" then Printf.bprintf buf "Torrent diskname: %s\n" file.file_torrent_diskname; @@ -646,9 +648,7 @@ let load_torrent_string s user group = (* Save the torrent, because we later want to put it in the seeded directory. *) let torrent_is_usable = ref false in - let can_handle_tracker url = - String2.check_prefix url "http://" in - List.iter (fun url -> if can_handle_tracker url then torrent_is_usable := true) + List.iter (fun url -> if can_handle_tracker (make_tracker_url url) then torrent_is_usable := true) (if torrent.torrent_announce_list <> [] then torrent.torrent_announce_list else [torrent.torrent_announce]); if not !torrent_is_usable then raise (Torrent_can_not_be_used torrent.torrent_name); diff --git a/src/networks/bittorrent/bTProtocol.ml b/src/networks/bittorrent/bTProtocol.ml index 8d24926..ce66d7b 100644 --- a/src/networks/bittorrent/bTProtocol.ml +++ b/src/networks/bittorrent/bTProtocol.ml @@ -218,7 +218,6 @@ With bencoded payload: Choke/unchoke every 10 seconds *) - open BasicSocket open CommonTypes open Printf2 @@ -637,3 +636,4 @@ let send_init client_uid file_id sock = Buffer.add_string buf (Sha1.direct_to_string client_uid); let s = Buffer.contents buf in write_string sock s + diff --git a/src/networks/bittorrent/bTTorrent.ml b/src/networks/bittorrent/bTTorrent.ml index fc13385..451b243 100644 --- a/src/networks/bittorrent/bTTorrent.ml +++ b/src/networks/bittorrent/bTTorrent.ml @@ -112,12 +112,12 @@ let decode_torrent s = match key, value with String "path", List path -> current_file := path_list_to_string path; - if !verbose_msg_servers then - lprintf_nl "[BT] Parsed a new path: [%s]" !current_file + (*if !verbose_msg_servers then + lprintf_nl "[BT] Parsed a new path: [%s]" !current_file*) | String "path.utf-8", List path_utf8 -> current_file_utf8 := path_list_to_string path_utf8; - if !verbose_msg_servers then - lprintf_nl "[BT] Parsed path.utf-8: [%s]" !current_file + (*if !verbose_msg_servers then + lprintf_nl "[BT] Parsed path.utf-8: [%s]" !current_file*) | String "length", Int n -> length := !length ++ n; current_length := n; @@ -147,7 +147,7 @@ let decode_torrent s = match key, value with String "announce", String tracker_url -> if !verbose_msg_servers then - lprintf_nl "[BT] New tracker added :%s" tracker_url; + lprintf_nl "[BT] New tracker added: %s" tracker_url; announce := tracker_url | String "announce-list", List list -> List.iter (fun url_list -> diff --git a/src/networks/bittorrent/bTTypes.ml b/src/networks/bittorrent/bTTypes.ml index aa5af21..474d26f 100644 --- a/src/networks/bittorrent/bTTypes.ml +++ b/src/networks/bittorrent/bTTypes.ml @@ -222,6 +222,11 @@ type tracker_status = | Disabled_mld of string | Disabled_failure of (int * string) +type tracker_url = +[ `Http of string (* url *) +| `Udp of string * int (* host and port *) +| `Other of string ] + type client = { client_client : client CommonClient.client_impl; mutable client_file : file; @@ -277,7 +282,7 @@ type client = { } and tracker_info = { - tracker_url : string; + tracker_url : tracker_url; mutable tracker_interval : int; mutable tracker_min_interval : int; mutable tracker_last_conn : int; diff --git a/src/networks/bittorrent/bTUdpTracker.mlp b/src/networks/bittorrent/bTUdpTracker.mlp new file mode 100644 index 0000000..c086bf1 --- /dev/null +++ b/src/networks/bittorrent/bTUdpTracker.mlp @@ -0,0 +1,104 @@ + +(* +open BasicSocket +open CommonTypes +open Printf2 +open CommonOptions +open Options +open Md4 +open CommonGlobals +open BigEndian +open TcpBufferedSocket +open AnyEndian +open BTTypes +*) + +(** UDP trackers + http://www.bittorrent.org/beps/bep_0015.html *) + +open Bitstring + +let of_bits = string_of_bitstring +let bits = bitstring_of_string + +(* +Choose a random transaction ID. +Fill the connect request structure. +Send the packet. +*) +let connect_request txn = + of_bits ( BITSTRING { 0x41727101980L : 64 ; 0l : 32 ; txn : 32 } ) + +exception Error of string + +let fail fmt = Printf.ksprintf (fun s -> raise (Error s)) fmt + +(* +Receive the packet. +Check whether the packet is at least 16 bytes. +Check whether the transaction ID is equal to the one you chose. +Check whether the action is connect. +Store the connection ID for future use. +*) +let connect_response s exp_txn = + bitmatch bits s with + | { 0l : 32 ; txn : 32 ; conn_id : 64 } -> + if txn = exp_txn then conn_id else fail "error connect_response txn %ld expected %ld" txn exp_txn + | { 3l : 32 ; txn : 32 ; msg : -1 : string } -> fail "error connect_response txn %ld : %s" txn msg + | { _ } -> fail "error connect_response" + +(* +Choose a random transaction ID. +Fill the announce request structure. +Send the packet. +*) +let announce_request conn txn ~info_hash ~peer_id (downloaded,left,uploaded) event ?(key=0l) ~numwant port = + of_bits (BITSTRING { + conn : 64 ; + 1l : 32 ; + txn : 32 ; + info_hash : 20 * 8 : string; + peer_id : 20 * 8 : string; + downloaded : 64 ; + left : 64 ; + uploaded : 64 ; + event : 32 ; + 0l : 32 ; (* ip *) + key : 32 ; (* key *) + numwant : 32 ; (* key *) + port : 16 }) + +(* +Receive the packet. +Check whether the packet is at least 20 bytes. +Check whether the transaction ID is equal to the one you chose. +Check whether the action is announce. +Do not announce again until interval seconds have passed or an event has occurred. +*) +let announce_response s exp_txn = + let rec clients rest l = + bitmatch rest with + | { ip : 32 ; port : 16 ; rest : -1 : bitstring } -> clients rest ((ip,port)::l) + | { _ } -> l + in + bitmatch bits s with + | { 1l : 32 ; txn : 32 ; interval : 32 ; leechers : 32 ; seeders : 32 ; + rest : -1 : bitstring } -> + if txn = exp_txn then + (interval,clients rest []) + else + fail "error announce_response txn %ld expected %ld" txn exp_txn + | { 3l : 32 ; txn : 32 ; msg : -1 : string } -> fail "error announce_response txn %ld : %s" txn msg + | { _ } -> fail "error announce_response" + +(* +If the tracker encounters an error, it might send an error packet. +Receive the packet. +Check whether the packet is at least 8 bytes. +Check whether the transaction ID is equal to the one you chose. +*) +let error_response s = + bitmatch bits s with + | { 3l : 32 ; txn : 32 ; msg : -1 : string } -> Some (txn, msg) + | { _ } -> None + diff --git a/src/utils/lib/options.ml4 b/src/utils/lib/options.ml4 index 43f0deb..38e3379 100644 --- a/src/utils/lib/options.ml4 +++ b/src/utils/lib/options.ml4 @@ -256,10 +256,10 @@ let really_load filename sections = let temp_file = filename ^ ".tmp" in if Sys.file_exists temp_file then begin - Printf.eprintf "File %s exists\n" temp_file; - Printf.eprintf "An error may have occurred during previous configuration save.\n"; - Printf.eprintf "Please, check your configurations files, and rename/remove this file\n"; - Printf.eprintf "before restarting\n"; + lprintf "File %s exists\n" temp_file; + lprintf "An error may have occurred during previous configuration save.\n"; + lprintf "Please, check your configurations files, and rename/remove this file\n"; + lprintf "before restarting\n"; exit 70 end; Unix2.tryopen_read filename (fun ic -> @@ -271,10 +271,10 @@ let really_load filename sections = try parse_gwmlrc stream with e -> - Printf.eprintf "Syntax error while parsing file %s at pos %d:(%s)\n" + lprintf "Syntax error while parsing file %s at pos %d:(%s)\n" filename (Stream.count s) (Printexc2.to_string e); - Printf.eprintf "it seems that %s is corrupt,\n" filename; - Printf.eprintf "try to use a backup from %s\n" + lprintf "it seems that %s is corrupt,\n" filename; + lprintf "try to use a backup from %s\n" (Filename.concat (Sys.getcwd ()) "old_config"); exit 70 in Hashtbl.clear once_values;