← Back to branch summary

~ubuntu-branches/ubuntu/quantal/xen-api/quantal

« back to all changes in this revision

Viewing changes to ocaml/xe-cli/rt/gtclient.ml

  • Committer: Package Import Robot
  • Author(s): Jon Ludlam
  • Date: 2011-07-07 21:50:18 UTC
  • Revision ID: package-import@ubuntu.com-20110707215018-3t9ekbh7qy5y2b1p
Tags: upstream-1.3
Import upstream version 1.3

Show diffs side-by-side

added added

removed removed

Lines of Context:
ocaml/xe-cli/rt/gtclient.ml
 
1
(*
 
2
 * Copyright (C) 2006-2009 Citrix Systems Inc.
 
3
 *
 
4
 * This program is free software; you can redistribute it and/or modify
 
5
 * it under the terms of the GNU Lesser General Public License as published
 
6
 * by the Free Software Foundation; version 2.1 only. with the special
 
7
 * exception on linking described in file LICENSE.
 
8
 *
 
9
 * This program is distributed in the hope that it will be useful,
 
10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 
11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
12
 * GNU Lesser General Public License for more details.
 
13
 *)
 
14
 
 
15
 
 
16
module Protocol = Gtcomms.Make_Protocol (struct type t=Gtmessages.message end)
 
17
module Client = Gtcomms.Client (Protocol)
 
18
module Server = Gtcomms.Server (Protocol)
 
19
 
 
20
open Gtmessages
 
21
 
 
22
let rec nthtl l n =
 
23
  if n=0 then l else nthtl (List.tl l) (n-1)
 
24
 
 
25
let _ =
 
26
  let addr = Sys.argv.(1) in
 
27
  let msg = 
 
28
    match Sys.argv.(2) with
 
29
      "test" ->     Test
 
30
    | "shutdown" -> Shutdown (int_of_string Sys.argv.(3))
 
31
    | "reboot" ->   Reboot (int_of_string Sys.argv.(3))
 
32
    | "crash" ->    Crash 
 
33
    | "checkcd" ->  CheckCD (nthtl (Array.to_list Sys.argv) 3)    
 
34
    | "checkcdfail" -> CheckCDFail (nthtl (Array.to_list Sys.argv) 3)
 
35
    | "checkvif" -> CheckVIF Sys.argv.(3)
 
36
    | "checkdisks" -> CheckDisks (nthtl (Array.to_list Sys.argv) 3)
 
37
    | "checkmountdisk" -> CheckMountDisks (nthtl (Array.to_list Sys.argv) 3)
 
38
    | "setuptestdisk" -> SetupTestDisk Sys.argv.(3)
 
39
    | _ -> raise (Failure "Unknown command!")
 
40
  in 
 
41
  try
 
42
    let ans = Client.emit_answer addr 8085 msg in
 
43
    match ans with
 
44
      CmdResult str -> print_endline str
 
45
    | _ -> exit 0
 
46
  with
 
47
    exc -> 
 
48
      Printf.printf "Exception trapped: %s\n" (Printexc.to_string exc);
 
49
      exit 1