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