src/networks/bittorrent/bTUdpTracker.mlp

   1
   2 (*
   3 open BasicSocket
   4 open CommonTypes
   5 open Printf2
   6 open CommonOptions
   7 open Options
   8 open Md4
   9 open CommonGlobals
  10 open BigEndian
  11 open TcpBufferedSocket
  12 open AnyEndian
  13 open BTTypes
  14 *)
  15
  16 (** UDP trackers
  17   http://www.bittorrent.org/beps/bep_0015.html *)
  18
  19 open Bitstring
  20
  21 let of_bits = string_of_bitstring
  22 let bits = bitstring_of_string
  23
  24 (*
  25 Choose a random transaction ID.
  26 Fill the connect request structure.
  27 Send the packet.
  28 *)
  29 let connect_request txn =
  30   of_bits ( BITSTRING { 0x41727101980L : 64 ; 0l : 32 ; txn : 32 } )
  31
  32 exception Error of string
  33
  34 let fail fmt = Printf.ksprintf (fun s -> raise (Error s)) fmt
  35
  36 (*
  37 Receive the packet.
  38 Check whether the packet is at least 16 bytes.
  39 Check whether the transaction ID is equal to the one you chose.
  40 Check whether the action is connect.
  41 Store the connection ID for future use.
  42 *)
  43 let connect_response s exp_txn =
  44   bitmatch bits s with
  45   | { 0l : 32 ; txn : 32 ; conn_id : 64 } ->
  46     if txn = exp_txn then conn_id else fail "error connect_response txn %ld expected %ld" txn exp_txn
  47   | { 3l : 32 ; txn : 32 ; msg : -1 : string } -> fail "error connect_response txn %ld : %s" txn msg
  48   | { _ } -> fail "error connect_response"
  49
  50 (*
  51 Choose a random transaction ID.
  52 Fill the announce request structure.
  53 Send the packet.
  54 *)
  55 let announce_request conn txn ~info_hash ~peer_id (downloaded,left,uploaded) event ?(key=0l) ~numwant port =
  56   of_bits (BITSTRING {
  57     conn : 64 ;
  58     1l : 32 ;
  59     txn : 32 ;
  60     info_hash : 20 * 8 : string;
  61     peer_id : 20 * 8 : string;
  62     downloaded : 64 ;
  63     left : 64 ;
  64     uploaded : 64 ;
  65     event : 32 ;
  66     0l : 32 ; (* ip *)
  67     key : 32 ; (* key *)
  68     numwant : 32 ; (* key *)
  69     port : 16 })
  70
  71 (*
  72 Receive the packet.
  73 Check whether the packet is at least 20 bytes.
  74 Check whether the transaction ID is equal to the one you chose.
  75 Check whether the action is announce.
  76 Do not announce again until interval seconds have passed or an event has occurred.
  77 *)
  78 let announce_response s exp_txn =
  79   let rec clients rest l =
  80     bitmatch rest with
  81     | { ip : 32 ; port : 16 ; rest : -1 : bitstring } -> clients rest ((ip,port)::l)
  82     | { _ } -> l
  83   in
  84   bitmatch bits s with
  85   | { 1l : 32 ; txn : 32 ; interval : 32 ; leechers : 32 ; seeders : 32 ;
  86       rest : -1 : bitstring } ->
  87         if txn = exp_txn then
  88           (interval,clients rest [])
  89         else
  90           fail "error announce_response txn %ld expected %ld" txn exp_txn
  91   | { 3l : 32 ; txn : 32 ; msg : -1 : string } -> fail "error announce_response txn %ld : %s" txn msg
  92   | { _ } -> fail "error announce_response"
  93
  94 (*
  95 If the tracker encounters an error, it might send an error packet.
  96 Receive the packet.
  97 Check whether the packet is at least 8 bytes.
  98 Check whether the transaction ID is equal to the one you chose.
  99 *)
 100 let error_response s =
 101   bitmatch bits s with
 102   | { 3l : 32 ; txn : 32 ; msg : -1 : string } -> Some (txn, msg)
 103   | { _ } -> None
 104