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 := (try List.hd !next_urls with _ -> "") :: !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 (real_file_name <> "");
 289   assert (!file_piece_size <> zero);
 290   assert (!file_pieces <> "");
 291   assert (!file_info = Bencode.decode (Bencode.encode !file_info));
 292
 293   let file_id = Sha1.string (Bencode.encode !file_info) in
 294   let npieces = 1 + Int64.to_int ((!length -- one) // !file_piece_size) in
 295   let pieces = Array.init npieces (fun i ->
 296         let s = String.sub !file_pieces (i*20) 20 in
 297         Sha1.direct_of_string s
 298     ) in
 299
 300 (* Only at this point we know if the torrent contains an "encoding" field
 301    If UTF8 filenames were found, use them. If not and we have a charset
 302    value used for encoding, convert non-UTF8 filenames to UTF8 ones. *)
 303   if !file_files_utf8 <> [] then
 304     file_files := !file_files_utf8
 305   else
 306     if !file_encoding <> "" then
 307       begin
 308         let file_files_encoded = ref [] in
 309         List.iter (fun (name, length) ->
 310           file_files_encoded := !file_files_encoded @ [(Charset.safe_convert !file_encoding name), length]
 311         ) !file_files;
 312         file_files := !file_files_encoded
 313       end;
 314
 315   (match List.length !file_files with
 316   | 0 -> ()
 317   | 1 -> file_name := (fst (List.hd !file_files));
 318          file_files := []
 319   | _ -> file_files := List.rev !file_files);
 320
 321   file_id, {
 322     torrent_name = real_file_name;
 323     torrent_filename = !file_torrent_filename;
 324     torrent_name_utf8 = real_file_name;
 325     torrent_length = !length;
 326     torrent_announce = !announce;
 327     torrent_announce_list = !announce_list;
 328     torrent_piece_size = !file_piece_size;
 329     torrent_files = !file_files;
 330     torrent_pieces = pieces;
 331     torrent_comment = Charset.safe_convert !file_encoding !file_comment;
 332     torrent_created_by = Charset.safe_convert !file_encoding !file_created_by;
 333     torrent_creation_date = !file_creation_date;
 334     torrent_modified_by = Charset.safe_convert !file_encoding !file_modified_by;
 335     torrent_encoding = !file_encoding;
 336     torrent_private = !file_is_private;
 337
 338 (*
 339     torrent_nodes = !file_nodes;
 340 *)
 341   }
 342
 343 let encode_torrent torrent =
 344
 345   let npieces = Array.length torrent.torrent_pieces in
 346   let pieces = String.create (20 * npieces) in
 347   for i = 0 to npieces - 1 do
 348     String.blit (Sha1.direct_to_string torrent.torrent_pieces.(i)) 0
 349       pieces (i*20) 20
 350   done;
 351
 352   let encode_file (filename, size) =
 353     Dictionary [
 354       String "length", Int size;
 355       String "path", List (List.map
 356           (fun s -> String s)(Filepath.string_to_path '/' filename));
 357     ]
 358   in
 359
 360   let files =
 361     match torrent.torrent_files with
 362       [] ->
 363         String "length", Int torrent.torrent_length
 364     | _ ->
 365         String "files",
 366         List (List.map encode_file torrent.torrent_files)
 367   in
 368
 369   let info =
 370     Dictionary [
 371       files;
 372       String "name", String torrent.torrent_name;
 373       String "name.utf-8", String torrent.torrent_name_utf8;
 374       String "piece length", Int torrent.torrent_piece_size;
 375       String "pieces", String pieces;
 376       String "private", Int torrent.torrent_private;
 377     ]
 378   in
 379
 380   let info_encoded = Bencode.encode info in
 381   let file_id = Sha1.string info_encoded in
 382   file_id,
 383   Dictionary [
 384     String "announce", String torrent.torrent_announce;
 385     String "comment", String torrent.torrent_comment;
 386     String "created by", String torrent.torrent_created_by;
 387     String "creation date", Int torrent.torrent_creation_date;
 388     String "encoding", String torrent.torrent_encoding;
 389     String "info", info;
 390     String "modified-by", String torrent.torrent_modified_by;
 391 (*
 392     String "nodes", String torrent.torrent_nodes;
 393 *)
 394   ]
 395
 396 let make_torrent announce filename comment is_private =
 397   let announce_list = [ announce ] in
 398   let basename = Filename.basename filename in
 399   let files, t =
 400     if Unix2.is_directory filename then
 401       let rec iter_directory list dirname =
 402         let files = Unix2.list_directory (Filename.concat filename dirname) in
 403         iter_files list dirname files
 404
 405       and iter_files list dirname files =
 406         match files with
 407           [] -> list
 408         | file :: tail ->
 409             let basename = Filename.concat dirname file in
 410             let fullname = Filename.concat filename basename in
 411             let left =
 412               if Unix2.is_directory fullname then
 413                 iter_directory list basename
 414               else
 415                 (basename, Unix32.getsize fullname) :: list
 416             in
 417             iter_files left dirname tail
 418       in
 419       let files = iter_directory [] "" in
 420       let t = Unix32.create_multifile filename false files in
 421       files, t
 422     else
 423       [], Unix32.create_ro filename
 424   in
 425
 426   Unix32.flush_fd t;
 427   let length = Unix32.getsize64 t in
 428   let npieces = 1+ Int64.to_int ((length -- one) // chunk_size) in
 429   let pieces = Array.create npieces Sha1.null in
 430   for i = 0 to npieces - 1 do
 431     let begin_pos = chunk_size *.. i in
 432
 433     let end_pos = begin_pos ++ chunk_size in
 434     let end_pos =
 435       if end_pos > length then length else end_pos in
 436
 437     let sha1 = Sha1.digest_subfile t
 438         begin_pos (end_pos -- begin_pos) in
 439     pieces.(i) <- sha1
 440   done;
 441
 442   {
 443     torrent_name = basename;
 444     torrent_filename = "";
 445     torrent_name_utf8 = Charset.to_utf8 basename;
 446     torrent_length = length;
 447     torrent_announce = announce;
 448     torrent_announce_list = announce_list;
 449     torrent_piece_size = chunk_size;
 450     torrent_files = files;
 451     torrent_pieces = pieces;
 452     torrent_comment =
 453       if String.length comment > 1 then
 454         comment
 455       else
 456         Printf.sprintf "Created by MLdonkey/%s" Autoconf.current_version;
 457
 458     torrent_created_by = Printf.sprintf "MLdonkey/%s" Autoconf.current_version;
 459     torrent_creation_date = Int64.of_float (Unix.gettimeofday ());
 460     torrent_modified_by = "";
 461     torrent_encoding = "";
 462     torrent_private = is_private;
 463 (*
 464     torrent_nodes = "";
 465 *)
 466   }
 467
 468 let generate_torrent announce torrent_filename torrent_comment torrent_private filename =
 469   let torrent = make_torrent announce filename torrent_comment torrent_private in
 470   let file_id, encoded = encode_torrent torrent in
 471   let encoded = Bencode.encode encoded in
 472   File.from_string torrent_filename encoded