[Mldonkey-commits] mldonkey distrib/ChangeLog src/networks/bittorr...

[mldonkey-commits]

CVSROOT:        /sources/mldonkey
Module name:    mldonkey
Changes by:     spiralvoice <spiralvoice>       10/04/11 10:45:25

Modified files:
        distrib        : ChangeLog 
        src/networks/bittorrent: bTInteractive.ml bTTracker.ml 
        src/utils/net  : http_server.ml 
        src/utils/xml-light: xml.mli 

Log message:
        patch #7164

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/mldonkey/distrib/ChangeLog?cvsroot=mldonkey&r1=1.1424&r2=1.1425
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTInteractive.ml?cvsroot=mldonkey&r1=1.153&r2=1.154
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/networks/bittorrent/bTTracker.ml?cvsroot=mldonkey&r1=1.31&r2=1.32
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/net/http_server.ml?cvsroot=mldonkey&r1=1.39&r2=1.40
http://cvs.savannah.gnu.org/viewcvs/mldonkey/src/utils/xml-light/xml.mli?cvsroot=mldonkey&r1=1.2&r2=1.3

Patches:
Index: distrib/ChangeLog
===================================================================
RCS file: /sources/mldonkey/mldonkey/distrib/ChangeLog,v
retrieving revision 1.1424
retrieving revision 1.1425
diff -u -b -r1.1424 -r1.1425
--- distrib/ChangeLog   11 Apr 2010 10:42:06 -0000      1.1424
+++ distrib/ChangeLog   11 Apr 2010 10:45:24 -0000      1.1425
@@ -15,6 +15,12 @@
 =========
 
 2010/04/11
+7164: BT: more user-friendly tracker (ygrek)
+- `compute_torrent` shows full path and url to generated torrent file
+- `torrents` output htmlized
+- corrected server header
+- improved comments for tracker options
+- search torrents in old directory too
 7163: Fix not sending UDP packets when max_hard_upload_rate = 0 (ygrek)
 
 2010/04/10

Index: src/networks/bittorrent/bTInteractive.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTInteractive.ml,v
retrieving revision 1.153
retrieving revision 1.154
diff -u -b -r1.153 -r1.154
--- src/networks/bittorrent/bTInteractive.ml    4 Apr 2010 09:16:28 -0000       
1.153
+++ src/networks/bittorrent/bTInteractive.ml    11 Apr 2010 10:45:24 -0000      
1.154
@@ -778,7 +778,8 @@
 
     if !verbose_share then 
       lprintf_file_nl (as_file file) "Sharing file %s" filename;
-    BTClients.talk_to_tracker file false
+    BTClients.talk_to_tracker file false;
+    Some filename
   with
   | Not_found ->
       (* if the torrent is still there while the file is gone, remove the 
torrent *)
@@ -789,19 +790,21 @@
       in
       (try
           Unix2.rename torrent_diskname new_torrent_diskname;
+          Some new_torrent_diskname
         with _ ->
-          (lprintf_nl "Failed to rename %s to %s"
-              torrent_diskname new_torrent_diskname));
+          (lprintf_nl "Failed to rename %s to %s" torrent_diskname 
new_torrent_diskname);
+           None
+          )
   | e ->
-      lprintf_nl "Cannot share torrent %s for %s"
-        torrent_diskname (Printexc2.to_string e)
+      lprintf_nl "Cannot share torrent %s for %s" torrent_diskname 
(Printexc2.to_string e);
+      None
 
 (* Call one minute after start, and then every 20 minutes. Should
   automatically contact the tracker. *)
 let share_files _ =
   if !verbose_share then lprintf_nl "share_files";
   List.iter (fun file ->
-    try_share_file (Filename.concat seeded_directory file)
+    ignore (try_share_file (Filename.concat seeded_directory file))
   ) (Unix2.list_directory seeded_directory);
   let shared_files_copy = !current_files in
  (* if the torrent is gone while the file is still shared, remove the share *)
@@ -1029,33 +1032,64 @@
 
 let op_network_connected _ = true
 
-
-let get_default_tracker () = 
-  if !!BTTracker.default_tracker = "" then
-     Printf.sprintf "http://%s:%d/announce";
-      (Ip.to_string (CommonOptions.client_ip None))
-      !!BTTracker.tracker_port 
-   else
-     !!BTTracker.default_tracker
-
 let compute_torrent filename announce comment = 
-  let announce = if announce = "" then get_default_tracker () else announce in
+  let announce = if announce = "" then BTTracker.get_default_tracker () else 
announce in
   if !verbose then lprintf_nl "compute_torrent: [%s] [%s] [%s]"
    filename announce comment;
-  let basename = Filename.basename filename in
-  let torrent = Filename.concat seeded_directory
-    (Printf.sprintf "%s.torrent" basename) in
+  let basename = Printf.sprintf "%s.torrent" (Filename.basename filename) in
+  let torrent = Filename.concat seeded_directory basename in
   let is_private = 0 in
   let file_id = BTTorrent.generate_torrent announce torrent comment 
(Int64.of_int is_private) filename in
-  try_share_file torrent;
-  ignore (BTTracker.new_tracker file_id)
+  match try_share_file torrent with 
+  | None -> failwith "Cannot share file"
+  | Some path -> 
+    Filename.concat (Sys.getcwd ()) path,
+    try `Ok (BTTracker.track_torrent basename file_id) with exn -> `Exn 
(Printexc2.to_string exn)
+
+let text fmt = Printf.ksprintf (fun s -> `Text s) fmt
+let link name url = `Link (name,url)
+
+let output buf typ elements =
+  let f = match typ with
+  | HTML | XHTML | XML ->
+    begin function 
+    | `Text s -> Xml.buffer_escape buf s
+    | `Link (name,url) -> 
+        Printf.bprintf buf "<a href=\"%s\">%s</a>" 
+          (Xml.escape url) (Xml.escape (match name with "" -> url | s -> s))
+    | `Break -> Buffer.add_string buf "<br/>"
+    end
+  | TEXT | ANSI ->
+    begin function
+    | `Text s -> Buffer.add_string buf s
+    | `Link ("",url) -> Printf.bprintf buf "%s" url
+    | `Link (name,url) -> Printf.bprintf buf "%s <%s>" name url
+    | `Break -> Buffer.add_string buf "\n"
+    end
+  in
+  List.iter f elements
+
+(* dirty hack *)
+let output o l =
+  match o.conn_output with
+  | ANSI | TEXT -> output o.conn_buf o.conn_output l
+  | HTML | XHTML | XML ->
+    let buf = Buffer.create 1024 in
+    output buf o.conn_output l;
+    let s = Buffer.contents buf in
+    for i = 0 to String.length s - 1 do
+      begin match s.[i] with
+      | '<' | '>' | '\\' | '"' | '&' -> Buffer.add_char o.conn_buf '\\'
+      | _ -> () end;
+      Buffer.add_char o.conn_buf s.[i]
+    done
 
 let commands =
 
     [
     "compute_torrent", "Network/Bittorrent", Arg_multiple (fun args o ->
-      let buf = o.conn_buf in
-      try
+      output o
+      begin try
         let filename = ref "" in
         let comment = ref "" in
         (match args with
@@ -1063,62 +1097,39 @@
         | [fname] -> filename := fname
         | _ -> raise Not_found);
 
-        compute_torrent !filename "" !comment;
-
-        if o.conn_output = HTML then
-          (* TODO: really htmlize it *)
-          Printf.bprintf buf ".torrent file generated"
-        else
-          Printf.bprintf buf ".torrent file generated\n";
-      ""
+        let (path,url) = compute_torrent !filename "" !comment in
+        [
+          text "Torrent file generated : %s" path;
+          `Break;
+          (match url with
+          | `Ok url -> link "Download" url
+          | `Exn s -> text "Not tracked : %s" s);
+          `Break
+        ]
       with 
-      | Not_found ->
-          if o.conn_output = HTML then
-            (* TODO: really htmlize it *)
-            Printf.bprintf buf "Not enough parameters"
-          else
-            Printf.bprintf buf "Not enough parameters\n";
-      ""
-      | exn ->
-        if o.conn_output = HTML then
-            (* TODO: really htmlize it *)
-            Printf.bprintf buf "Error: %s" (Printexc2.to_string exn)
-          else
-            Printf.bprintf buf "Error: %s\n" (Printexc2.to_string exn);
+      | Not_found -> [text "Not enough parameters"; `Break]
+      | exn -> [text "Error: %s" (Printexc2.to_string exn); `Break]
+      end;
       ""
     ), _s "<filename> <comment> :\tgenerate the corresponding <filename> 
.torrent file with <comment> in torrents/tracked/.\n\t\t\t\t\tThe file is 
automatically tracked, and seeded if in incoming/";
 
     "torrents", "Network/Bittorrent", Arg_none (fun o ->
-      let buf = o.conn_buf in
-      if !!BTTracker.tracker_port <> 0 then begin
-          Printf.bprintf o.conn_buf (_b ".torrent files available:\n");
+      output o 
+        begin try
+          BTTracker.check_tracker ();
           let files_tracked = Unix2.list_directory tracked_directory in
           let files_downloading = Unix2.list_directory downloads_directory in
           let files_seeded = Unix2.list_directory seeded_directory in
-          let all_torrents_files = files_tracked @ files_downloading @ 
files_seeded in
+          let files_old = Unix2.list_directory old_directory in
+          let all_torrents_files = files_tracked @ files_downloading @ 
files_seeded @ files_old in
 
-          if o.conn_output = HTML then
-            (* TODO: really htmlize it *)
-            List.iter (fun file ->
-                Printf.bprintf buf "http://%s:%d/%s "
-                  (Ip.to_string (CommonOptions.client_ip None))
-                !!BTTracker.tracker_port
-                  file
-            ) all_torrents_files
-          else
-            List.iter (fun file ->
-                Printf.bprintf buf "http://%s:%d/%s\n";
-                  (Ip.to_string (CommonOptions.client_ip None))
-                !!BTTracker.tracker_port
-                  file
-            ) all_torrents_files;
-        end
-      else
-          if o.conn_output = HTML then
-            (* TODO: really htmlize it *)
-            Printf.bprintf buf "Tracker not activated (tracker_port = 0)"
-          else
-            Printf.bprintf buf "Tracker not activated (tracker_port = 0)\n";
+          let l = List.map (fun file -> [link file (BTTracker.tracker_url 
file); `Break]) all_torrents_files in
+
+          (`Text (_s ".torrent files available:")) :: `Break :: List.flatten l
+        with
+          exn ->
+          [`Text (Printexc2.to_string exn); `Break]
+        end;
         _s ""
     ), _s ":\t\t\t\tprint all .torrent files on this server";
 
@@ -1297,7 +1308,7 @@
       let c, pos = get_string s pos in
       let sf = CommonShared.shared_find n in
       let f = shared_fullname sf in
-      compute_torrent f a c;
+      ignore (compute_torrent f a c)
   | opcode -> failwith (Printf.sprintf "[BT] Unknown message opcode %d" opcode)
 
 let _ =

Index: src/networks/bittorrent/bTTracker.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/networks/bittorrent/bTTracker.ml,v
retrieving revision 1.31
retrieving revision 1.32
diff -u -b -r1.31 -r1.32
--- src/networks/bittorrent/bTTracker.ml        4 Apr 2010 09:16:28 -0000       
1.31
+++ src/networks/bittorrent/bTTracker.ml        11 Apr 2010 10:45:25 -0000      
1.32
@@ -97,7 +97,7 @@
 
 let tracker_port = define_option bittorrent_section ["tracker_port"]
   ~restart: true
-  "The port to bind the tracker to"
+  "The port to bind the tracker to (0 to disable)"
     port_option 6881
 
 let max_tracked_files = define_option bittorrent_section ["max_tracked_files"]
@@ -117,11 +117,11 @@
     bool_option true
 
 let default_tracker = define_option bittorrent_section ["default_tracker"]
-    "Let you define a default tracker for creating torrents (leave empty for 
mlnet tracker)"
+    "Default tracker for creating torrents (leave empty for builtin tracker)"
     string_option ""
 
 let default_comment = define_option bittorrent_section ["default_comment"]
-    "Let you define a default comment for creating torrents"
+    "Default comment for creating torrents"
     string_option ""
 
 
@@ -165,7 +165,30 @@
     Hashtbl.add tracked_files info_hash tracker;
     tracker
   else
-    failwith "[BT] Too many tracked files"
+    failwith (Printf.sprintf "[BT] Too many tracked files (%d)" 
!ntracked_files)
+
+let is_tracker_running () = !tracker_sock <> None
+
+let check_tracker () =
+  if not (is_tracker_running ()) then
+    failwith "Tracker is not running (either BT-tracker_port is 0 or stopped)"
+
+let tracker_url suffix =
+  check_tracker ();
+  Printf.sprintf "http://%s:%d/%s";
+    (Ip.to_string (CommonOptions.client_ip None))
+    !!tracker_port
+    (Url.encode suffix)
+
+let track_torrent filename info_hash =
+  check_tracker ();
+  if not (Hashtbl.mem tracked_files info_hash) then ignore (new_tracker 
info_hash);
+  tracker_url filename
+
+let get_default_tracker () =
+  match !!default_tracker with
+  | "" -> tracker_url "announce"
+  | s -> s
 
 let reply_has_tracker r info_hash peer_id peer_ip peer_port peer_key peer_left 
peer_event numwant no_peer_id  =
 
@@ -233,8 +256,10 @@
        In fact, we should only return peers if this peer is behind a firewall.
      *)
 
-        if tracker.tracker_message_time < last_time () then
-
+        (* use cache *)
+        if tracker.tracker_message_time >= last_time () then
+          tracker.tracker_message_content
+        else
           let list = ref [] in
           lprintf_nl "Tracker collecting peers:";
           (try
@@ -259,8 +284,6 @@
               Fifo.put tracker.tracker_peers p
           ) !list;
 
-(* reply by sending [head] *)
-
           let message =
             Dictionary [
               "interval", Int 600L;
@@ -294,15 +317,13 @@
               tracker.tracker_message_content <- m;
             end;
           m
-        else
-          tracker.tracker_message_content
   in
 
   r.reply_content <- message
 
 let http_handler t r =
   try
-    add_reply_header r "Server" "MLdonkey";
+    add_reply_header r "Server" (Printf.sprintf "MLdonkey/%s" 
Autoconf.current_version);
     add_reply_header r "Connection" "close";
 
     match r.get_url.Url.short_file with
@@ -422,6 +443,7 @@
     | filename ->
         if !verbose_msg_servers then
           lprintf_nl "Tracker received a request for .torrent: [%s]" filename;
+        let filename = Url.decode filename in
         if (Filename2.last_extension filename <> ".torrent") then
           failwith "Incorrect filename 1";
         for i = 1 to String.length filename - 1 do
@@ -446,6 +468,9 @@
           let file_name = Filename.concat seeded_directory filename in
 (*          lprintf " xx [%s]/[%s]\n" file_name filename; *)
           if Sys.file_exists file_name then file_name else
+          let file_name = Filename.concat old_directory filename in
+(*          lprintf " xx [%s]/[%s]\n" file_name filename; *)
+          if Sys.file_exists file_name then file_name else
             failwith
               (Printf.sprintf "Tracker HTTPD: torrent [%s] not found" filename)
         in

Index: src/utils/net/http_server.ml
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/net/http_server.ml,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -b -r1.39 -r1.40
--- src/utils/net/http_server.ml        24 Feb 2009 18:35:46 -0000      1.39
+++ src/utils/net/http_server.ml        11 Apr 2010 10:45:25 -0000      1.40
@@ -251,7 +251,7 @@
     Autoconf.current_version my_ip my_port
   in
   Printf.sprintf
-"HTTP/1.1 %s %s\nMLDonkey/%s\nConnection: close
+"HTTP/1.1 %s %s\nServer: MLDonkey/%s\nConnection: close
 Content-Type: text/html; charset=iso-8859-1\nContent-length: %d\r\n"
     code error_text Autoconf.current_version (String.length reject_message), 
reject_message,
   Printf.sprintf "%s %s" code error_text

Index: src/utils/xml-light/xml.mli
===================================================================
RCS file: /sources/mldonkey/mldonkey/src/utils/xml-light/xml.mli,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -b -r1.2 -r1.3
--- src/utils/xml-light/xml.mli 8 Apr 2010 19:01:34 -0000       1.2
+++ src/utils/xml-light/xml.mli 11 Apr 2010 10:45:25 -0000      1.3
@@ -144,6 +144,9 @@
  any user-readable formating ). *)
 val to_string : xml -> string
 
+(** Append string escaped as xml pcdata to buffer *)
+val buffer_escape : Buffer.t -> string -> unit
+
 (** Escape string as xml pcdata *)
 val escape : string -> string