2 * Copyright (C) 2012 Red Hat Inc.
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.
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.
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.
24 (* All jobs that are loaded. Maps name -> [job] structure. *)
25 let jobs = ref StringMap.empty
27 (* Map variable names to jobs which depend on that variable. This
28 * gives us a quick way to tell which jobs might need to be reevaluated
29 * when a variable is set.
31 let dependencies = ref StringMap.empty
33 (* Current values of variables. Using the referentially transparent
34 * type Map is very useful here because it lets us cheaply keep
35 * previous values of variables.
37 let variables : variables ref = ref StringMap.empty
42 (* Was debugging requested on the command line? *)
45 let esys = Unixqueue.standard_event_system ()
51 Whenlock.create_lock !jobsdir;
53 (* Remove old socket if it exists. *)
54 let addr = sprintf "%s/socket" !jobsdir in
55 (try unlink addr with Unix_error _ -> ());
58 Whenproto_srv.When.V1.create_server
62 ~proc_get_variable_names
63 (Rpc_server.Unix addr)
64 Rpc.Tcp (* not TCP, this is the same as SOCK_STREAM *)
69 and proc_reload_file () =
70 if !debug then Syslog.notice "remote call: reload_file";
72 try reload_file (); `ok
73 with Failure err -> `error err
75 and proc_set_variable (name, value) =
76 if !debug then Syslog.notice "remote call: set_variable %s" name;
78 let value = variable_of_rpc value in
79 variables := StringMap.add name value !variables;
81 (* Which jobs need to be re-evaluated? *)
82 let jobnames = try StringMap.find name !dependencies with Not_found -> [] in
83 let jobs = reevaluate_jobs jobnames in
86 and proc_get_variable name =
87 if !debug then Syslog.notice "remote call: get_variable %s" name;
89 try rpc_of_variable (StringMap.find name !variables)
90 with (* all non-existent variables are empty strings *)
91 Not_found -> `string_t ""
93 and proc_get_variable_names () =
94 if !debug then Syslog.notice "remote call: get_variable_names";
96 (* Only return variables that are non-empty. *)
97 let vars = StringMap.fold (
98 fun name value xs -> if value <> T_string "" then name :: xs else xs
100 let vars = Array.of_list vars in
101 Array.sort compare vars;
104 (* Reload the jobs file. *)
106 let file = sprintf "%s/jobs.cmo" !jobsdir in
111 Dynlink.loadfile file;
112 let jobs = Whenfile.get_jobs () in
113 Syslog.notice "loaded %d job(s) from %s" (List.length jobs) file;
116 | Dynlink.Error err ->
117 let err = Dynlink.error_message err in
118 Syslog.error "error loading jobs: %s" err;
121 failwith (Printexc.to_string exn) in
123 (* Set 'jobs' and related global variables. *)
125 let map = List.fold_left (
127 let name = j.job_name in
128 StringMap.add name j map
129 ) StringMap.empty js in
133 let map = List.fold_left (
135 let deps = dependencies_of_job j in
136 let name = j.job_name in
139 let names = try StringMap.find d map with Not_found -> [] in
140 StringMap.add d (name :: names) map
142 ) StringMap.empty js in
143 dependencies := map in
145 (* Re-evaluate all jobs. *)
146 let jobs = reevaluate_jobs (StringMap.keys !jobs) in
149 (* Re-evaluate each named job, in a loop until we reach a fixpoint.
150 * Return the names of all the jobs that need to be run.
152 and reevaluate_jobs jobnames =
153 let rec loop set jobnames =
158 try StringMap.find jobname !jobs
159 with Not_found -> assert false in
160 assert (jobname = job.job_name);
162 let r, job' = job_evaluate job !variables in
163 jobs := StringMap.add jobname job' !jobs;
166 Syslog.notice "evaluate %s -> %b\n" jobname r;
168 if r then StringSet.add jobname set else set
170 if StringSet.compare set set' <> 0 then
175 let set = loop StringSet.empty jobnames in
176 StringSet.elements set
178 and run_jobs jobnames =
180 Syslog.notice "running %s" job.job_name;
185 (List.map (fun jobname -> StringMap.find jobname !jobs) jobnames)