tools: Specify format of disks (RHBZ#642934,CVE-2010-3851).
[libguestfs.git] / generator / generator_pr.ml
1 (* libguestfs
2  * Copyright (C) 2009-2010 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
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17  *)
18
19 (* Please read generator/README first. *)
20
21 open Unix
22 open Printf
23
24 open Generator_utils
25
26 (* 'pr' prints to the current output file. *)
27 let chan = ref Pervasives.stdout
28 let lines = ref 0
29 let pr fs =
30   ksprintf
31     (fun str ->
32        let i = count_chars '\n' str in
33        lines := !lines + i;
34        output_string !chan str
35     ) fs
36
37 let output_to filename k =
38   let filename_new = filename ^ ".new" in
39   chan := open_out filename_new;
40   k ();
41   close_out !chan;
42   chan := Pervasives.stdout;
43
44   (* Is the new file different from the current file? *)
45   if Sys.file_exists filename && files_equal filename filename_new then
46     unlink filename_new                 (* same, so skip it *)
47   else (
48     (* different, overwrite old one *)
49     (try chmod filename 0o644 with Unix_error _ -> ());
50     rename filename_new filename;
51     chmod filename 0o444;
52     printf "written %s\n%!" filename;
53   )
54
55 let get_lines_generated () =
56   !lines