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