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

« back to all changes in this revision

Viewing changes to examples/rpc/finder/finder_client.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
* 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:
1
 
(* $Id$ *)
 
1
(* $Id: finder_client.ml 1279 2009-10-14 01:12:00Z gerd $ *)
2
2
 
3
3
let start() =
4
4
  let host = ref "localhost" in
 
5
  let port = ref None in
5
6
  let query = ref None in
 
7
  let tmo = ref (-1.0) in
 
8
  let shutdown = ref false in
 
9
  let lastquery = ref false in
 
10
  let max_resp_length = ref None in
6
11
  Arg.parse
7
12
    [ "-host", Arg.Set_string host,
8
13
      "<hostname>  Contact the finder daemon on this host";
 
14
      
 
15
      "-port", Arg.Int (fun n -> port := Some n),
 
16
      "<port>  Bypass portmapper, and use this port directly";
 
17
 
 
18
      "-timeout", Arg.Set_float tmo,
 
19
      "<tmo>  Set a timeout value in seconds";
 
20
 
 
21
      "-shutdown", Arg.Set shutdown,
 
22
      "  Shut the server down";
 
23
 
 
24
      "-lastquery", Arg.Set lastquery,
 
25
      "  Show the last query";
 
26
 
 
27
      "-max-resp-length", Arg.Int (fun n -> max_resp_length := Some n),
 
28
      "<n>  Set the max allowed byte length of responses to n";
 
29
 
 
30
      "-debug", Arg.String (fun s -> Netlog.Debug.enable_module s),
 
31
      "<module>  Enable debug messages for <module>";
 
32
 
 
33
      "-debug-all", Arg.Unit (fun () -> Netlog.Debug.enable_all()),
 
34
      "  Enable all debug messages";
 
35
 
 
36
      "-debug-list", Arg.Unit (fun () -> 
 
37
                                 List.iter print_endline (Netlog.Debug.names());
 
38
                                 exit 0),
 
39
      "  Show possible modules for -debug, then exit"
9
40
    ]
10
41
    (fun s -> query := Some s)
11
42
    "usage: finder_client [options] <query>";
12
43
 
13
44
  let query_string =
14
45
    match !query with
15
 
      | None -> failwith "Query is missing on the command-line"
16
 
      | Some q -> q in
 
46
      | None -> 
 
47
          if not !shutdown && not !lastquery then 
 
48
            failwith "Query is missing on the command-line";
 
49
          None
 
50
      | Some q -> 
 
51
          Some q in
17
52
 
18
53
  let rpc_client =
19
 
    Finder_service_clnt.Finder.V1.create_portmapped_client !host Rpc.Tcp in
 
54
    match !port with
 
55
      | None ->
 
56
          Finder_service_clnt.Finder.V1.create_portmapped_client
 
57
            !host Rpc.Tcp 
 
58
      | Some p ->
 
59
          Finder_service_clnt.Finder.V1.create_client
 
60
            (Rpc_client.Inet(!host,p)) Rpc.Tcp
 
61
  in
 
62
  Rpc_client.configure rpc_client 0 !tmo;
 
63
  ( match !max_resp_length with
 
64
      | None -> ()
 
65
      | Some n -> Rpc_client.set_max_response_length rpc_client n
 
66
  );
20
67
 
21
68
  try
22
 
    match Finder_service_clnt.Finder.V1.find rpc_client query_string with
23
 
      | `not_found ->
24
 
          print_endline ("Not found: " ^ query_string)
25
 
      | `found fullpath ->
26
 
          print_endline fullpath
 
69
    if !lastquery then (
 
70
      print_endline
 
71
        ("Last query: " ^ 
 
72
            Finder_service_clnt.Finder.V1.lastquery rpc_client ())
 
73
    );
 
74
    ( match query_string with
 
75
        | Some q ->
 
76
            ( match Finder_service_clnt.Finder.V1.find rpc_client q with
 
77
                | `not_found ->
 
78
                    print_endline ("Not found: " ^ q)
 
79
                | `found fullpath ->
 
80
                    print_endline fullpath
 
81
            )
 
82
        | None -> ()
 
83
    );
 
84
    if !shutdown then (
 
85
      Finder_service_clnt.Finder.V1.shutdown rpc_client ()
 
86
    );
 
87
    Rpc_client.shut_down rpc_client
27
88
  with
28
89
    | Rpc_client.Communication_error exn ->
29
90
        prerr_endline ("RPC: I/O error: " ^ Printexc.to_string exn)
30
91
    | Rpc_client.Message_lost ->
31
92
        prerr_endline "RPC: Message lost"
 
93
    | Rpc_client.Response_dropped ->
 
94
        prerr_endline "RPC: Response dropped"
32
95
    | Rpc.Rpc_server Rpc.Unavailable_program ->
33
96
        prerr_endline "RPC: Unavailable program"
34
97
    | Rpc.Rpc_server (Rpc.Unavailable_version(_,_)) ->
57
120
        prerr_endline "RPC: Authentication failed";
58
121
;;
59
122
 
60
 
Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
 
123
Netsys_signal.init();
61
124
start();;