src/networks/bittorrent/bTTorrent.ml

   1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 open Int64ops
  21 open Md4
  22 open Options
  23 open CommonOptions
  24 open Printf2
  25
  26 open BasicSocket
  27
  28 open CommonGlobals
  29
  30 open BTOptions
  31 open BTTypes
  32 open Bencode
  33
  34 open Gettext
  35 let _s x = _s "BTTorrent" x
  36 let _b x = _b "BTTorrent" x
  37
  38 (*
  39
  40 We could have a a-la-edonkey tracker: it would connect back to incoming
  41   client, and check whether they are accessible from the outside world,
  42 and also check which chunks they have before sending them sources, so
  43 that we can filter out immediatly sources that are not interesting for
  44 them.
  45 *)
  46
  47 (*
  48
  49 torrents/: for BitTorrent
  50   downloads/: .torrent files of current downloads
  51   tracked/: .torrent files of tracked downloads
  52     * If the file appears in incoming/, it is automatically seeded.
  53   seeded/:
  54      * If the file appears in incoming/, it is automatically seeded.
  55
  56   *)
  57
  58
  59 let chunk_size = Int64.of_int (256 * 1024)
  60
  61 let decode_torrent s =
  62   if !verbose_msg_servers then lprintf_nl "[BT] .torrent file loaded";
  63 (*            lprintf "Loaded: %s\n" (String.escaped s); *)
  64   let v = Bencode.decode s in
  65 (*            lprintf "Decoded file: %s\n" (Bencode.print v);  *)
  66
  67
  68   let announce = ref "" in
  69   let announce_list = ref [] in
  70   let file_info = ref (List []) in
  71   let file_name = ref "" in
  72   let file_torrent_filename = ref "" in
  73   let file_name_utf8 = ref None in
  74   let file_piece_size = ref zero in
  75   let file_pieces = ref "" in
  76   let file_comment = ref "" in
  77   let file_created_by = ref "" in
  78   let file_creation_date = ref zero in
  79   let file_modified_by = ref "" in
  80   let file_encoding = ref "" in
  81   let file_codepage = ref zero in
  82   let file_ed2k_hash = ref "" in
  83   let file_is_private = ref zero in
  84   let file_aps = ref (List []) in
  85   let file_dht_backup_enable = ref zero in
  86   let length = ref zero in
  87   let file_files = ref [] in
  88   let file_files_utf8 = ref [] in
  89
  90   let parse_files files =
  91     let current_pos = ref zero in
  92     List.iter (fun v ->
  93         match v with
  94           Dictionary list ->
  95             let current_file = ref "" in
  96             let current_file_utf8 = ref "" in
  97             let current_length = ref zero in
  98             let length_set = ref false in
  99
 100             let path_list_to_string l =
 101                     Filepath.path_to_string '/'
 102                 (
 103                   List.map (fun v ->
 104                           match v with
 105                             String s -> s
 106                           | _ -> assert false
 107                   ) l
 108                 )
 109             in
 110
 111             List.iter (fun (key, value) ->
 112                 match key, value with
 113                 | "path", List path ->
 114                     current_file := path_list_to_string path;
 115                     if !verbose_msg_servers then
 116                       lprintf_nl "[BT] Parsed a new path: [%s]" !current_file
 117                 | "path.utf-8", List path_utf8 ->
 118                     current_file_utf8 := path_list_to_string path_utf8;
 119                     if !verbose_msg_servers then
 120                       lprintf_nl "[BT] Parsed path.utf-8: [%s]" !current_file
 121                 | "length", Int n ->
 122                     length := !length ++ n;
 123                     current_length := n;
 124                     length_set := true
 125
 126                 | key, _ ->
 127                     if !verbose_msg_servers then lprintf_nl "[BT] other field [%s] with value [%s] in files" key (Bencode.print value)
 128             ) list;
 129
 130             assert (!length_set);
 131             assert (!current_file <> "" || !current_file_utf8 <> "");
 132             file_files := (!current_file, !current_length) :: !file_files;
 133             if !current_file_utf8 <> "" then
 134               file_files_utf8 := (!current_file_utf8, !current_length) :: !file_files_utf8;
 135             current_pos := !current_pos ++ !current_length
 136
 137         | _ -> assert false
 138     ) files;
 139   in
 140
 141   begin
 142     match v with
 143       Dictionary list ->
 144         List.iter (fun (key, value) ->
 145             match key, value with
 146             | "announce", String tracker_url ->
 147                if !verbose_msg_servers then
 148                  lprintf_nl "[BT] New tracker added :%s" tracker_url;
 149                 announce := tracker_url
 150             | "announce-list", List list ->
 151                 List.iter (fun url_list ->
 152                     let next_urls = ref [] in
 153                     match url_list with
 154                     | List next_url_list ->
 155                         List.iter (fun myvalue ->
 156                             match myvalue with
 157                             | String next_url ->
 158                                 next_urls := next_url :: !next_urls;
 159                                 if !verbose_msg_servers then
 160                                   lprintf_nl "[BT] New tracker received :%s" next_url
 161                             | _ ->
 162                                 if !verbose_msg_servers then
 163                                   lprintf_nl "[BT] error while decoding announce list"
 164                         ) next_url_list;
 165                         if List.length !next_urls > 1 then begin
 166                             next_urls := List2.shuffle !next_urls;
 167                             announce_list := !next_urls @ !announce_list
 168                           end
 169                         else
 170                           announce_list := (try List.hd !next_urls with _ -> "") :: !announce_list
 171                     | _ ->
 172                         lprintf_nl "[BT] unknown field in announce list"
 173                     ) list;
 174                     announce_list := List.rev !announce_list;
 175                     if !verbose_msg_servers then
 176                       List.iter (fun url ->
 177                         lprintf_nl "[BT] New tracker added :%s" url
 178                         ) !announce_list
 179             | "info", ((Dictionary list) as info) ->
 180
 181                 file_info := info;
 182                 List.iter (fun (key, value) ->
 183                     match key, value with
 184                     | "files", List files ->
 185                         parse_files files
 186                     | "length", Int n ->
 187                         length := n
 188                     | "name", String name ->
 189                         file_name := name
 190                     | "piece length", Int n ->
 191                         file_piece_size := n
 192                     | "pieces", String pieces ->
 193                         file_pieces := pieces
 194                     | "ed2k", String string_ed2k ->
 195                         if !!enable_donkey then
 196                           file_ed2k_hash := string_ed2k;
 197                       (* TODO: Add new ed2k download if ed2k hash is available,
 198                                then merge it with current download *)
 199                     | "sha1", String string_sha1 -> ()
 200                       (* TODO: Parse sha1 hash *)
 201
 202                     | "publisher", String created_by ->
 203                       file_created_by := created_by
 204                     | "publisher-url", String publisher_url ->
 205                       file_created_by := !file_created_by ^ " @ " ^ publisher_url
 206
 207                     | "name.utf-8", String name_utf8 ->
 208                         file_name_utf8 := Some name_utf8
 209
 210                     | "publisher.utf-8", String publisher_utf8 -> ()
 211                     | "publisher-url.utf-8", String publisher_url_utf8 -> ()
 212
 213                     | "private", Int n ->
 214                         (* TODO: if set to 1, only accept peers from tracker *)
 215                         file_is_private := n;
 216                         if !verbose_msg_servers &&
 217                           Int64.to_int !file_is_private = 1 then
 218                             lprintf_nl "[BT] torrent is private"
 219                     | key, _ ->
 220                         if !verbose_msg_servers then
 221                           lprintf_nl "[BT] found other field [%s] with value [%s] in info" key (Bencode.print value)
 222                 ) list
 223
 224             | "comment", String comment
 225             | "comment.utf-8", String comment ->
 226               file_comment := comment
 227             (* Next 2 strings are after info sometimes  *)
 228             | "publisher", String created_by ->
 229               file_created_by := created_by
 230             | "publisher-url", String publisher_url ->
 231               file_created_by := !file_created_by ^ " @ " ^ publisher_url
 232
 233             | "created by", String created_by ->
 234               file_created_by := created_by
 235             | "creation date", Int creation_date ->
 236               file_creation_date := creation_date
 237             | "modified-by", String modified_by ->
 238               file_modified_by := modified_by
 239             | "encoding", String encoding ->
 240               file_encoding := encoding
 241             | "codepage", Int codepage ->
 242               file_codepage := codepage
 243             | "torrent filename", String torrent_filename ->
 244               file_torrent_filename := torrent_filename
 245             | "nodes", nodes -> ()
 246               (* TODO : nodes is a list of DHT Network nodes ,parse and use them *)
 247
 248 (*
 249               file_nodes := nodes
 250 *)
 251
 252             | "azureus_properties", ((Dictionary list) as azureus_properties) ->
 253                 file_aps := azureus_properties;
 254                 List.iter (fun (key, value) ->
 255                     match key, value with
 256                     | "dht_backup_enable", Int n ->
 257                         file_dht_backup_enable := n;
 258                         if !verbose_msg_servers &&
 259                           Int64.to_int !file_dht_backup_enable = 1 then
 260                             lprintf_nl "[BT] azureus properties : Torrent has dht backup"
 261                     | key, _ ->
 262                         if !verbose_msg_servers then
 263                           lprintf_nl "[BT] found other field [%s] with value [%s] in azureus properties" key (Bencode.print value)
 264                 ) list
 265             | key, _ ->
 266                 if !verbose_msg_servers then lprintf_nl "[BT] found other field [%s] with value [%s] after info" key (Bencode.print value)
 267         ) list
 268     | _ -> assert false
 269   end;
 270
 271 (* Convert codepage number to Charset name, for example: 936 -> CP936 *)
 272   if !file_codepage <> 0L && !file_encoding = "" then
 273     file_encoding := "CP" ^ (Int64.to_string !file_codepage);
 274
 275   let real_file_name =
 276     match !file_name_utf8 with
 277     | None -> Charset.safe_convert !file_encoding !file_name
 278     | Some name -> name
 279   in
 280   assert (real_file_name <> "");
 281   assert (!file_piece_size <> zero);
 282   assert (!file_pieces <> "");
 283   assert (!file_info = Bencode.decode (Bencode.encode !file_info));
 284
 285   let file_id = Sha1.string (Bencode.encode !file_info) in
 286   let npieces = 1 + Int64.to_int ((!length -- one) // !file_piece_size) in
 287   let pieces = Array.init npieces (fun i ->
 288         let s = String.sub !file_pieces (i*20) 20 in
 289         Sha1.direct_of_string s
 290     ) in
 291
 292 (* Only at this point we know if the torrent contains an "encoding" field
 293    If UTF8 filenames were found, use them. If not and we have a charset
 294    value used for encoding, convert non-UTF8 filenames to UTF8 ones. *)
 295   if !file_files_utf8 <> [] then
 296     file_files := !file_files_utf8
 297   else
 298     if !file_encoding <> "" then
 299       begin
 300         let file_files_encoded = ref [] in
 301         List.iter (fun (name, length) ->
 302           file_files_encoded := !file_files_encoded @ [(Charset.safe_convert !file_encoding name), length]
 303         ) !file_files;
 304         file_files := !file_files_encoded
 305       end;
 306
 307   (match List.length !file_files with
 308   | 0 -> ()
 309   | 1 -> file_name := (fst (List.hd !file_files));
 310          file_files := []
 311   | _ -> file_files := List.rev !file_files);
 312
 313   file_id, {
 314     torrent_name = real_file_name;
 315     torrent_filename = !file_torrent_filename;
 316     torrent_name_utf8 = real_file_name;
 317     torrent_length = !length;
 318     torrent_announce = !announce;
 319     torrent_announce_list = !announce_list;
 320     torrent_piece_size = !file_piece_size;
 321     torrent_files = !file_files;
 322     torrent_pieces = pieces;
 323     torrent_comment = Charset.safe_convert !file_encoding !file_comment;
 324     torrent_created_by = Charset.safe_convert !file_encoding !file_created_by;
 325     torrent_creation_date = !file_creation_date;
 326     torrent_modified_by = Charset.safe_convert !file_encoding !file_modified_by;
 327     torrent_encoding = !file_encoding;
 328     torrent_private = !file_is_private;
 329
 330 (*
 331     torrent_nodes = !file_nodes;
 332 *)
 333   }
 334
 335 let encode_torrent torrent =
 336
 337   let npieces = Array.length torrent.torrent_pieces in
 338   let pieces = String.create (20 * npieces) in
 339   for i = 0 to npieces - 1 do
 340     String.blit (Sha1.direct_to_string torrent.torrent_pieces.(i)) 0
 341       pieces (i*20) 20
 342   done;
 343
 344   let encode_file (filename, size) =
 345     Dictionary [
 346       "length", Int size;
 347       "path", List (List.map
 348           (fun s -> String s)(Filepath.string_to_path '/' filename));
 349     ]
 350   in
 351
 352   let files =
 353     match torrent.torrent_files with
 354       [] ->
 355         "length", Int torrent.torrent_length
 356     | _ ->
 357         "files",
 358         List (List.map encode_file torrent.torrent_files)
 359   in
 360
 361   let info =
 362     Dictionary [
 363       files;
 364       "name", String torrent.torrent_name;
 365       "name.utf-8", String torrent.torrent_name_utf8;
 366       "piece length", Int torrent.torrent_piece_size;
 367       "pieces", String pieces;
 368       "private", Int torrent.torrent_private;
 369     ]
 370   in
 371
 372   let info_encoded = Bencode.encode info in
 373   let file_id = Sha1.string info_encoded in
 374   file_id,
 375   Dictionary [
 376     "announce", String torrent.torrent_announce;
 377     "comment", String torrent.torrent_comment;
 378     "created by", String torrent.torrent_created_by;
 379     "creation date", Int torrent.torrent_creation_date;
 380     "encoding", String torrent.torrent_encoding;
 381     "info", info;
 382     "modified-by", String torrent.torrent_modified_by;
 383 (*
 384     String "nodes", String torrent.torrent_nodes;
 385 *)
 386   ]
 387
 388 let make_torrent announce filename comment is_private =
 389   let announce_list = [ announce ] in
 390   let basename = Filename.basename filename in
 391   let files, t =
 392     if Unix2.is_directory filename then
 393       let rec iter_directory list dirname =
 394         let files = Unix2.list_directory (Filename.concat filename dirname) in
 395         iter_files list dirname files
 396
 397       and iter_files list dirname files =
 398         match files with
 399           [] -> list
 400         | file :: tail ->
 401             let basename = Filename.concat dirname file in
 402             let fullname = Filename.concat filename basename in
 403             let left =
 404               if Unix2.is_directory fullname then
 405                 iter_directory list basename
 406               else
 407                 (basename, Unix32.getsize fullname) :: list
 408             in
 409             iter_files left dirname tail
 410       in
 411       let files = iter_directory [] "" in
 412       let t = Unix32.create_multifile filename false files in
 413       files, t
 414     else
 415       [], Unix32.create_ro filename
 416   in
 417
 418   Unix32.flush_fd t;
 419   let length = Unix32.getsize64 t in
 420   let npieces = 1+ Int64.to_int ((length -- one) // chunk_size) in
 421   let pieces = Array.create npieces Sha1.null in
 422   for i = 0 to npieces - 1 do
 423     let begin_pos = chunk_size *.. i in
 424
 425     let end_pos = begin_pos ++ chunk_size in
 426     let end_pos =
 427       if end_pos > length then length else end_pos in
 428
 429     let sha1 = Sha1.digest_subfile t
 430         begin_pos (end_pos -- begin_pos) in
 431     pieces.(i) <- sha1
 432   done;
 433
 434   {
 435     torrent_name = basename;
 436     torrent_filename = "";
 437     torrent_name_utf8 = Charset.Locale.to_utf8 basename;
 438     torrent_length = length;
 439     torrent_announce = announce;
 440     torrent_announce_list = announce_list;
 441     torrent_piece_size = chunk_size;
 442     torrent_files = files;
 443     torrent_pieces = pieces;
 444     torrent_comment =
 445       if String.length comment > 1 then
 446         comment
 447       else
 448         Printf.sprintf "Created by MLdonkey/%s" Autoconf.current_version;
 449
 450     torrent_created_by = Printf.sprintf "MLdonkey/%s" Autoconf.current_version;
 451     torrent_creation_date = Int64.of_float (Unix.gettimeofday ());
 452     torrent_modified_by = "";
 453     torrent_encoding = "";
 454     torrent_private = is_private;
 455 (*
 456     torrent_nodes = "";
 457 *)
 458   }
 459
 460 let generate_torrent announce torrent_filename torrent_comment torrent_private filename =
 461   let torrent = make_torrent announce filename torrent_comment torrent_private in
 462   let file_id, encoded = encode_torrent torrent in
 463   let encoded = Bencode.encode encoded in
 464   File.from_string torrent_filename encoded;
 465   file_id
 466