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                   String "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                 | String "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                 | String "length", Int n ->
 122                     length := !length ++ n;
 123                     current_length := n;
 124                     length_set := true
 125
 126                 | String key, _ ->
 127                     if !verbose_msg_servers then lprintf_nl "[BT] other field [%s] with value [%s] in files" key (Bencode.print value)
 128                 | _ ->
 129                     lprintf_nl "[BT] other field in files"
 130             ) list;
 131
 132             assert (!length_set);
 133             assert (!current_file <> "" || !current_file_utf8 <> "");
 134             file_files := (!current_file, !current_length) :: !file_files;
 135             if !current_file_utf8 <> "" then
 136               file_files_utf8 := (!current_file_utf8, !current_length) :: !file_files_utf8;
 137             current_pos := !current_pos ++ !current_length
 138
 139         | _ -> assert false
 140     ) files;
 141   in
 142
 143   begin
 144     match v with
 145       Dictionary list ->
 146         List.iter (fun (key, value) ->
 147             match key, value with
 148               String "announce", String tracker_url ->
 149                if !verbose_msg_servers then
 150                  lprintf_nl "[BT] New tracker added :%s" tracker_url;
 151                 announce := tracker_url
 152             | String "announce-list", List list ->
 153                 List.iter (fun url_list ->
 154                     let next_urls = ref [] in
 155                     match url_list with
 156                     | List next_url_list ->
 157                         List.iter (fun myvalue ->
 158                             match myvalue with
 159                             | String next_url ->
 160                                 next_urls := next_url :: !next_urls;
 161                                 if !verbose_msg_servers then
 162                                   lprintf_nl "[BT] New tracker received :%s" next_url
 163                             | _ ->
 164                                 if !verbose_msg_servers then
 165                                   lprintf_nl "[BT] error while decoding announce list"
 166                         ) next_url_list;
 167                         if List.length !next_urls > 1 then begin
 168                             next_urls := List2.shuffle !next_urls;
 169                             announce_list := !next_urls @ !announce_list
 170                           end
 171                         else
 172                           announce_list := List.hd !next_urls :: !announce_list
 173                     | _ ->
 174                         lprintf_nl "[BT] unknown field in announce list"
 175                     ) list;
 176                     announce_list := List.rev !announce_list;
 177                     if !verbose_msg_servers then
 178                       List.iter (fun url ->
 179                         lprintf_nl "[BT] New tracker added :%s" url
 180                         ) !announce_list
 181             | String "info", ((Dictionary list) as info) ->
 182
 183                 file_info := info;
 184                 List.iter (fun (key, value) ->
 185                     match key, value with
 186                     | String "files", List files ->
 187                         parse_files files
 188                     | String "length", Int n ->
 189                         length := n
 190                     | String "name", String name ->
 191                         file_name := name
 192                     | String "piece length", Int n ->
 193                         file_piece_size := n
 194                     | String "pieces", String pieces ->
 195                         file_pieces := pieces
 196                     | String "ed2k", String string_ed2k ->
 197                         if !!enable_donkey then
 198                           file_ed2k_hash := string_ed2k;
 199                       (* TODO: Add new ed2k download if ed2k hash is available,
 200                                then merge it with current download *)
 201                     | String "sha1", String string_sha1 -> ()
 202                       (* TODO: Parse sha1 hash *)
 203
 204                     | String "publisher", String created_by ->
 205                       file_created_by := created_by
 206                     | String "publisher-url", String publisher_url ->
 207                       file_created_by := !file_created_by ^ " @ " ^ publisher_url
 208
 209                     | String "name.utf-8", String name_utf8 ->
 210                         file_name_utf8 := Some name_utf8
 211
 212                     | String "publisher.utf-8", String publisher_utf8 -> ()
 213                     | String "publisher-url.utf-8", String publisher_url_utf8 -> ()
 214
 215                     | String "private", Int n ->
 216                         (* TODO: if set to 1, only accept peers from tracker *)
 217                         file_is_private := n;
 218                         if !verbose_msg_servers &&
 219                           Int64.to_int !file_is_private = 1 then
 220                             lprintf_nl "[BT] torrent is private"
 221                     | String key, _ ->
 222                         if !verbose_msg_servers then
 223                           lprintf_nl "[BT] found other field [%s] with value [%s] in info" key (Bencode.print value)
 224                     | _ ->
 225                         lprintf_nl "[BT] other field in info"
 226                 ) list
 227
 228             | String "comment", String comment
 229             | String "comment.utf-8", String comment ->
 230               file_comment := comment
 231             (* Next 2 strings are after info sometimes  *)
 232             | String "publisher", String created_by ->
 233               file_created_by := created_by
 234             | String "publisher-url", String publisher_url ->
 235               file_created_by := !file_created_by ^ " @ " ^ publisher_url
 236
 237             | String "created by", String created_by ->
 238               file_created_by := created_by
 239             | String "creation date", Int creation_date ->
 240               file_creation_date := creation_date
 241             | String "modified-by", String modified_by ->
 242               file_modified_by := modified_by
 243             | String "encoding", String encoding ->
 244               file_encoding := encoding
 245             | String "codepage", Int codepage ->
 246               file_codepage := codepage
 247             | String "torrent filename", String torrent_filename ->
 248               file_torrent_filename := torrent_filename
 249             | String "nodes", nodes -> ()
 250               (* TODO : nodes is a list of DHT Network nodes ,parse and use them *)
 251
 252 (*
 253               file_nodes := nodes
 254 *)
 255
 256             | String "azureus_properties", ((Dictionary list) as azureus_properties) ->
 257                 file_aps := azureus_properties;
 258                 List.iter (fun (key, value) ->
 259                     match key, value with
 260                     | String "dht_backup_enable", Int n ->
 261                         file_dht_backup_enable := n;
 262                         if !verbose_msg_servers &&
 263                           Int64.to_int !file_dht_backup_enable = 1 then
 264                             lprintf_nl "[BT] azureus properties : Torrent has dht backup"
 265                     | String key, _ ->
 266                         if !verbose_msg_servers then
 267                           lprintf_nl "[BT] found other field [%s] with value [%s] in azureus properties" key (Bencode.print value)
 268                     | _ ->
 269                         lprintf_nl "[BT] other field in azureus properties"
 270                 ) list
 271             | String key, _ ->
 272                 if !verbose_msg_servers then lprintf_nl "[BT] found other field [%s] with value [%s] after info" key (Bencode.print value)
 273             | _ ->
 274                 lprintf_nl "[BT] other field after info"
 275         ) list
 276     | _ -> assert false
 277   end;
 278
 279 (* Convert codepage number to Charset name, for example: 936 -> CP936 *)
 280   if !file_codepage <> 0L && !file_encoding = "" then
 281     file_encoding := "CP" ^ (Int64.to_string !file_codepage);
 282
 283   let real_file_name =
 284     match !file_name_utf8 with
 285     | None -> Charset.safe_convert !file_encoding !file_name
 286     | Some name -> name
 287   in
 288   assert (!announce <> "");
 289   assert (real_file_name <> "");
 290   assert (!file_piece_size <> zero);
 291   assert (!file_pieces <> "");
 292   assert (!file_info = Bencode.decode (Bencode.encode !file_info));
 293
 294   let file_id = Sha1.string (Bencode.encode !file_info) in
 295   let npieces = 1 + Int64.to_int ((!length -- one) // !file_piece_size) in
 296   let pieces = Array.init npieces (fun i ->
 297         let s = String.sub !file_pieces (i*20) 20 in
 298         Sha1.direct_of_string s
 299     ) in
 300
 301 (* Only at this point we know if the torrent contains an "encoding" field
 302    If UTF8 filenames were found, use them. If not and we have a charset
 303    value used for encoding, convert non-UTF8 filenames to UTF8 ones. *)
 304   if !file_files_utf8 <> [] then
 305     file_files := !file_files_utf8
 306   else
 307     if !file_encoding <> "" then
 308       begin
 309         let file_files_encoded = ref [] in
 310         List.iter (fun (name, length) ->
 311           file_files_encoded := !file_files_encoded @ [(Charset.safe_convert !file_encoding name), length]
 312         ) !file_files;
 313         file_files := !file_files_encoded
 314       end;
 315
 316   (match List.length !file_files with
 317   | 0 -> ()
 318   | 1 -> file_name := (fst (List.hd !file_files));
 319          file_files := []
 320   | _ -> file_files := List.rev !file_files);
 321
 322   file_id, {
 323     torrent_name = real_file_name;
 324     torrent_filename = !file_torrent_filename;
 325     torrent_name_utf8 = real_file_name;
 326     torrent_length = !length;
 327     torrent_announce = !announce;
 328     torrent_announce_list = !announce_list;
 329     torrent_piece_size = !file_piece_size;
 330     torrent_files = !file_files;
 331     torrent_pieces = pieces;
 332     torrent_comment = Charset.safe_convert !file_encoding !file_comment;
 333     torrent_created_by = Charset.safe_convert !file_encoding !file_created_by;
 334     torrent_creation_date = !file_creation_date;
 335     torrent_modified_by = Charset.safe_convert !file_encoding !file_modified_by;
 336     torrent_encoding = !file_encoding;
 337     torrent_private = !file_is_private;
 338
 339 (*
 340     torrent_nodes = !file_nodes;
 341 *)
 342   }
 343
 344 let encode_torrent torrent =
 345
 346   let npieces = Array.length torrent.torrent_pieces in
 347   let pieces = String.create (20 * npieces) in
 348   for i = 0 to npieces - 1 do
 349     String.blit (Sha1.direct_to_string torrent.torrent_pieces.(i)) 0
 350       pieces (i*20) 20
 351   done;
 352
 353   let encode_file (filename, size) =
 354     Dictionary [
 355       String "length", Int size;
 356       String "path", List (List.map
 357           (fun s -> String s)(Filepath.string_to_path '/' filename));
 358     ]
 359   in
 360
 361   let files =
 362     match torrent.torrent_files with
 363       [] ->
 364         String "length", Int torrent.torrent_length
 365     | _ ->
 366         String "files",
 367         List (List.map encode_file torrent.torrent_files)
 368   in
 369
 370   let info =
 371     Dictionary [
 372       files;
 373       String "name", String torrent.torrent_name;
 374       String "name.utf-8", String torrent.torrent_name_utf8;
 375       String "piece length", Int torrent.torrent_piece_size;
 376       String "pieces", String pieces;
 377       String "private", Int torrent.torrent_private;
 378     ]
 379   in
 380
 381   let info_encoded = Bencode.encode info in
 382   let file_id = Sha1.string info_encoded in
 383   file_id,
 384   Dictionary [
 385     String "announce", String torrent.torrent_announce;
 386     String "comment", String torrent.torrent_comment;
 387     String "created by", String torrent.torrent_created_by;
 388     String "creation date", Int torrent.torrent_creation_date;
 389     String "encoding", String torrent.torrent_encoding;
 390     String "info", info;
 391     String "modified-by", String torrent.torrent_modified_by;
 392 (*
 393     String "nodes", String torrent.torrent_nodes;
 394 *)
 395   ]
 396
 397 let make_torrent announce filename comment is_private =
 398   let announce_list = [ announce ] in
 399   let basename = Filename.basename filename in
 400   let files, t =
 401     if Unix2.is_directory filename then
 402       let rec iter_directory list dirname =
 403         let files = Unix2.list_directory (Filename.concat filename dirname) in
 404         iter_files list dirname files
 405
 406       and iter_files list dirname files =
 407         match files with
 408           [] -> list
 409         | file :: tail ->
 410             let basename = Filename.concat dirname file in
 411             let fullname = Filename.concat filename basename in
 412             let left =
 413               if Unix2.is_directory fullname then
 414                 iter_directory list basename
 415               else
 416                 (basename, Unix32.getsize fullname) :: list
 417             in
 418             iter_files left dirname tail
 419       in
 420       let files = iter_directory [] "" in
 421       let t = Unix32.create_multifile filename false files in
 422       files, t
 423     else
 424       [], Unix32.create_ro filename
 425   in
 426
 427   Unix32.flush_fd t;
 428   let length = Unix32.getsize64 t in
 429   let npieces = 1+ Int64.to_int ((length -- one) // chunk_size) in
 430   let pieces = Array.create npieces Sha1.null in
 431   for i = 0 to npieces - 1 do
 432     let begin_pos = chunk_size *.. i in
 433
 434     let end_pos = begin_pos ++ chunk_size in
 435     let end_pos =
 436       if end_pos > length then length else end_pos in
 437
 438     let sha1 = Sha1.digest_subfile t
 439         begin_pos (end_pos -- begin_pos) in
 440     pieces.(i) <- sha1
 441   done;
 442
 443   {
 444     torrent_name = basename;
 445     torrent_filename = "";
 446     torrent_name_utf8 = Charset.to_utf8 basename;
 447     torrent_length = length;
 448     torrent_announce = announce;
 449     torrent_announce_list = announce_list;
 450     torrent_piece_size = chunk_size;
 451     torrent_files = files;
 452     torrent_pieces = pieces;
 453     torrent_comment =
 454       if String.length comment > 1 then
 455         comment
 456       else
 457         Printf.sprintf "Created by MLdonkey/%s" Autoconf.current_version;
 458
 459     torrent_created_by = Printf.sprintf "MLdonkey/%s" Autoconf.current_version;
 460     torrent_creation_date = Int64.of_float (Unix.gettimeofday ());
 461     torrent_modified_by = "";
 462     torrent_encoding = "";
 463     torrent_private = is_private;
 464 (*
 465     torrent_nodes = "";
 466 *)
 467   }
 468
 469 let generate_torrent announce torrent_filename torrent_comment torrent_private filename =
 470   let torrent = make_torrent announce filename torrent_comment torrent_private in
 471   let file_id, encoded = encode_torrent torrent in
 472   let encoded = Bencode.encode encoded in
 473   File.from_string torrent_filename encoded