tools/whenjobs.ml

   1 (* whenjobs daemon
   2  * Copyright (C) 2012 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   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 General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *)
  18
  19 open Big_int
  20 open Unix
  21 open Printf
  22
  23 (* Ensures that Whentools module is linked to the whenjobs tool. *)
  24 let _ = Whentools.set_variable
  25
  26 let libdir = ref Libdir.libdir
  27
  28 let jobsdir =
  29   (* Running the program as root is a mistake.  It must be run as a
  30    * non-root user.
  31    *)
  32   let euid = geteuid () in
  33   if euid = 0 then (
  34     eprintf "whenjobs: this program must not be run as root\n";
  35     exit 1
  36   );
  37
  38   (* $HOME must be defined and must exist and be a directory and must be
  39    * owned by the current user.
  40    *)
  41   let home =
  42     try getenv "HOME"
  43     with Not_found ->
  44       eprintf "whenjobs: $HOME environment variable must be defined\n";
  45       exit 1 in
  46
  47   let stat =
  48     try lstat home
  49     with Unix_error (err, fn, _) ->
  50       eprintf "whenjobs: %s: %s ($HOME): %s\n" fn home (error_message err);
  51       exit 1 in
  52   if stat.st_kind != S_DIR then (
  53     eprintf "whenjobs: %s ($HOME): not a directory\n" home;
  54     exit 1
  55   );
  56
  57   if stat.st_uid != euid then (
  58     eprintf "whenjobs: %s ($HOME): not owned by the current user (uid %d)\n"
  59       home euid;
  60     exit 1
  61   );
  62
  63   (* Make the $HOME/.whenjobs directory if it doesn't exist. *)
  64   let jobsdir = sprintf "%s/.whenjobs" home in
  65   (try mkdir jobsdir 0o700 with Unix_error _ -> ());
  66
  67   jobsdir
  68
  69 let rec main () =
  70   (* Parse the command line arguments. *)
  71   let mode = ref None in
  72   let typ = ref "string" in
  73
  74   let set_mode m () = mode := Some m in
  75
  76   let display_version () =
  77     printf "%s %s\n" Config.package_name Config.package_version;
  78     exit 0
  79   in
  80
  81   let argspec = Arg.align [
  82     "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon";
  83     "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon";
  84     "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon";
  85     "--daemon-restart", Arg.Unit (set_mode `Daemon_restart), " Restart the daemon";
  86     "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script";
  87     "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script";
  88     "--get", Arg.Unit (set_mode `Get), " Display the variable";
  89     "-l", Arg.Unit (set_mode `List), " List the script";
  90     "--list", Arg.Unit (set_mode `List), " List the script";
  91     "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
  92     "--set", Arg.Unit (set_mode `Set), " Set the variable";
  93     "--type", Arg.Set_string typ, "bool|int|float|string|unit Set the variable type";
  94     "--upload", Arg.Unit (set_mode `Upload), " Upload the script";
  95     "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
  96     "-V", Arg.Unit display_version, " Display version number and exit";
  97     "--version", Arg.Unit display_version, " Display version number and exit";
  98   ] in
  99
 100   let args = ref [] in
 101   let anon_fun str = args := str :: !args in
 102
 103   let usage_msg = "\
 104 Whenjobs is a powerful but simple cron replacement.
 105 Whenjobs copyright (C) 2012 Red Hat Inc.
 106
 107 Editing the script:
 108
 109   whenjobs -e | --edit
 110   whenjobs -l | --list
 111
 112 Get and set variables:
 113
 114   whenjobs --get variable
 115   whenjobs --set variable value
 116
 117 Start and stop the per-user daemon:
 118
 119   whenjobs --daemon-start | --daemon-stop | --daemon-status
 120
 121 For documentation see the whenjobs(1) man page.
 122
 123 Options:
 124 " in
 125
 126   Arg.parse argspec anon_fun usage_msg;
 127
 128   let mode = !mode in
 129   let args = List.rev !args in
 130
 131   let typ = match !typ with
 132     | "bool"|"boolean" -> `Bool
 133     | "string" -> `String
 134     | "int" -> `Int
 135     | "float"|"double" -> `Float
 136     | "unit" -> `Unit
 137     | t ->
 138       eprintf "whenjobs: --type: unknown type (%s)\n" t;
 139       exit 1 in
 140
 141   (* Depending on the selected mode, perform a different action. *)
 142   match mode with
 143   | None ->
 144     eprintf "whenjobs: no operation selected.\n";
 145     suggest_help ();
 146     exit 1
 147
 148   | Some `Edit ->
 149     unused_error args "-e";
 150     edit_file ()
 151
 152   | Some `List ->
 153     unused_error args "-l";
 154     list_file ()
 155
 156   | Some `Upload ->
 157     unused_error args "--upload";
 158     upload_file ()
 159
 160   | Some `Set ->
 161     if List.length args != 2 then (
 162       eprintf "whenjobs --set variable value\n";
 163       eprintf "If 'value' contains spaces, you may need to quote it.\n";
 164       suggest_help ();
 165       exit 1
 166     );
 167     set_variable (List.hd args) (List.hd (List.tl args)) typ
 168
 169   | Some `Get ->
 170     if List.length args != 1 then (
 171       eprintf "whenjobs --get variable\n";
 172       suggest_help ();
 173       exit 1
 174     );
 175     get_variable (List.hd args)
 176
 177   | Some `Variables ->
 178     unused_error args "--variables";
 179     list_variables ()
 180
 181   | Some `Daemon_start ->
 182     unused_error args "--daemon-start";
 183     daemon_start ()
 184
 185   | Some `Daemon_stop ->
 186     unused_error args "--daemon-stop";
 187     daemon_stop ()
 188
 189   | Some `Daemon_restart ->
 190     unused_error args "--daemon-restart";
 191     daemon_restart ()
 192
 193   | Some `Daemon_status ->
 194     unused_error args "--daemon-status";
 195     daemon_status ()
 196
 197 and edit_file () =
 198   (* If there is no initial file, create an empty one containing the
 199    * tutorial.
 200    *)
 201   let file = get_jobs_filename () in
 202   if not (Sys.file_exists file) then
 203     create_tutorial file;
 204
 205   (* Is $EDITOR set?  If not, use a default. *)
 206   let editor = try getenv "EDITOR" with Not_found -> "vi" in
 207
 208   (* Get the (size, MD5) of the file to tell if it changed. *)
 209   let file_stamp () =
 210     try (lstat file).st_size, Digest.file file
 211     with Unix_error (err, fn, _) ->
 212       eprintf "whenjobs: %s: %s: %s\n" fn file (error_message err);
 213       exit 1
 214   in
 215   let old_stamp = file_stamp () in
 216
 217   let cmd = sprintf "%s %s" editor file in
 218   if Sys.command cmd != 0 then (
 219     eprintf "whenjobs: error editing file (is $EDITOR set correctly?)\n";
 220     exit 1
 221   );
 222
 223   let new_stamp = file_stamp () in
 224
 225   if old_stamp <> new_stamp then
 226     upload_file ()
 227
 228 and list_file () =
 229   let file = get_jobs_filename () in
 230   if not (Sys.file_exists file) then (
 231     eprintf "whenjobs: there is no jobs file, use 'whenjobs -e' to create one\n";
 232     exit 1
 233   );
 234   let chan = open_in file in
 235   let rec loop () =
 236     printf "%s\n" (input_line chan);
 237     loop ()
 238   in
 239   (try loop () with End_of_file -> ());
 240   close_in chan
 241
 242 and upload_file () =
 243   (* Recompile the jobs file. *)
 244   let file = get_jobs_filename () in
 245   let cmo_file = sprintf "%s/jobs.cmo" jobsdir in
 246   let cmd = sprintf "ocamlfind ocamlc -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s -o %s"
 247     !libdir !libdir file cmo_file in
 248   if Sys.command cmd <> 0 then (
 249     eprintf "whenjobs: could not compile jobs script, see earlier error messages\n";
 250     eprintf "compile command was:\n%s\n" cmd;
 251     exit 1
 252   );
 253
 254   (* Test-load the jobs file to ensure it makes sense. *)
 255   Whenfile.init Whenstate.empty;
 256   (try
 257      Dynlink.loadfile cmo_file
 258    with
 259      Dynlink.Error err ->
 260        eprintf "whenjobs: %s\n" (Dynlink.error_message err);
 261        (* Since it failed, unlink it. *)
 262        (try unlink cmo_file with Unix_error _ -> ());
 263        exit 1
 264   );
 265
 266   (* OK now let's tell the daemon to reload it. *)
 267   let client = start_client () in
 268   (match Whenproto_clnt.When.V1.reload_file client () with
 269   | `ok -> ()
 270   | `error msg ->
 271     eprintf "whenjobs: reload: %s\n" msg;
 272     suggest_check_server_logs ();
 273     exit 1
 274   );
 275   stop_client client
 276
 277 and set_variable name value typ =
 278   let value = match typ with
 279     | `Bool ->
 280       (match value with
 281       | "true"|"t"|"yes"|"y"|"on"|"1" -> `bool_t true
 282       | "false"|"f"|"no"|"n"|"off"|"0" -> `bool_t false
 283       | _ ->
 284         eprintf "whenjobs: variable does not have a boolean value\n";
 285         exit 1
 286       )
 287     | `String -> `string_t value
 288     | `Int ->
 289       (try ignore (big_int_of_string value)
 290        with Failure _ ->
 291          eprintf "whenjobs: variable is not an integer\n";
 292          exit 1
 293       );
 294       `int_t value (* the string is what we pass over the wire *)
 295     | `Float ->
 296       (try `float_t (float_of_string value)
 297        with Failure _ ->
 298          eprintf "whenjobs: variable is not a floating point number\n";
 299          exit 1
 300       )
 301     | `Unit ->
 302       if value <> "" then (
 303         eprintf "whenjobs: unit variables must be empty strings\n";
 304         exit 1
 305       );
 306       `unit_t in
 307
 308   let client = start_client () in
 309   (match Whenproto_clnt.When.V1.set_variable client (name, value) with
 310   | `ok -> ()
 311   | `error msg ->
 312     eprintf "whenjobs: set: %s\n" msg;
 313     suggest_check_server_logs ();
 314     exit 1
 315   );
 316   stop_client client
 317
 318 and get_variable name =
 319   let client = start_client () in
 320   let value = Whenproto_clnt.When.V1.get_variable client name in
 321   print_endline (string_of_variable value);
 322   stop_client client
 323
 324 and list_variables () =
 325   let client = start_client () in
 326   let names = Whenproto_clnt.When.V1.get_variable_names client () in
 327   Array.iter (
 328     fun name ->
 329       let value = Whenproto_clnt.When.V1.get_variable client name in
 330       printf "%s=%s\n" name (string_of_variable value)
 331   ) names;
 332   stop_client client
 333
 334 and daemon_start () =
 335   assert false
 336
 337 and daemon_stop () =
 338   let client = start_client () in
 339   (match Whenproto_clnt.When.V1.exit_daemon client () with
 340   | `ok -> ()
 341   | `error msg ->
 342     eprintf "whenjobs: daemon-stop: %s\n" msg;
 343     suggest_check_server_logs ();
 344     exit 1
 345   );
 346   stop_client client
 347
 348 and daemon_restart () =
 349   assert false
 350
 351 and daemon_status () =
 352   assert false
 353
 354 and unused_error args op =
 355   if args <> [] then (
 356     eprintf "whenjobs %s: unused parameters on the command line.\n" op;
 357     suggest_help ();
 358     exit 1
 359   )
 360
 361 and suggest_help () =
 362   eprintf "Use 'whenjobs --help' for a summary of options or read whenjobs(1) man page.\n"
 363
 364 and suggest_check_server_logs () =
 365   eprintf "Look at the server logs (/var/log/cron or /var/log/syslog usually) for\n";
 366   eprintf "further information on why this daemon operation failed.\n"
 367
 368 and get_jobs_filename () =
 369   sprintf "%s/jobs.ml" jobsdir
 370
 371 and create_tutorial file =
 372   let chan = open_out file in
 373   output_string chan Tutorial.tutorial;
 374   close_out chan
 375
 376 and start_client () =
 377   let addr = sprintf "%s/socket" jobsdir in
 378   let client =
 379     try
 380       Whenproto_clnt.When.V1.create_client
 381         (Rpc_client.Unix addr)
 382         Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *)
 383     with
 384     | Unix_error ((ECONNREFUSED|ENOENT), _, _) ->
 385       eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n";
 386       eprintf "Use 'whenjobs --daemon-start' to start the daemon.\n";
 387       exit 1
 388     | Unix_error (err, fn, _) ->
 389       eprintf "whenjobs: %s: %s: %s\n" fn addr (error_message err);
 390       exit 1 in
 391   client
 392
 393 and stop_client client =
 394   Rpc_client.shut_down client
 395
 396 and string_of_variable = function
 397   | `unit_t -> ""
 398   | `bool_t b -> string_of_bool b
 399   | `string_t s -> s
 400   | `int_t i -> i (* passed on the wire as a string *)
 401   | `float_t f -> string_of_float f
 402
 403 let () =
 404   try main ()
 405   with
 406     (* Pretty print some of the exceptions that main can throw. *)
 407   | Rpc.Rpc_server err ->
 408     eprintf "whenjobs: rpc error: %s\n" (Rpc.string_of_server_error err);
 409     suggest_check_server_logs ();
 410     exit 1
 411   | Failure msg ->
 412     eprintf "whenjobs: error: %s\n" msg;
 413     exit 1
 414   | Invalid_argument msg ->
 415     eprintf "whenjobs: invalid argument: %s\n" msg;
 416     exit 1
 417   | exn ->
 418     eprintf "whenjobs: error: %s\n" (Printexc.to_string exn);
 419     exit 1