src/networks/donkey/donkeyMftp.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 AnyEndian
  21
  22 open Printf2
  23 open LittleEndian
  24 open Int64ops
  25 open TcpBufferedSocket
  26
  27 open CommonTypes
  28 open CommonGlobals
  29 open CommonOptions
  30
  31 let output_int32_8 oc i =
  32   output_char oc (char_of_int (Int64.to_int (Int64.logand i 255L)))
  33
  34 let output_int32_32 oc i =
  35   output_int32_8 oc i;
  36   output_int32_8 oc (right64 i  8);
  37   output_int32_8 oc (right64 i  16);
  38   output_int32_8 oc (right64 i  24)
  39
  40 let output_int8 oc i =
  41   output_char oc (char_of_int (i land 255))
  42
  43 let output_int oc i =
  44   output_int8 oc i;
  45   output_int8 oc (i lsr 8);
  46   output_int8 oc (i lsr 16);
  47   output_int8 oc (i lsr 24)
  48
  49 (*
  50 let buf_int buf int =
  51   buf_int32_32 buf (Int32.of_int int)
  52   *)
  53
  54 let rec rev_assoc x = function
  55     [] -> raise Not_found
  56   | (b,a)::l -> if a = x then b else rev_assoc x l
  57
  58 let buf_string buf s =
  59   buf_int16 buf (String.length s);
  60   Buffer.add_string buf s
  61
  62 let buf_port buf port =
  63   buf_int16 buf port
  64
  65
  66 let buf_addr buf (ip,port) =
  67   buf_ip buf ip;
  68   buf_port buf port
  69
  70 let buf_tag buf tag names_of_tag =
  71   let name = try rev_assoc tag.tag_name names_of_tag
  72     with _ -> string_of_field tag.tag_name
  73   in
  74 (* try
  75             let i = rev_assoc name names_of_tag in
  76             String.make 1 (char_of_int i)
  77           with _ -> name *)
  78   match tag.tag_value with
  79   | Uint64 n ->
  80       buf_int8 buf 3;
  81       buf_string buf name;
  82       buf_int64_32 buf n
  83   | Fint64 n ->
  84       buf_int8 buf 4;
  85       buf_string buf name;
  86       buf_int64_32 buf n
  87   | Addr ip -> assert false
  88   | String s ->
  89       buf_int8 buf 2;
  90       buf_string buf name;
  91       buf_string buf s
  92   | Uint16 n ->
  93       buf_int8 buf 8;
  94       buf_int16 buf n
  95   | Uint8 n ->
  96       buf_int8 buf 9;
  97       buf_int8 buf n
  98   | Pair _ -> assert false
  99
 100 let rec buf_tags buf tags names_of_tag =
 101   buf_int buf (List.length tags);
 102   let rec iter_tags tags =
 103     match tags with
 104       [] -> ()
 105     | tag :: tags ->
 106         buf_tag buf tag names_of_tag;
 107         iter_tags tags
 108   in
 109   iter_tags tags
 110
 111 let read_uint8 ic =
 112   Int64.of_int (int_of_char (input_char ic))
 113
 114 let read_uint64_32 ic =
 115   let a0 = read_uint8 ic in
 116   let a1 = read_uint8 ic in
 117   let a2 = read_uint8 ic in
 118   let a3 = read_uint8 ic in
 119   a0 ++ (left64 a1  8) ++ (left64 a2 16) ++ (left64 a3 24)
 120
 121 let read_request ic =
 122   let c = int_of_char (input_char ic) in
 123   assert (c = 227);
 124   let len32 = read_uint64_32 ic in
 125   let len = Int64.to_int len32 in
 126   let s = String.create len in
 127   really_input ic s 0 len;
 128   (*
 129   lprintf "read_request %d [%s]" len (String.escaped s);
 130 lprint_newline ();
 131   *)
 132   s
 133
 134 let output_request oc s =
 135   output_char oc (char_of_int 227);
 136   let len = String.length s in
 137   (*
 138   lprintf "output_request %d [%s]" len (String.escaped s);
 139 lprint_newline ();
 140   *)
 141   output_int oc len;
 142   output_string oc s
 143
 144 let get_port s pos =
 145   get_int16 s pos
 146
 147 let get_string = get_string16
 148
 149 let get_tag (names_of_tag : (string * field) list) s pos =
 150   let t2 = get_uint8 s pos in
 151   let name, pos2 =
 152     if t2 land 0x80 = 0x80 then
 153       String.sub s (pos+1) 1, pos+2
 154     else
 155       get_string s (pos+1)
 156   in
 157 (*  lprintf "tag name = %s" (String.escaped name);   *)
 158   let t = t2 land 0x7f in
 159   let v, pos = match t with
 160     | 2 -> let v, pos = get_string s pos2 in
 161         String v, pos
 162     | 1|3 -> let v = get_uint64_32 s pos2 in
 163         Uint64 v, pos2+4
 164     | 4 -> let v = get_uint64_32 s pos2 in
 165         Fint64 v, pos2+4
 166     | 8 -> let v = get_int16 s pos2 in
 167         Uint16 v, pos2 + 2
 168     | 9 -> let v = get_uint8 s pos2 in
 169         Uint8 v, pos2 + 1
 170     | _ when t >= 0x11 & t <= 0x20 -> let v = String.sub s pos2 (t-0x10) in
 171         String v, pos2 + t - 0x10
 172     | _ ->
 173         if !verbose_unknown_messages then
 174           lprintf "get_tags: unknown tag %d at pos %d\n" t pos;
 175         raise Not_found
 176   in
 177   {
 178     tag_name = (try
 179         List.assoc name names_of_tag
 180       with Not_found ->
 181 (*          lprintf "Unknown tag \"%s\"\n" (String.escaped name); *)
 182           match field_of_string name with
 183           | Field_KNOWN s -> Field_UNKNOWN s
 184           | field -> field);
 185     tag_value = v
 186   }, pos
 187
 188 let get_tags s pos names_of_tag =
 189   let rec iter_tags ntags pos tags =
 190     if ntags = 0 then List.rev tags, pos else
 191     let tag, pos = get_tag names_of_tag s pos in
 192     iter_tags (ntags-1) pos (tag :: tags)
 193   in
 194   iter_tags (get_int s pos) (pos+4) []
 195
 196 let get_peer s pos =
 197   let ip = get_ip s pos in
 198   let port = get_port s (pos+4) in
 199   (ip,port), pos+6
 200
 201 module type Request = sig
 202     type t
 203     val parse: int -> string -> t
 204     val print: t -> unit
 205     val write: Buffer.t -> t -> unit
 206   end
 207
 208 let file_common_tags = [
 209     "\001", Field_Filename;
 210     "\002", Field_Size;
 211     "\003", Field_Type;
 212     "\004", Field_Format;
 213     "\005", Field_Lastseencomplete;
 214     "\021", Field_Availability;
 215     "\048", Field_Completesources;
 216     "\058", Field_Size_Hi;
 217     "\208", Field_Artist;
 218     "\209", Field_Album;
 219     "\210", Field_Title;
 220     "\211", Field_Medialength;
 221     "\212", Field_Bitrate;
 222     "\213", Field_Mediacodec;
 223     "\247", Field_Filerating;
 224
 225     "Artist", Field_Artist;
 226     "Album", Field_Album;
 227     "Title", Field_Title;
 228   ]
 229
 230 let client_common_tags =
 231       [
 232         "\001", "name";
 233         "\015", "port";
 234         "\017", "version";
 235         "\031", "udpport";
 236         "\032", "compression";
 237         "\033", "udpport";
 238         "\034", "udpver";
 239         "\035", "sourceexchange";
 240         "\036", "comments";
 241         "\037", "extendedrequest";
 242         "\038", "compatibleclient";
 243         "\039", "features";
 244         "\059", "extrainfo";
 245         "\060", "downloadtime";
 246         "\061", "incompleteparts";
 247         "\062", "l2hac";
 248         "\063", "realparts";
 249         "\065", "mod_unknown41";
 250         "\066", "mod_unknown42";
 251         "\067", "mod_unknown43";
 252         "\078", "neo_features";
 253         "\084", "mod_featureset";
 254         "\085", "mod_version";
 255         "\086", "mod_protocol";
 256         "\090", "mod_bowlfish";
 257         "\092", "mod_secure_community";
 258         "\093", "mod_unknown0x5d";
 259         "\096", "mod_unknown0x60";
 260         "\100", "mod_unknown0x64";
 261         "\102", "mod_fusion";
 262         "\103", "mod_fusion_version";
 263
 264 (* http://forums.shareaza.com/showthread.php?threadid=37323&perpage=15&pagenumber=2 *)
 265         "\105", "edonkeyclc serverip?";
 266         "\106", "edonkeyclc serverport?";
 267
 268         "\108", "mod_unknown0x6c";
 269         "\117", "mod_unknown0x75"; (* http://emule-project.net @ NewMule *)
 270         "\118", "mod_unknown0x76";
 271         "\119", "mod_tarod";
 272         "\120", "mod_tarod_version";
 273         "\121", "mod_morph";
 274         "\128", "mod_morph_version";
 275         "\130", "mod_mortillo";
 276         "\131", "mod_mortillo_version";
 277         "\132", "chanblard_version";
 278         "\133", "signature";
 279         "\134", "cache";
 280         "\135", "mod_lsd";
 281         "\136", "mod_lsd_version";
 282         "\144", "mod_lovelace_version";
 283         "\148", "os_info"; (* reused by aMule to transfer client OS type *)
 284         "\153", "mod_plus";
 285         "\160", "mod_wombat";
 286         "\161", "dev_wombat";
 287         "\170", "koizo"; (* http://sourceforge.net/projects/koizo *)
 288         "\205", "mod_unknown0xcd";
 289         "\224", "isp_bypass";
 290         "\225", "nat_tunneling";
 291         "\239", "emule_compatoptions";
 292         "\240", "nat_security";
 293         "\249", "emule_udpports";
 294         "\250", "emule_miscoptions1";
 295         "\251", "emule_version";
 296         "\252", "buddy_ip";
 297         "\253", "buddy_udp";
 298         "\254", "emule_miscoptions2";
 299         "pr",   "edonkeyclc horde";
 300         "wombia", "wombat a";
 301         "wombib", "wombat b";
 302       ]