Implement url_exists, file_contains_string, url_contains_string.
[goaljobs.git] / goaljobs.ml
1 (* goaljobs
2  * Copyright (C) 2013 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 Unix
20 open Printf
21
22 open Goaljobs_config
23
24 type goal_result_t = Goal_OK | Goal_failed of string
25 exception Goal_result of goal_result_t
26
27 let goal_failed msg = raise (Goal_result (Goal_failed msg))
28
29 let target v =
30   if v then raise (Goal_result Goal_OK)
31 let target_all vs = target (List.fold_left (&&) true vs)
32 let target_exists vs = target (List.fold_left (||) false vs)
33 let require () = ()
34
35 let file_exists = Sys.file_exists
36
37 let file_newer_than f1 f2 =
38   let stat f =
39     try Some (stat f)
40     with
41     | Unix_error (ENOENT, _, _) -> None
42     | Unix_error (err, _, _) ->
43       let msg = sprintf "file_newer_than: %s: %s" f (error_message err) in
44       goal_failed msg
45   in
46   let s1 = stat f1 and s2 = stat f2 in
47   match s1 with
48   | None -> false
49   | Some s1 ->
50     match s2 with
51     | None ->
52       let msg = sprintf "file_newer_than: %s: file does not exist" f2 in
53       goal_failed msg
54     | Some s2 ->
55       s1.st_mtime >= s2.st_mtime
56
57 let more_recent objs srcs =
58   if not (List.for_all file_exists objs) then false
59   else (
60     List.for_all (
61       fun obj -> List.for_all (file_newer_than obj) srcs
62     ) objs
63   )
64
65 let url_exists url =
66   (* http://stackoverflow.com/questions/12199059/how-to-check-if-an-url-exists-with-the-shell-and-probably-curl *)
67   let cmd =
68     sprintf "curl --output /dev/null --silent --head --fail %s" (quote url) in
69   match Sys.command cmd with
70   | 0 -> true
71   | 1 -> false
72   | r ->
73     let msg = sprintf "curl error testing '%s' (exit code %d)" url r in
74     goal_failed msg
75
76 let file_contains_string filename str =
77   let cmd = sprintf "grep -q %s %s" (quote str) (quote filename) in
78   match Sys.command cmd with
79   | 0 -> true
80   | 1 -> false
81   | r ->
82     let msg = sprintf "grep error testing for '%s' in '%s' (exit code %d)"
83       str filename r in
84     goal_failed msg
85
86 let url_contains_string url str =
87   let tmp = Filename.temp_file "goaljobsurl" "" in
88   let cmd =
89     sprintf "curl --output %s --silent --fail %s" (quote tmp) (quote url) in
90   (match Sys.command cmd with
91   | 0 -> ()
92   | 1 ->
93     let msg = sprintf "curl failed to download URL '%s'" url in
94     goal_failed msg
95   | r ->
96     let msg = sprintf "curl error testing '%s' (exit code %d)" url r in
97     goal_failed msg
98   );
99   let r = file_contains_string tmp str in
100   unlink tmp;
101   r
102
103
104 let sh fs =
105   let do_sh cmd =
106     let cmd = "set -e\nset -x\n\n" ^ cmd in
107     let r = Sys.command cmd in
108     if r <> 0 then (
109       let msg = sprintf "external command failed with code %d" r in
110       goal_failed msg
111     )
112   in
113   ksprintf do_sh fs
114
115 let do_shlines cmd =
116   let cmd = "set -e\nset -x\n\n" ^ cmd in
117   let chan = open_process_in cmd in
118   let lines = ref [] in
119   let rec loop () =
120     let line = input_line chan in
121     lines := line :: !lines;
122     loop ()
123   in
124   (try loop () with End_of_file -> ());
125   let r = close_process_in chan in
126   match r with
127   | WEXITED 0 -> List.rev !lines
128   | WEXITED i ->
129     let msg = sprintf "external command failed with code %d" i in
130     goal_failed msg
131   | WSIGNALED i ->
132     let msg = sprintf "external command was killed by signal %d" i in
133     goal_failed msg
134   | WSTOPPED i ->
135     let msg = sprintf "external command was stopped by signal %d" i in
136     goal_failed msg
137 let shlines fs = ksprintf do_shlines fs
138
139 let do_shout cmd =
140   let lines = do_shlines cmd in
141   String.concat "\n" lines
142 let shout fs = ksprintf do_shout fs
143
144 (*
145 val shell : string ref
146 *)
147
148 (*
149 val replace_substring : string -> string -> string -> string
150 *)
151
152 let change_file_extension ext filename =
153   let i =
154     try String.rindex filename '.'
155     with Not_found -> String.length filename in
156   String.sub filename 0 i ^ "." ^ ext
157
158 (*
159 val filter_file_extension : string -> string list -> string
160 *)
161
162 (* XXX The Memory is not actually persistent yet. *)
163 let memory = Hashtbl.create 13
164
165 let memory_exists = Hashtbl.mem memory
166 let memory_set = Hashtbl.replace memory
167 let memory_get k = try Some (Hashtbl.find memory k) with Not_found -> None
168 let memory_delete = Hashtbl.remove memory
169
170 let published_goals = ref []
171 let publish name fn = published_goals := (name, fn) :: !published_goals
172 let get_goal name =
173   try Some (List.assoc name !published_goals) with Not_found -> None
174
175 let goal_file_exists filename =
176   if not (file_exists filename) then (
177     let msg = sprintf "file '%s' required but not found" filename in
178     goal_failed msg
179   )
180 let goal_file_newer_than f1 f2 =
181   if not (file_newer_than f1 f2) then (
182     let msg = sprintf "file %s is required to be newer than %s" f1 f2 in
183     goal_failed msg
184   )
185 let goal_more_recent objs srcs =
186   if not (more_recent objs srcs) then (
187     let msg = sprintf "object(s) %s are required to be newer than source(s) %s"
188       (String.concat " " objs) (String.concat " " srcs) in
189     goal_failed msg
190   )
191 let goal_url_exists url =
192   if not (url_exists url) then (
193     let msg = sprintf "url_exists: URL '%s' required but does not exist" url in
194     goal_failed msg
195   )
196 let goal_file_contains_string filename str =
197   if not (file_contains_string filename str) then (
198     let msg = sprintf "file_contains_string: file '%s' is required to contain string '%s'" filename str in
199     goal_failed msg
200   )
201 let goal_url_contains_string url str =
202   if not (url_contains_string url str) then (
203     let msg = sprintf "url_contains_string: URL '%s' is required to contain string '%s'" url str in
204     goal_failed msg
205   )
206 let goal_memory_exists k =
207   if not (memory_exists k) then (
208     let msg = sprintf "memory_exists: key '%s' required but does not exist" k in
209     goal_failed msg
210   )
211
212 (* Run the program. *)
213 let init () =
214   let prog = Sys.executable_name in
215   let prog = Filename.basename prog in
216
217   let args = ref [] in
218
219   let display_version () =
220     printf "%s %s\n" package_name package_version;
221     exit 0
222   in
223
224   let list_goals () =
225     let names = !published_goals in
226     let names = List.map fst names in
227     let names = List.sort compare names in
228     List.iter print_endline names
229   in
230
231   let argspec = Arg.align [
232     "--goals", Arg.Unit list_goals, " List all goals";
233     "-l", Arg.Unit list_goals, " List all goals";
234     "-V", Arg.Unit display_version, " Display version number and exit";
235     "--version", Arg.Unit display_version, " Display version number and exit";
236   ] in
237   let anon_fun str = args := str :: !args in
238   let usage_msg = sprintf "\
239 %s: a script generated by goaljobs
240
241 List all goals:                %s -l
242 Run a single goal like this:   %s <name-of-goal> [<goal-args ...>]
243
244 For more information see the goaljobs(1) man page.
245
246 Options:
247 " prog prog prog in
248
249   Arg.parse argspec anon_fun usage_msg;
250
251   let args = List.rev !args in
252
253   (* Was a goal named on the command line? *)
254   match args with
255   | name :: args ->
256     (match get_goal name with
257     | Some fn -> fn args
258     | None ->
259       eprintf "error: no goal called '%s' was found.\n" name;
260       eprintf "Use %s -l to list all published goals in this script.\n" name;
261       exit 1
262     )
263   | [] ->
264     (* Does a published 'all' goal exist? *)
265     match get_goal "all" with
266     | Some fn -> fn []
267     | None ->
268       (* No published 'all' goal.  This is only a warning, because
269        * other top-level code may exist in the script.
270        *)
271       eprintf "warning: no 'all' goal found.\n"