Socket server over select with requests count and history

sockserv.ml

open Unix
open Printf

module SM = Map.Make(struct type t = Unix.file_descr let compare = compare end)

type context = {
	buf : string;
	smap : socket_context SM.t;
	count : int;
	history : string list;
}
and socket_context = Server | Connection

let string_of_addr = function
	| ADDR_UNIX s -> s
	| ADDR_INET (a,p) -> sprintf "%s:%d" (string_of_inet_addr a) p

let start_port = int_of_string Sys.argv.(1)
let num_ports = int_of_string Sys.argv.(2)

let ports =
	let arr = Array.make num_ports 0 in
	for i = 0 to num_ports - 1 do
		arr.(i) <- start_port + i
	done;
	Array.to_list arr

let sock_of_port lst p = 
	try
		let srv_sock = socket PF_INET SOCK_STREAM 0
		and srv_addr = ADDR_INET (inet_addr_any, p) in
		setsockopt srv_sock SO_REUSEADDR true;
		bind srv_sock srv_addr;
		listen srv_sock 25;
		srv_sock :: lst
	with
	| Unix_error (err, fn, _) when err = EADDRINUSE ->
		printf "Порт зайнятий: %d\n%!" p;
		lst
	| Unix_error (err, fn, _) when err = EMFILE -> lst

let handle ctx sock =
	match SM.find sock ctx.smap with
	| Server ->
		 let new_sock,addr = accept sock in
		 printf "Connected from %s\n%!" (string_of_addr addr);
		 let smap = SM.add new_sock Connection ctx.smap in
		 { ctx with smap = smap }
	| Connection ->
		 let received = recv sock ctx.buf 0 (Bytes.length ctx.buf) [] in
		 if received > 0 then begin
			 let s = String.sub ctx.buf 0 received in
			 printf "Запит %d, Отримано %d байт: %s\n%!" ctx.count received s;
			 if s = "dump" then begin printf "%s%!" (String.concat "\n" ctx.history) end;
			 { ctx with count = ctx.count + 1; history = s :: ctx.history }
		 end else begin
			 close sock;
			 let smap = SM.remove sock ctx.smap in
			 {ctx with smap = smap}
		 end

let rec loop ctx =
	let socks,_ = List.split (SM.bindings ctx.smap) in
	let (readsocks, _, _) = select socks [] [] 0.5 in
	let ctx = List.fold_left handle ctx readsocks in
	loop ctx

let _ =
	let srvsocks =
		let l = List.fold_left sock_of_port [] ports in
		printf "Кількість серверних сокетів: %d\n%!" (List.length l);
		let res = if List.length l < num_ports
			then begin close (List.hd l); List.tl l end
			else l
		in res in
	let init = {
		buf = Bytes.create 65536;
		smap = List.fold_left
			(fun m s -> SM.add s Server m)
			SM.empty srvsocks;
		count = 0;
		history = []
	} in
	loop init