Source

ocaml-bert / tcp_server.ml

Full commit
open Sys;;
open Unix;;

let start_tcp_server addr =
  let sock  = socket PF_INET SOCK_STREAM 0 in
    try 
      setsockopt sock SO_REUSEADDR true;
      bind sock addr;
      listen sock 10;
      sock
    with z-> close sock; raise z;; 

let start_default_tcp_server port = 
  start_tcp_server (ADDR_INET (inet_addr_any, port));;

let tcp_server treat_connection = 
  ignore (signal sigpipe Signal_ignore);
  let sock = start_default_tcp_server 10009 in
    while true do
      let client = accept sock in
	treat_connection client
    done;;

let accept_callback (csock, caddr) = 
(*  print_endline (string_of_inet_addr ADDR_UNIX (addr)); *)
  begin match caddr with
    | ADDR_INET(caller, _)->
	prerr_endline ("connection from " ^ string_of_inet_addr caller );
    | ADDR_UNIX(_)->
	prerr_endline "connection from the unix domain ... ";
  end;
  let rec my_read_ sock buf start remain = 
    let len = recv sock buf start remain [MSG_PEEK] in
      begin match remain with 
	| 0 -> (start+len, buf) ;
	| r -> my_read_ sock buf (start+len) (r-len);
      end;
  in
  let my_read sock len = 
    let buf = String.create len in
      my_read_ sock buf 0 len 
  in
  let (len, buffer) = my_read csock 1024 in
    prerr_endline ((string_of_int len) ^ " bytes recv'd");
    prerr_endline buffer;
    close csock;
    prerr_endline "----------------";;

(* print_endline (string_of_inet_addr ADDR_UNIX(addr));  *)
Printf.printf "staring server in 10009\n";;
handle_unix_error tcp_server accept_callback;;