--- /dev/null
+(* whenjobs daemon
+ * Copyright (C) 2012 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Big_int
+open Unix
+open Printf
+
+let libdir = ref Libdir.libdir
+
+let jobsdir =
+ (* Running the program as root is a mistake. It must be run as a
+ * non-root user.
+ *)
+ let euid = geteuid () in
+ if euid = 0 then (
+ eprintf "whenjobs: this program must not be run as root\n";
+ exit 1
+ );
+
+ (* $HOME must be defined and must exist and be a directory and must be
+ * owned by the current user.
+ *)
+ let home =
+ try getenv "HOME"
+ with Not_found ->
+ eprintf "whenjobs: $HOME environment variable must be defined\n";
+ exit 1 in
+
+ let stat =
+ try lstat home
+ with Unix_error (err, fn, _) ->
+ eprintf "whenjobs: %s: %s ($HOME): %s\n" fn home (error_message err);
+ exit 1 in
+ if stat.st_kind != S_DIR then (
+ eprintf "whenjobs: %s ($HOME): not a directory\n" home;
+ exit 1
+ );
+
+ if stat.st_uid != euid then (
+ eprintf "whenjobs: %s ($HOME): not owned by the current user (uid %d)\n"
+ home euid;
+ exit 1
+ );
+
+ (* Make the $HOME/.whenjobs directory if it doesn't exist. *)
+ let jobsdir = sprintf "%s/.whenjobs" home in
+ (try mkdir jobsdir 0o700 with Unix_error _ -> ());
+
+ jobsdir
+
+let rec main () =
+ (* Parse the command line arguments. *)
+ let mode = ref None in
+ let typ = ref "string" in
+
+ let set_mode m () = mode := Some m in
+
+ let display_version () =
+ printf "%s %s\n" Config.package_name Config.package_version;
+ exit 0
+ in
+
+ let argspec = Arg.align [
+ "--daemon-start", Arg.Unit (set_mode `Daemon_start), " Start the daemon";
+ "--daemon-status", Arg.Unit (set_mode `Daemon_status), " Display the status of the daemon";
+ "--daemon-stop", Arg.Unit (set_mode `Daemon_stop), " Stop the daemon";
+ "--daemon-restart", Arg.Unit (set_mode `Daemon_restart), " Restart the daemon";
+ "-e", Arg.Unit (set_mode `Edit), " Edit and upload the script";
+ "--edit", Arg.Unit (set_mode `Edit), " Edit and upload the script";
+ "--get", Arg.Unit (set_mode `Get), " Display the variable";
+ "-l", Arg.Unit (set_mode `List), " List the script";
+ "--list", Arg.Unit (set_mode `List), " List the script";
+ "--lib", Arg.Set_string libdir, "dir Specify directory that contains pa_when.cmo";
+ "--set", Arg.Unit (set_mode `Set), " Set the variable";
+ "--type", Arg.Set_string typ, "bool|int|float|string Set the variable type";
+ "--upload", Arg.Unit (set_mode `Upload), " Upload the script";
+ "--variables", Arg.Unit (set_mode `Variables), " Display all variables and values";
+ "-V", Arg.Unit display_version, " Display version number and exit";
+ "--version", Arg.Unit display_version, " Display version number and exit";
+ ] in
+
+ let args = ref [] in
+ let anon_fun str = args := str :: !args in
+
+ let usage_msg = "\
+Whenjobs is a powerful but simple cron replacement.
+Whenjobs copyright (C) 2012 Red Hat Inc.
+
+Editing the script:
+
+ whenjobs -e | --edit
+ whenjobs -l | --list
+
+Get and set variables:
+
+ whenjobs --get variable
+ whenjobs --set variable value
+
+Start and stop the per-user daemon:
+
+ whenjobs --daemon-start | --daemon-stop | --daemon-status
+
+For documentation see the whenjobs(1) man page.
+
+Options:
+" in
+
+ Arg.parse argspec anon_fun usage_msg;
+
+ let mode = !mode in
+ let args = List.rev !args in
+
+ let typ = match !typ with
+ | "bool"|"boolean" -> `Bool
+ | "string" -> `String
+ | "int" -> `Int
+ | "float"|"double" -> `Float
+ | t ->
+ eprintf "whenjobs: --type: unknown type (%s)\n" t;
+ exit 1 in
+
+ (* Depending on the selected mode, perform a different action. *)
+ match mode with
+ | None ->
+ eprintf "whenjobs: no operation selected.\n";
+ suggest_help ();
+ exit 1
+
+ | Some `Edit ->
+ unused_error args "-e";
+ edit_file ()
+
+ | Some `List ->
+ unused_error args "-l";
+ list_file ()
+
+ | Some `Upload ->
+ unused_error args "--upload";
+ upload_file ()
+
+ | Some `Set ->
+ if List.length args != 2 then (
+ eprintf "whenjobs --set variable value\n";
+ eprintf "If 'value' contains spaces, you may need to quote it.\n";
+ suggest_help ();
+ exit 1
+ );
+ set_variable (List.hd args) (List.hd (List.tl args)) typ
+
+ | Some `Get ->
+ if List.length args != 1 then (
+ eprintf "whenjobs --get variable\n";
+ suggest_help ();
+ exit 1
+ );
+ get_variable (List.hd args)
+
+ | Some `Variables ->
+ unused_error args "--variables";
+ list_variables ()
+
+ | Some `Daemon_start ->
+ unused_error args "--daemon-start";
+ daemon_start ()
+
+ | Some `Daemon_stop ->
+ unused_error args "--daemon-stop";
+ daemon_stop ()
+
+ | Some `Daemon_restart ->
+ unused_error args "--daemon-restart";
+ daemon_restart ()
+
+ | Some `Daemon_status ->
+ unused_error args "--daemon-status";
+ daemon_status ()
+
+and edit_file () =
+ (* If there is no initial file, create an empty one containing the
+ * tutorial.
+ *)
+ let file = get_jobs_filename () in
+ if not (Sys.file_exists file) then
+ create_tutorial file;
+
+ (* Is $EDITOR set? If not, use a default. *)
+ let editor = try getenv "EDITOR" with Not_found -> "vi" in
+
+ (* Get the (size, MD5) of the file to tell if it changed. *)
+ let file_stamp () =
+ try (lstat file).st_size, Digest.file file
+ with Unix_error (err, fn, _) ->
+ eprintf "whenjobs: %s: %s: %s\n" fn file (error_message err);
+ exit 1
+ in
+ let old_stamp = file_stamp () in
+
+ let cmd = sprintf "%s %s" editor file in
+ if Sys.command cmd != 0 then (
+ eprintf "whenjobs: error editing file (is $EDITOR set correctly?)\n";
+ exit 1
+ );
+
+ let new_stamp = file_stamp () in
+
+ if old_stamp <> new_stamp then
+ upload_file ()
+
+and list_file () =
+ let file = get_jobs_filename () in
+ if not (Sys.file_exists file) then (
+ eprintf "whenjobs: there is no jobs file, use 'whenjobs -e' to create one\n";
+ exit 1
+ );
+ let chan = open_in file in
+ let rec loop () =
+ printf "%s\n" (input_line chan);
+ loop ()
+ in
+ (try loop () with End_of_file -> ());
+ close_in chan
+
+and upload_file () =
+ (* Recompile the jobs file. *)
+ let file = get_jobs_filename () in
+ let cmo_file = sprintf "%s/jobs.cmo" jobsdir in
+ let cmd = sprintf "ocamlfind ocamlc -I +camlp4 -I %s -package unix,camlp4.lib -pp 'camlp4o %s/pa_when.cmo' -c %s -o %s"
+ !libdir !libdir file cmo_file in
+ if Sys.command cmd <> 0 then (
+ eprintf "whenjobs: could not compile jobs script, see earlier error messages\n";
+ eprintf "compile command was:\n%s\n" cmd;
+ exit 1
+ );
+
+ (* Test-load the jobs file to ensure it makes sense. *)
+ Whenfile.init ();
+ (try
+ Dynlink.loadfile cmo_file
+ with
+ Dynlink.Error err ->
+ eprintf "whenjobs: %s\n" (Dynlink.error_message err);
+ (* Since it failed, unlink it. *)
+ (try unlink cmo_file with Unix_error _ -> ());
+ exit 1
+ );
+
+ (* OK now let's tell the daemon to reload it. *)
+ let client = start_client () in
+ (match Whenproto_clnt.When.V1.reload_file client () with
+ | `ok -> ()
+ | `error msg ->
+ eprintf "whenjobs: reload: %s\n" msg;
+ suggest_check_server_logs ();
+ exit 1
+ );
+ stop_client client
+
+and set_variable name value typ =
+ let value = match typ with
+ | `Bool ->
+ (match value with
+ | "true"|"t"|"yes"|"y"|"on"|"1" -> `bool_t true
+ | "false"|"f"|"no"|"n"|"off"|"0" -> `bool_t false
+ | _ ->
+ eprintf "whenjobs: variable does not have a boolean value\n";
+ exit 1
+ )
+ | `String -> `string_t value
+ | `Int ->
+ (try ignore (big_int_of_string value)
+ with Failure _ ->
+ eprintf "whenjobs: variable is not an integer\n";
+ exit 1
+ );
+ `int_t value (* the string is what we pass over the wire *)
+ | `Float ->
+ (try `float_t (float_of_string value)
+ with Failure _ ->
+ eprintf "whenjobs: variable is not a floating point number\n";
+ exit 1
+ ) in
+
+ let client = start_client () in
+ Whenproto_clnt.When.V1.set_variable client (name, value);
+ stop_client client
+
+and get_variable name =
+ let client = start_client () in
+ let value = Whenproto_clnt.When.V1.get_variable client name in
+ print_endline (string_of_variable value);
+ stop_client client
+
+and list_variables () =
+ let client = start_client () in
+ let names = Whenproto_clnt.When.V1.get_variable_names client () in
+ Array.iter (
+ fun name ->
+ let value = Whenproto_clnt.When.V1.get_variable client name in
+ printf "%s=%s\n" name (string_of_variable value)
+ ) names;
+ stop_client client
+
+and daemon_start () =
+ assert false
+
+and daemon_stop () =
+ assert false
+
+and daemon_restart () =
+ assert false
+
+and daemon_status () =
+ assert false
+
+and unused_error args op =
+ if args <> [] then (
+ eprintf "whenjobs %s: unused parameters on the command line.\n" op;
+ suggest_help ();
+ exit 1
+ )
+
+and suggest_help () =
+ eprintf "Use 'whenjobs --help' for a summary of options or read whenjobs(1) man page.\n"
+
+and suggest_check_server_logs () =
+ eprintf "Look at the server logs (/var/log/cron or /var/log/syslog usually) for\n";
+ eprintf "further information on why this daemon operation failed.\n"
+
+and get_jobs_filename () =
+ sprintf "%s/jobs.ml" jobsdir
+
+and create_tutorial file =
+ let chan = open_out file in
+ output_string chan Tutorial.tutorial;
+ close_out chan
+
+and start_client () =
+ let addr = sprintf "%s/socket" jobsdir in
+ let client =
+ try
+ Whenproto_clnt.When.V1.create_client
+ (Rpc_client.Unix addr)
+ Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *)
+ with
+ | Unix_error ((ECONNREFUSED|ENOENT), _, _) ->
+ eprintf "whenjobs: error: the daemon ('whenjobsd') is not running\n";
+ eprintf "Use 'whenjobs --daemon-start' to start the daemon.\n";
+ exit 1
+ | Unix_error (err, fn, _) ->
+ eprintf "whenjobs: %s: %s: %s\n" fn addr (error_message err);
+ exit 1 in
+ client
+
+and stop_client client =
+ Rpc_client.shut_down client
+
+and string_of_variable = function
+ | `bool_t b -> string_of_bool b
+ | `string_t s -> s
+ | `int_t i -> i (* passed on the wire as a string *)
+ | `float_t f -> string_of_float f
+
+let () =
+ try main ()
+ with
+ (* Pretty print some of the exceptions that main can throw. *)
+ | Rpc.Rpc_server err ->
+ eprintf "whenjobs: rpc error: %s\n" (Rpc.string_of_server_error err);
+ suggest_check_server_logs ();
+ exit 1
+ | Failure msg ->
+ eprintf "whenjobs: error: %s\n" msg;
+ exit 1
+ | Invalid_argument msg ->
+ eprintf "whenjobs: invalid argument: %s\n" msg;
+ exit 1
+ | exn ->
+ eprintf "whenjobs: error: %s\n" (Printexc.to_string exn);
+ exit 1
git.annexia.org / whenjobs.git / blobdiff