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