(* goaljobs * Copyright (C) 2013 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 Unix open Printf type goal_result_t = Goal_OK | Goal_failed of string exception Goal_result of goal_result_t let goal_failed msg = raise (Goal_result (Goal_failed msg)) let target v = if v then raise (Goal_result Goal_OK) let target_all vs = target (List.fold_left (&&) true vs) let target_exists vs = target (List.fold_left (||) false vs) let require () = () let file_exists = Sys.file_exists let file_newer_than f1 f2 = let stat f = try Some (stat f) with | Unix_error (ENOENT, _, _) -> None | Unix_error (err, _, _) -> let msg = sprintf "file_newer_than: %s: %s" f (error_message err) in goal_failed msg in let s1 = stat f1 and s2 = stat f2 in match s1 with | None -> false | Some s1 -> match s2 with | None -> let msg = sprintf "file_newer_than: %s: file does not exist" f2 in goal_failed msg | Some s2 -> s1.st_mtime >= s2.st_mtime let more_recent objs srcs = if not (List.for_all file_exists objs) then false else ( List.for_all ( fun obj -> List.for_all (file_newer_than obj) srcs ) objs ) let url_exists url = goal_failed "url_exists not implemented!" let sh fs = let do_sh cmd = let cmd = "set -e\nset -x\n\n" ^ cmd in let r = Sys.command cmd in if r <> 0 then ( let msg = sprintf "external command failed with code %d" r in goal_failed msg ) in ksprintf do_sh fs let do_shlines cmd = let cmd = "set -e\nset -x\n\n" ^ cmd in let chan = open_process_in cmd in let lines = ref [] in let rec loop () = let line = input_line chan in lines := line :: !lines; loop () in (try loop () with End_of_file -> ()); let r = close_process_in chan in match r with | WEXITED 0 -> List.rev !lines | WEXITED i -> let msg = sprintf "external command failed with code %d" i in goal_failed msg | WSIGNALED i -> let msg = sprintf "external command was killed by signal %d" i in goal_failed msg | WSTOPPED i -> let msg = sprintf "external command was stopped by signal %d" i in goal_failed msg let shlines fs = ksprintf do_shlines fs let do_shout cmd = let lines = do_shlines cmd in String.concat "\n" lines let shout fs = ksprintf do_shout fs (* val shell : string ref *) (* val replace_substring : string -> string -> string -> string *) let change_file_extension ext filename = let i = try String.rindex filename '.' with Not_found -> String.length filename in String.sub filename 0 i ^ "." ^ ext (* val filter_file_extension : string -> string list -> string *) (* XXX The Memory is not actually persistent yet. *) let memory = Hashtbl.create 13 let memory_exists = Hashtbl.mem memory let memory_set = Hashtbl.replace memory let memory_get k = try Some (Hashtbl.find memory k) with Not_found -> None let memory_delete = Hashtbl.remove memory let goal_file_exists filename = if not (file_exists filename) then ( let msg = sprintf "file '%s' required but not found" filename in goal_failed msg ) let goal_file_newer_than f1 f2 = if not (file_newer_than f1 f2) then ( let msg = sprintf "file %s is required to be newer than %s" f1 f2 in goal_failed msg ) let goal_more_recent objs srcs = if not (more_recent objs srcs) then ( let msg = sprintf "object(s) %s are required to be newer than source(s) %s" (String.concat " " objs) (String.concat " " srcs) in goal_failed msg ) let goal_url_exists url = if not (url_exists url) then ( let msg = sprintf "url_exists: URL '%s' required but does not exist" url in goal_failed msg ) let goal_memory_exists k = if not (memory_exists k) then ( let msg = sprintf "memory_exists: key '%s' required but does not exist" k in goal_failed msg )