Index: src/networks/fileTP/fileTPInteractive.ml =================================================================== --- src/networks/fileTP/fileTPInteractive.ml (revision 137) +++ src/networks/fileTP/fileTPInteractive.ml (working copy) @@ -313,13 +313,49 @@ download_file_from_mirror file u; find_mirrors file u - - - + +let is_http_torrent headers url = + let ext = String.lowercase (Filename2.last_extension url) in + if ext = ".torrent" || ext = ".tor" || + (String2.contains headers "content-type application/x-bittorrent") then true else false + +let get_regexp_int text r = + ignore (Str.search_forward r text 0); + let a = Str.group_beginning 1 in + let b = Str.group_end 1 in + int_of_string (String.sub text a (b - a)) + +let get_regexp_string text r = + ignore (Str.search_forward r text 0); + let a = Str.group_beginning 1 in + let b = Str.group_end 1 in + String.sub text a (b - a) + +let rec op_network_parse_url url = + lprintf "filetp.op_network_parse_url\n"; + let location_regexp = "Location: \\(.*\\)" in + let real_url = get_regexp_string url (Str.regexp location_regexp) in + lprintf "real url: %s\n" real_url; + if (is_http_torrent url real_url) then false else + if (String2.check_prefix real_url "http://") then ( + lprintf "http download\n"; + let length_regexp = "Content-Length: \\(.*\\)" in + try let length = get_regexp_int url (Str.regexp length_regexp) in + if (length > 0) then begin + download_file real_url; true + end + else raise Not_found + with Not_found -> lprintf "Unknown file length. Use a web browser\n"; false + ) + else if (String2.check_prefix url "ftp://") || (String2.check_prefix url "ssh://") then ( + download_file url; + true + ) + else + false + let _ = - network.op_network_parse_url <- (fun url -> - false); - () + network.op_network_parse_url <- op_network_parse_url open Queues open GuiTypes Index: src/networks/bittorrent/bTInteractive.ml =================================================================== --- src/networks/bittorrent/bTInteractive.ml (revision 137) +++ src/networks/bittorrent/bTInteractive.ml (working copy) @@ -320,19 +320,17 @@ let load_torrent_string torrent_basename s = let file_id, torrent = BTTorrent.decode_torrent s in - let torrent_diskname = Filename.concat downloads_directory torrent_basename in File.from_string torrent_diskname s; - let file = new_download file_id torrent torrent_diskname in BTClients.get_sources_from_tracker file; file let load_torrent_file torrent_basename filename = + lprintf "BTInteractive.load_torrent_file %s %s\n" torrent_basename filename; let s = File.to_string filename in - lprintf "BTInteractive.load_torrent_file %s\n" filename; ignore (load_torrent_string torrent_basename s) let parse_tracker_reply file t filename = @@ -431,22 +429,27 @@ load_torrent_file file_diskname filename; file_cancel (as_ft ft); end) + +let valid_torrent_extension url = + let ext = String.lowercase (Filename2.last_extension url) in + if ext = ".torrent" || ext = ".tor" then true else false + +let get_regexp_string text r = + ignore (Str.search_forward r text 0); + let a = Str.group_beginning 1 in + let b = Str.group_end 1 in + String.sub text a (b - a) let op_network_parse_url url = - let ext = String.lowercase (Filename2.last_extension url) in - lprintf "Last extension: %s\n" ext; - if ext = ".torrent" || ext = ".tor" then - try - lprintf "Trying to load %s\n" url; - load_torrent_file url url; - true - with e -> - lprintf "Exception %s while loading\n" (Printexc2.to_string e); - - let u = Url.of_string url in + (*lprintf "BT.op_network_parse_url";*) + let location_regexp = "Location: \\(.*\\)" in + try let real_url = get_regexp_string url (Str.regexp location_regexp) in + if (valid_torrent_extension real_url) || + (String2.contains url "Content-Type: application/x-bittorrent") then ( + let u = Url.of_string real_url in let module H = Http_client in let r = { - H.basic_request with + H.basic_request with H.req_url = u; H.req_proxy = !CommonOptions.http_proxy; H.req_user_agent = @@ -455,9 +458,9 @@ let referers = !!BTOptions.referers in let (rule_search,rule_value) = try (List.find(fun (rule_search,rule_value) -> - Str.string_match (Str.regexp rule_search) url 0 + Str.string_match (Str.regexp rule_search) real_url 0 ) referers ) - with Not_found -> ("",url) in + with Not_found -> ("",real_url) in Some (Url.of_string rule_value) ); H.req_headers = try let cookies = List.assoc u.Url.server !!BTOptions.cookies in @@ -477,8 +480,20 @@ load_torrent_from_web r (Filename.basename u.Url.short_file) ft; lprintf "wget started\n"; true - else - false + ) + else + false + with Not_found -> + if (valid_torrent_extension url) then + try + load_torrent_file (Filename2.basename url) url; + true + with e -> + lprintf "Exception %s while loading\n" (Printexc2.to_string e); + false + else + false + let op_client_info c = let module P = GuiTypes in Index: src/utils/net/http_client.ml =================================================================== --- src/utils/net/http_client.ml (revision 137) +++ src/utils/net/http_client.ml (working copy) @@ -285,20 +285,19 @@ with _ -> lprintf "bad content length [%s]\n" content; ) headers; - - let content_handler = content_handler !content_length headers in + let location = "Location", Url.to_string old_url in + let content_handler = content_handler !content_length (location::headers) in set_reader sock content_handler; let buf = TcpBufferedSocket.buf sock in if buf.len > 0 then content_handler sock buf.len - | 302 -> - lprintf "Http_client 302: Redirect\n"; + | 301 | 302 -> + lprintf "Http_client 30x: Redirect\n"; if level < 10 then begin try let url = List.assoc "Location" headers in - lprintf "Redirected to %s\n" url; List.iter (fun (name, value) -> lprintf "[%s]=[%s]\n" name value; ) headers; @@ -382,7 +381,7 @@ (try f headers with _ -> ()); fun sock nread -> close sock Closed_by_user - ) + ) (fun _ -> ()) let wget_string r f progress = Index: src/daemon/driver/driverCommands.ml =================================================================== --- src/daemon/driver/driverCommands.ml (revision 137) +++ src/daemon/driver/driverCommands.ml (working copy) @@ -2153,22 +2153,48 @@ "dllink", Arg_multiple (fun args o -> - let buf = o.conn_buf in + lprintf "dllink\n"; + let buf = o.conn_buf in + let query_networks url = + if not (networks_iter_until_true + (fun n -> + try + network_parse_url n url + with e -> + Printf.bprintf buf "Exception %s for network %s\n" + (Printexc2.to_string e) (n.network_name); + false + )) then + _s "Unable to match URL" + else + _s "done" + in + let url = String2.unsplit args ' ' in - - if not (networks_iter_until_true - (fun n -> - try - network_parse_url n url - with e -> - Printf.bprintf buf "Exception %s for network %s\n" - (Printexc2.to_string e) (n.network_name); - false - )) then - _s "Unable to match URL" - else - _s "done" - ), " :\t\t\t\tdownload ed2k, sig2dat, torrent or other link"; + if (String2.starts_with url "http") then ( + let u = Url.of_string url in + let module H = Http_client in + let r = { + H.basic_request with + H.req_url = u; + H.req_proxy = !CommonOptions.http_proxy; + H.req_request = H.HEAD; + H.req_user_agent = + Printf.sprintf "MLdonkey/%s" Autoconf.current_version; + } in + H.whead r + (fun headers -> + (* Combine the list of header fields into one string *) + let concat_headers = + (List.fold_right (fun (n, c) t -> n ^ ": " ^ c ^ "\n" ^ t) headers "") in + ignore (query_networks concat_headers) + ); + + _s "Parsing HTTP url..." + ) + else + query_networks url + ), " :\t\t\t\tdownload ed2k, sig2dat, torrent or other link"; "dllinks", Arg_one (fun arg o -> let buf = o.conn_buf in