← Back to branch summary

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

« back to all changes in this revision

Viewing changes to examples/netplex/lever.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:
examples/netplex/lever.ml
 
1
(* $Id: lever.ml 1415 2010-02-15 23:58:25Z gerd $ *)
 
2
 
 
3
open Printf
 
4
 
 
5
(* --- things we need for creating the lever --- *)
 
6
 
 
7
module T = struct
 
8
  type s = string    (* argument type. Here, the message string *)
 
9
  type r = bool      (* result type. Here, whether the lever was successful *)
 
10
end
 
11
 
 
12
module L = Netplex_cenv.Make_lever(T)
 
13
 
 
14
module LV = Netplex_cenv.Make_var_type(L)
 
15
 
 
16
(* --- helper --- *)
 
17
 
 
18
let helper_hooks s =
 
19
  ( object
 
20
      inherit Netplex_kit.empty_processor_hooks () 
 
21
      method post_start_hook cont =
 
22
        (* Just print the message 10 times *)
 
23
        for n = 1 to 10 do
 
24
          Netlog.logf `Info "Helper1: %s" s;
 
25
          Unix.sleep 1
 
26
        done;
 
27
        (* There is no real way for disabling a helper again. [shutdown]
 
28
           will shut the process down (and it is not restarting). The
 
29
           service definition will remain active, however.
 
30
         *)
 
31
        cont#shutdown();
 
32
        
 
33
    end
 
34
  )
 
35
 
 
36
(* --- worker --- *)
 
37
 
 
38
let proc_operation s =
 
39
  (* Start the helper thread using a lever *)
 
40
  let lever = LV.get "sample_lever" in
 
41
  let success = lever s in
 
42
  let r =
 
43
    if success then
 
44
      "Could activate lever"
 
45
    else
 
46
      "Error activating lever" in
 
47
  Netlog.log `Info r;
 
48
  r
 
49
 
 
50
 
 
51
let setup_worker srv _ =
 
52
  Operation_srv.P.V.bind
 
53
    ~proc_null:(fun () -> ())
 
54
    ~proc_operation
 
55
    srv
 
56
 
 
57
 
 
58
let worker_hooks() =
 
59
  ( object(self)
 
60
      inherit Netplex_kit.empty_processor_hooks() 
 
61
 
 
62
      val mutable helper1_lever = (fun _ -> assert false)
 
63
 
 
64
      method post_add_hook socksrv ctrl =
 
65
        (* This is run in controller context, right after program startup.
 
66
           Register now the lever function, which starts a helper service.
 
67
         *)
 
68
        let lever = 
 
69
          L.register ctrl
 
70
            (fun ctrl s ->
 
71
               try
 
72
                 Netplex_kit.add_helper_service
 
73
                   ctrl "helper1" (helper_hooks s);
 
74
                 true   (* successful *)
 
75
               with error ->
 
76
                 Netlog.logf `Err "Cannot start helper service: %s"
 
77
                   (Netexn.to_string error);
 
78
                 false  (* not successful *)
 
79
            ) in
 
80
        (* Remember the created lever until the child forks *)
 
81
        helper1_lever <- lever
 
82
 
 
83
      method post_start_hook cont =
 
84
        (* Make the lever generally available in the child *)
 
85
        LV.set "sample_lever" helper1_lever
 
86
    end
 
87
  )
 
88
 
 
89
let worker_factory() =
 
90
  Rpc_netplex.rpc_factory
 
91
    ~configure:(fun _ _ -> ())
 
92
    ~name:"worker"
 
93
    ~setup:setup_worker
 
94
    ~hooks:(fun _ -> worker_hooks())
 
95
    ()
 
96
 
 
97
 
 
98
(* --- main --- *)
 
99
 
 
100
let start() =
 
101
  let (opt_list, cmdline_cfg) = Netplex_main.args() in
 
102
 
 
103
  let use_mt = ref false in
 
104
 
 
105
  let opt_list' =
 
106
    [ "-mt", Arg.Set use_mt,
 
107
      "  Use multi-threading instead of multi-processing";
 
108
      
 
109
      "-debug", Arg.String (fun s -> Netlog.Debug.enable_module s),
 
110
      "<module>  Enable debug messages for <module>";
 
111
 
 
112
      "-debug-all", Arg.Unit (fun () -> Netlog.Debug.enable_all()),
 
113
      "  Enable all debug messages";
 
114
 
 
115
      "-debug-list", Arg.Unit (fun () -> 
 
116
                                 List.iter print_endline (Netlog.Debug.names());
 
117
                                 exit 0),
 
118
      "  Show possible modules for -debug, then exit";
 
119
   ] @ opt_list in
 
120
 
 
121
  Arg.parse
 
122
    opt_list'
 
123
    (fun s -> raise (Arg.Bad ("Don't know what to do with: " ^ s)))
 
124
    (sprintf "usage: %s [options]" (Filename.basename Sys.argv.(0)));
 
125
 
 
126
  let parallelizer =
 
127
    if !use_mt then
 
128
      Netplex_mt.mt()     (* multi-threading *)
 
129
    else
 
130
      Netplex_mp.mp() in  (* multi-processing *)
 
131
  
 
132
  Netplex_main.startup
 
133
    parallelizer
 
134
    Netplex_log.logger_factories   (* allow all built-in logging styles *)
 
135
    Netplex_workload.workload_manager_factories (* ... all ways of workload management *)
 
136
    [ worker_factory() ]
 
137
    cmdline_cfg
 
138
 
 
139
 
 
140
let () =
 
141
  Netsys_signal.init();
 
142
  start()