1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
(****************************************************************************)
(* the diy toolsuite *)
(* *)
(* Jade Alglave, University College London, UK. *)
(* Luc Maranget, INRIA Paris-Rocquencourt, France. *)
(* *)
(* Copyright 2010-present Institut National de Recherche en Informatique et *)
(* en Automatique and the authors. All rights reserved. *)
(* *)
(* This software is governed by the CeCILL-B license under French law and *)
(* abiding by the rules of distribution of free software. You can use, *)
(* modify and/ or redistribute the software under the terms of the CeCILL-B *)
(* license as circulated by CEA, CNRS and INRIA at the following URL *)
(* "http://www.cecill.info". We also give a copy in LICENSE.txt. *)
(****************************************************************************)
(* Beware, this file is litmus/gen.new common, change with caution *)
open Printf
module type Option = sig
val verbose : int
(* Output name *)
val outname : string option
end
module type S = sig
(* Gives actual output name, ie add path to directory where the file is created *)
val outname : string -> string
(* Build archive or not *)
val is_archive : bool
(* Returns z if O.outname is *.tgz or empty string otherwise *)
val tarz : unit -> string
(* Produce final tar archive (and remove temporary directory) *)
val tar : unit -> unit
(* 'tar_dir dir' Similar, but archive contains top directory 'dir' *)
val tar_dir : (*dir*) string -> unit
end
module Make(O:Option) : S =
struct
type style = Dir | Tar | TarGz
let arg = match O.outname with
| None -> Filename.current_dir_name
| Some n -> n
let style =
if Filename.check_suffix arg ".tgz" then TarGz
else if Filename.check_suffix arg ".tar" then Tar
else Dir
let is_archive = match style with
| Dir -> false
| Tar|TarGz -> true
(* Limited system interface *)
let command cmd =
if O.verbose > 1 then begin
eprintf "Exec: %s -> %!" cmd
end ;
let r = Sys.command cmd in
if O.verbose > 1 then begin
eprintf "%i\n%!" r
end ;
r
let exec cmd = match command cmd with
| 0 -> ()
| _ -> Warn.fatal "Exec of '%s' failed" cmd
let rmdir name = exec (sprintf "/bin/rm -rf %s" name)
let mkdir name = exec (sprintf "/bin/rm -rf %s && mkdir %s" name name)
let direxists name = Sys.file_exists name && Sys.is_directory name
(************)
(* Let's go *)
(************)
let mk_temp_dir () =
let name = Filename.temp_file "dir" ".tmp" in
mkdir name ;
name
let out_dir = match style with
| Dir ->
if direxists arg then
arg
else
Warn.fatal "directory %s does not exist" arg
| Tar|TarGz -> mk_temp_dir ()
let outname name = Filename.concat out_dir name
let tarz () = match style with
| TarGz -> "z"
| Tar|Dir -> ""
let exec_tar2 dir1 dir2 tar =
let z = tarz () in
exec
(sprintf "( cd %s && tar c%sf - %s ) > %s" dir1 z dir2 tar)
let exec_tar dir tar = exec_tar2 dir "." tar
let tar () = match style with
| Tar|TarGz ->
let dir = out_dir in
exec_tar dir arg ;
rmdir dir
| Dir -> ()
let tar_dir dir =
let tar = arg in
let up = Filename.dirname dir
and name = Filename.basename dir in
exec_tar2 up name tar ;
rmdir up
end
|
