← Back to branch summary

~ubuntu-branches/ubuntu/trusty/ocamlnet/trusty

« back to all changes in this revision

Viewing changes to src/netplex/netplex_sockserv.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-09-02 14:12:33 UTC
  • mfrom: (18.2.3 sid)
  • Revision ID: james.westby@ubuntu.com-20110902141233-zbj0ygxb92u6gy4z
Tags: 3.4-1
http://bugs.debian.org/637147
* New upstream release
  - add a new NetcgiRequire directive to ease dependency management
    (Closes: #637147)
  - remove patches that were applied upstream:
    + Added-missing-shebang-lines-in-example-shell-scripts
    + Try-also-ocamlc-for-POSIX-threads

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/netplex/netplex_sockserv.ml
1
 
(* $Id: netplex_sockserv.ml 976 2006-08-26 16:04:13Z gerd $ *)
 
1
(* $Id: netplex_sockserv.ml 1662 2011-08-29 23:05:06Z gerd $ *)
2
2
 
3
3
open Netplex_types
4
 
 
5
 
let open_sockets prots =
 
4
open Printf
 
5
 
 
6
 
 
7
let create_server_socket = 
 
8
  Netplex_util.create_server_socket
 
9
 
 
10
let close_server_socket =
 
11
  Netplex_util.close_server_socket
 
12
 
 
13
let open_master_sockets srvname prots =
6
14
  let fdlist = ref [] in
7
15
  let sockets = ref [] in
 
16
 
8
17
  try
9
18
    List.iter
10
19
      (fun proto ->
 
20
         let addresses =  (* skip `Container addresses *)
 
21
           Array.of_list
 
22
             (List.filter
 
23
                (function
 
24
                   | `Container _ -> false
 
25
                   | _ -> true 
 
26
                )
 
27
                (Array.to_list proto#addresses)
 
28
             ) in
11
29
         let fda =
12
30
           Array.map
13
31
             (fun addr ->
14
 
                let s =
15
 
                  Unix.socket
16
 
                    (Unix.domain_of_sockaddr addr) Unix.SOCK_STREAM 0 in
17
 
                fdlist := s :: !fdlist;
18
 
                Unix.setsockopt s Unix.SO_REUSEADDR proto#lstn_reuseaddr;
19
 
                Unix.setsockopt s Unix.SO_KEEPALIVE proto#so_keepalive;
20
 
                ( match addr with
21
 
                    | Unix.ADDR_UNIX path ->
22
 
                        ( try Unix.unlink path with _ -> () )
23
 
                    | _ -> ()
24
 
                );
25
 
                Unix.bind s addr;
26
 
                Unix.set_nonblock s;
27
 
                Unix.set_close_on_exec s;
28
 
                Unix.listen s proto#lstn_backlog;
29
 
                s
 
32
                let fd = 
 
33
                  Netplex_util.create_server_socket srvname proto addr in
 
34
                fdlist := fd :: !fdlist;
 
35
                Netlog.Debug.track_fd
 
36
                  ~owner:"Netplex_sockserv"
 
37
                  ~descr:(sprintf 
 
38
                            "Master socket service=%s proto=%s %s"
 
39
                            srvname proto#name 
 
40
                            (Netsys.string_of_fd fd))
 
41
                  fd;
 
42
                fd
30
43
             )
31
 
             proto#addresses in
 
44
             addresses in
32
45
         sockets := (proto#name, fda) :: !sockets
33
46
      )
34
47
      prots;
40
53
;;
41
54
 
42
55
 
 
56
 
 
57
let close_master_sockets sockets =
 
58
  List.iter
 
59
    (fun (_, fda) ->
 
60
       Array.iter
 
61
         (fun fd ->
 
62
            Netplex_util.close_server_socket_1 ~release:true fd
 
63
         )
 
64
         fda
 
65
    )
 
66
    sockets
 
67
;;
 
68
 
 
69
 
43
70
class std_socket_service 
44
71
        proc
45
72
        config : socket_service =
46
 
  let sockets = open_sockets config#protocols in
 
73
  let sockets = open_master_sockets config#name config#protocols in
 
74
  let startup_directory = ref None in
47
75
object(self)
48
76
  method name = config#name
49
77
  method sockets = sockets
51
79
  method processor = proc
52
80
  method create_container sockserv =
53
81
    Netplex_container.create_container sockserv
54
 
 
 
82
  method shutdown () =
 
83
    close_master_sockets sockets
 
84
  method on_add ctrl =
 
85
    startup_directory := Some(ctrl#startup_directory)
 
86
  method startup_directory = 
 
87
    match !startup_directory with
 
88
      | None -> failwith "startup_directory"
 
89
      | Some d -> d
55
90
end
56
91
 
57
92
 
58
 
let create_socket_service
59
 
      proc
60
 
      config =
61
 
  new std_socket_service 
62
 
    proc config
63
 
;;
 
93
let create_socket_service = new std_socket_service 
 
94
 
 
95
 
 
96
let any_file_client_connector =
 
97
  Netplex_util.any_file_client_connector
 
98
 
 
99
let client_connector = 
 
100
  Netplex_util.client_connector