(* Intercept *) (* $Id: intercept.ml,v 1.1 2003/01/12 15:33:00 berke Exp $ *) (* By Berke Durak *) open Unix let address = Sys.argv.(1) let port = int_of_string (Sys.argv.(2)) let listen_port = int_of_string (Sys.argv.(3)) let string_of_sockaddr = function ADDR_UNIX(x) -> "unix("^x^")" | ADDR_INET(i,p) -> Printf.sprintf "%s:%d" (string_of_inet_addr i) p let msg x = print_string x; print_char '\n'; flush Pervasives.stdout and sf = Printf.sprintf let dump_bytes file buf pos len bytes_per_col = let rec do_line i = if i < len then begin Printf.fprintf file "0x%06x" i; do_hex i 0 end and do_hex i j = if i + j = len or j = bytes_per_col then do_spaces i j else begin Printf.fprintf file " %02x" (Char.code buf.[pos + i + j]); do_hex i (j + 1) end and do_spaces i j = if j = bytes_per_col then begin Printf.fprintf file " "; do_ascii i 0 end else begin Printf.fprintf file " "; do_spaces i (j + 1) end and do_ascii i j = if i + j = len or j = bytes_per_col then begin Printf.fprintf file "\n"; do_line (i + j) end else let c = Char.code buf.[pos + i + j] in if c > 32 && c < 128 then Printf.fprintf file "%c" buf.[pos + i + j] else Printf.fprintf file "."; do_ascii i (j + 1) in do_line 0 let _ = let buf = String.make 4096 '\000' in let s = socket PF_INET SOCK_STREAM 0 in setsockopt s SO_REUSEADDR true; bind s (ADDR_INET(inet_addr_any, listen_port)); listen s 1; while true do let (u,sa) = accept s in msg (sf "Received connection from %s." (string_of_sockaddr sa)); let t = socket PF_INET SOCK_STREAM 0 in connect t (ADDR_INET((gethostbyname address).h_addr_list.(0),port)); msg (sf "Connection established."); set_nonblock t; set_nonblock u; let wqt = Queue.create () and wqu = Queue.create () in begin try while true do let (rl,wl,_) = select [t;u] [t;u] [] (-1.0) in let do_read t wqu dir = if List.mem t rl then begin let r = read t buf 0 (String.length buf) in if r = 0 then raise End_of_file else begin Queue.add (0,(String.sub buf 0 r)) wqu; Printf.fprintf Pervasives.stdout "%s\n" dir; dump_bytes Pervasives.stdout buf 0 r 16; flush Pervasives.stdout end end; and do_write t wqt = if List.mem t wl then begin let rec loop () = if Queue.length wqt > 0 then let (i,x) = Queue.take wqt in let w = write t x i (String.length x - i) in if w > 0 then begin if i + w < String.length x then Queue.add (i + w, x) wqt; loop () end in loop () end in do_read t wqu "<<<"; do_write t wqt; do_read u wqt ">>>"; do_write u wqu done; with End_of_file -> () end; close t; close u; msg (sf "Connection closed.") done