Plasma GitLab Archive
Projects Blog Knowledge

(* $Id: netplex_sockserv.ml 1662 2011-08-29 23:05:06Z gerd $ *)

open Netplex_types
open Printf


let create_server_socket = 
  Netplex_util.create_server_socket

let close_server_socket =
  Netplex_util.close_server_socket

let open_master_sockets srvname prots =
  let fdlist = ref [] in
  let sockets = ref [] in

  try
    List.iter
      (fun proto ->
	 let addresses =  (* skip `Container addresses *)
	   Array.of_list
	     (List.filter
		(function
		   | `Container _ -> false
		   | _ -> true 
		)
		(Array.to_list proto#addresses)
	     ) in
	 let fda =
	   Array.map
	     (fun addr ->
		let fd = 
		  Netplex_util.create_server_socket srvname proto addr in
		fdlist := fd :: !fdlist;
		Netlog.Debug.track_fd
		  ~owner:"Netplex_sockserv"
		  ~descr:(sprintf 
			    "Master socket service=%s proto=%s %s"
			    srvname proto#name 
			    (Netsys.string_of_fd fd))
		  fd;
		fd
	     )
	     addresses in
	 sockets := (proto#name, fda) :: !sockets
      )
      prots;
    List.rev !sockets
  with
    | error ->
	List.iter (fun fd -> try Unix.close fd with _ -> ()) !fdlist;
	raise error
;;



let close_master_sockets sockets =
  List.iter
    (fun (_, fda) ->
       Array.iter
	 (fun fd ->
	    Netplex_util.close_server_socket_1 ~release:true fd
	 )
	 fda
    )
    sockets
;;


class std_socket_service 
	proc
        config : socket_service =
  let sockets = open_master_sockets config#name config#protocols in
  let startup_directory = ref None in
object(self)
  method name = config#name
  method sockets = sockets
  method socket_service_config = config
  method processor = proc
  method create_container sockserv =
    Netplex_container.create_container sockserv
  method shutdown () =
    close_master_sockets sockets
  method on_add ctrl =
    startup_directory := Some(ctrl#startup_directory)
  method startup_directory = 
    match !startup_directory with
      | None -> failwith "startup_directory"
      | Some d -> d
end


let create_socket_service = new std_socket_service 


let any_file_client_connector =
  Netplex_util.any_file_client_connector

let client_connector = 
  Netplex_util.client_connector

This web site is published by Informatikbüro Gerd Stolpmann
Powered by Caml