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