Commits

Roma Sokolov committed 3210b63

init commit

  • Participants

Comments (0)

Files changed (5)

+(* different utility functions *)
+
+ module KUtil = struct
+   let (>>) x f = f x
+   let ( & ) f x = f x         
+   
+   (* bicycle!  use String.concat instead*)
+   let join delim lst_of_string = 
+     let rec joinR lst acc = 
+       match lst with
+           [] -> acc
+         | h :: [] -> acc ^ h
+         | h :: t -> joinR t (acc ^ h ^ delim)
+     in joinR lst_of_string "";; 
+ 
+   
+   let urlencode str =
+     let buf = Buffer.create 20
+     in
+     let rec enc st = match (safe_next st) with
+         Some chr -> conv chr; enc st
+       | None -> Buffer.contents buf
+     
+     and safe_next st = try Some (Stream.next st)
+                        with Stream.Failure -> None
+     and conv chr = match chr with
+      '0'..'9' | 'a' .. 'z' | 'A' .. 'Z' | '.' | '_' | '-' | '~' -> Buffer.add_char buf chr
+      | _ -> Printf.bprintf buf "%%%x" (Char.code chr)
+  in enc (Stream.of_string str)
+
+
+ let sha1sum s = Sha1.to_hex (Sha1.string s)
+
+                                              
+ let gen20byte () = sha1sum & Printf.sprintf "%.0f"  & Unix.time ();;   
+ 
+ 
+ let get_addr hostname port =
+   let addrinfos = Unix.getaddrinfo hostname port [] 
+   in let ainfo = List.hd addrinfos 
+   in ainfo.Unix.ai_addr
+        
+ (* send whole message *)       
+ let send_all sock msg = 
+   let lngth = String.length msg
+   in Unix.send sock msg 0 lngth []
+
+ (* recieve all data from socket *)
+ let recv_all ?(thunk=1024) sock = 
+   let buffer = String.create thunk in 
+   let rec recvR acc = 
+     let count = Unix.recv sock 0 thunk [] in
+       if count = 0 then acc
+       else recvR ((String.sub buffer 0 count)::acc)
+   in
+     String.concat "" (List.rev recvR [])
+
+   
+   
+ end;;
+(* Roman Sokolov sokolov.r.v@gmail.com
+   bencode format parser
+   http://wiki.theory.org/BitTorrentSpecification
+ *)
+  
+ open KUtil
+
+ module Bencode = 
+  struct
+    
+    type value = 
+        BString of string
+      | BInt of int64
+      | BList of value list
+      | BDict of (string * value) list    
+    let char_to_int64 c = Int64.of_string (String.make 1 c)
+
+
+    let decode_stream stream = 
+      let ten = Int64.of_int 10 in 
+      let rec parse_value = parser 
+       | [< s = parse_string >] -> BString s
+       | [< ''i'; n = parse_number; ''e' >] -> BInt n
+       | [< ''l'; l = parse_list []; ''e' >] -> BList l
+       | [< ''d'; d = parse_dict []; ''e' >] -> BDict d
+      and parse_string = parser 
+       | [< n = parse_pos_number; '':'; s = take (Int64.to_int n) >] -> s
+      and take n chars = 
+        let s = String.make n '\000' in 
+          for i = 0 to n-1 do s.[i] <- Stream.next chars done; s
+      and parse_number = parser 
+       | [< ''-'; n = parse_pos_number >] -> Int64.neg n
+       | [< n = parse_pos_number >] -> n
+      and parse_pos_number = parser 
+       | [< ''0' .. '9' as c; n = parse_digits (char_to_int64 c) >] -> n
+      and parse_digits n = parser 
+       | [< ''0' .. '9' as c; t >] -> parse_digits (Int64.add (Int64.mul n ten) (char_to_int64 c)) t
+       | [< >] -> n
+      and parse_list acc = parser 
+       | [< v = parse_value; t >] -> parse_list (v::acc) t
+       | [< >] -> List.rev acc
+      and parse_dict acc = parser 
+       | [< k = parse_string; v = parse_value; t >] -> parse_dict ((k, v)::acc) t
+       | [< >] -> List.rev acc
+      in
+        let show () = 
+        (* show function is whole copy from ygrek's source. can't explain it yet ^_^ *)
+          let tail = Stream.npeek 10 stream >> List.map (String.make 1) >> String.concat ""
+          in Printf.sprintf "Position %u : %s" (Stream.count stream) tail 
+        in
+          try
+            parse_value stream
+          with Stream.Error _ -> failwith (show ())
+   
+
+    let decode_string st = decode_stream (Stream.of_string st)
+
+
+    let decode_file flnm = 
+      let fl = open_in_bin flnm in 
+      let stream = Stream.of_channel fl in
+      decode_stream stream
+
+        
+    (* for short-writing *)
+    let enc_string bf str = Printf.bprintf bf "%u:%s" (String.length str) str;; 
+
+    
+    (* encode values from internal representation into bencoded string *)
+    let encode bvalue = 
+      let buf = Buffer.create 100 in 
+      let rec enc bval = 
+        match bval with
+            BString s -> enc_string buf s
+          | BInt i -> Printf.bprintf buf "i%Lde" i
+          | BList l -> Buffer.add_char buf 'l';
+                       List.iter enc l ;
+                       Buffer.add_char buf 'e'
+          | BDict d -> Buffer.add_char buf 'd';
+                       List.iter (fun (s, v) -> enc_string buf s;enc v;) d;
+                       Buffer.add_char buf 'e'
+      in enc bvalue;
+         Buffer.contents buf;;
+    
+    
+    (* pretty format bvalue to string *)
+    let rec pformat bvalue = 
+      let buf = Buffer.create 100 in
+      let pp bval = 
+        match bval with
+            BString s -> Printf.bprintf  buf "'%s'" s
+          | BInt i -> Printf.bprintf buf "%Ld" i 
+          | BList l -> let jn_list = String.concat "; " (List.map pformat l) 
+                       in Printf.bprintf buf " [%s] " jn_list
+          | BDict d -> let ls_string = List.map (fun (s, v) -> Printf.sprintf "'%s':%s" s (pformat v)) d
+                       in let jn_list = String.concat "; " ls_string
+                       in Printf.bprintf buf " {%s} " jn_list
+      in pp bvalue;
+         Buffer.contents buf;;
+    
+    
+    let pprint bvalue = print_string (pformat bvalue);;
+ 
+ end;;

File example.torrent

Binary file added.

File katorrent.ml

+ open KUtil
+
+ let get_bdictkey key bdict = match bdict with
+     Bencode.BDict lst -> List.assoc key lst
+   | _ -> failwith "Invalid argument!"
+ 
+ let info = get_bdictkey "info"
+ let announce_addr = get_bdictkey "announce"
+ let gen_peer_id () = urlencode & gen20byte ()

File test.torrent

+d8:announce33:http://deviloid.net:6969/announce13:announce-listll33:http://deviloid.net:6969/announce48:http://www.fuckingtorrent.com/fenix/announce.php36:http://bt.moviehub.info/announce.php33:http://www.h33t.com:3310/announce39:http://restricted-zone.org/announce.php38:http://danishtorrents.org/announce.php39:http://www.swetorrents.org/announce.php31:http://bit-pit.com/announce.php34:http://tbd.no-ip.biz:2710/announce38:http://www.bootytape.com:5969/announce42:http://destroy.kinghosting.cz/announce.php39:http://www.quebec-team.net/announce.php33:http://torrentai.net/announce.php35:http://desidhamal.com:6883/announce45:http://thecellar.afraid.org:9000/announce.php37:http://torrent.jiwang.cc/announce.php40:http://tracker.aelitis.com:6969/announce36:http://www.grabthe.info/announce.php34:http://tpb.tracker.prq.to/announceee10:created by13:uTorrent/184013:creation datei1257185056e8:encoding5:UTF-84:infod6:lengthi1262897e4:name51:The Complete Top Secret Famous Recipes Cookbook.rar12:piece engthi65536e6:pieces400:p�^7�6
+�>�H$c�QV<�ܙs�|S:�C�0ۛ���[�f�bY@��h��`F�MJ�(��1�ԉD/Bs
+}�Z��