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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
type find_type =
| Files
| Dirs
type numerical_op =
| Gt
| Lt
| Eq
type string_op =
| Not_empty of string
| Equal of string * string
type condition =
| Exists of string
| Dir_exists of string
| Link_exists of string
| File_exists of string
| Is_not_root
| Writable_as_user of string
| And of condition * condition
| Not of condition
| Num_op of string * numerical_op * int
| Str_op of string_op
let (&&) c1 c2 = And (c1, c2)
type command =
| Continue
| Return of int
| Exit of int
| Echo of string
| Print_err of string
| Eval of string
| Eval_inplace of command
| Shift
| Assign of {var: string; value: string}
| Assign_eval of {var: string; command: command}
| Dirname of string
| Mkdir of {permissions: int option; dirs: string list}
| Chmod of {permissions: int; files: string list}
| Cp of {src: string; dst: string}
| Rm of {rec_: bool; files : string list}
| Symlink of {target: string; link: string}
| Set_permissions_in of
{on: find_type; permissions: int; starting_point: string}
| Copy_all_in of {src: string; dst: string; except: string}
| If of {condition : condition; then_ : command list; else_: command list}
| Prompt of {question: string; varname: string}
| Case of {varname: string; cases: case list}
| While of {condition: condition; while_: command list}
| Write_file of {file: string; lines : string list; append:bool}
| Read_file of {file: string; line_var: string; process_line: command list}
| Def_fun of {name: string; body : command list}
| Call_fun of {name: string; args: string list}
and case =
{ pattern : string
; commands : command list
}
type t = command list
let continue = Continue
let return i = Return i
let exit i = Exit i
let echof fmt = Format.kasprintf (fun s -> Echo s) fmt
let print_errf fmt = Format.kasprintf (fun s -> Print_err s) fmt
let eval s = Eval s
let shift = Shift
let assign ~var ~value = Assign {var; value}
let assign_eval var command = Assign_eval {var; command}
let dirname path = Dirname path
let mkdir ?permissions dirs = Mkdir {permissions; dirs}
let chmod permissions files = Chmod {permissions; files}
let cp ~src ~dst = Cp {src; dst}
let rm files = Rm {rec_ = false; files}
let rm_rf files = Rm {rec_ = true; files}
let symlink ~target ~link = Symlink {target; link}
let if_ condition then_ ?(else_=[]) () = If {condition; then_; else_}
let prompt ~question ~varname = Prompt {question; varname}
let case varname cases = Case {varname; cases}
let while_ condition while_ = While { condition; while_ }
let write_file ?(append=false) file lines = Write_file {file; lines; append}
let def_fun name body = Def_fun {name; body}
let call_fun name args = Call_fun {name; args}
let read_file ~line_var file process_line =
Read_file {file; line_var; process_line}
let set_permissions_in ~on ~permissions starting_point =
Set_permissions_in {on; permissions; starting_point}
let copy_all_in ~src ~dst ~except = Copy_all_in {src; dst; except}
let pp_sh_find_type fmtr ft =
match ft with
| Files -> Format.fprintf fmtr "f"
| Dirs -> Format.fprintf fmtr "d"
let pp_num_op = function
| Gt -> "gt"
| Lt -> "lt"
| Eq -> "eq"
let pp_str_op = function
| Not_empty s -> Printf.sprintf "-n \"%s\"" s
| Equal (s1, s2) -> Printf.sprintf "\"%s\" = \"%s\"" s1 s2
let rec pp_sh_condition fmtr condition =
match condition with
| Exists s -> Format.fprintf fmtr "[ -e %S ]" s
| Dir_exists s -> Format.fprintf fmtr "[ -d %S ]" s
| Link_exists s -> Format.fprintf fmtr "[ -L %S ]" s
| File_exists s -> Format.fprintf fmtr "[ -f %S ]" s
| Writable_as_user s -> Format.fprintf fmtr "[ -w %S ]" s
| Is_not_root -> Format.fprintf fmtr {|[ "$(id -u)" -ne 0 ]|}
| And (c1, c2) ->
Format.fprintf fmtr "%a && %a"
pp_sh_condition c1
pp_sh_condition c2
| Not (And _ as c) -> Format.fprintf fmtr "! (%a)" pp_sh_condition c
| Not c -> Format.fprintf fmtr "! %a" pp_sh_condition c
| Num_op (var, op, value) ->
Format.fprintf fmtr "[ $%s -%s %d ]" var (pp_num_op op) value
| Str_op s ->
Format.fprintf fmtr "[ %s ]" (pp_str_op s)
let rec pp_sh_command ?(newline=true) ~indent fmtr command =
let indent_str = String.make indent ' ' in
let fpf ?(indent=true) ?(newline=newline) fmt =
Format.fprintf fmtr ("%s" ^^ fmt ^^ (if newline then "\n" else ""))
(if indent then indent_str else "")
in
let pp_files = Fmt.(list ~sep:(const string " ") (using (fun x -> "\""^x^"\"") string)) in
match command with
| Continue -> fpf "continue"
| Return i -> fpf "return %d" i
| Exit i -> fpf "exit %d" i
| Echo s -> fpf "echo %S" s
| Print_err s -> fpf "printf '%%s\\n' %S >&2" s
| Eval s -> fpf "eval \"%s\"" s
| Eval_inplace command ->
fpf ~newline:false "$(";
pp_sh_command ~newline:false ~indent fmtr command;
fpf ~indent:false ")"
| Shift -> fpf "%s" "shift"
| Assign {var; value} -> fpf "%s=%S" var value
| Assign_eval {var; command} ->
fpf ~newline:false "%s=\"" var;
pp_sh_command ~newline:false ~indent:0 fmtr (Eval_inplace command);
fpf ~indent:false "\""
| Dirname s -> fpf "dirname %S" s
| Mkdir {permissions = None; dirs} -> fpf "mkdir -p %a" pp_files dirs
| Mkdir {permissions = Some perm; dirs} ->
fpf "mkdir -p -m %i %a" perm pp_files dirs
| Chmod {permissions; files} -> fpf "chmod %i %a" permissions pp_files files
| Cp {src; dst} -> fpf "cp %s %s" src dst
| Rm {rec_ = true; files} -> fpf "rm -rf %a" pp_files files
| Rm {rec_ = false; files} -> fpf "rm -f %a" pp_files files
| Symlink {target; link} -> fpf "ln -s %S %S" target link
| Set_permissions_in {on; permissions; starting_point} ->
fpf "find %s -type %a -exec chmod %i {} +"
starting_point
pp_sh_find_type on
permissions
| Copy_all_in {src; dst; except} ->
fpf
"find %s -mindepth 1 -maxdepth 1 ! -name '%s' -exec cp -rp {} %S \\;"
src except dst
| If {condition; then_; else_} ->
fpf "if %a; then" pp_sh_condition condition;
List.iter (pp_sh_command ~indent:(indent + 2) fmtr) then_;
(match else_ with
| [] -> ()
| _ ->
fpf "else";
List.iter (pp_sh_command ~indent:(indent + 2) fmtr) else_);
fpf "fi"
| Prompt {question; varname} ->
fpf {|printf "%s "|} question;
fpf {|read %s|} varname
| Case {varname; cases} ->
fpf {|case "$%s" in|} varname;
List.iter (pp_sh_case ~indent:(indent + 2) fmtr) cases;
fpf "esac"
| While {condition; while_} ->
fpf {|while %a; do|} pp_sh_condition condition;
List.iter (pp_sh_command ~indent:(indent + 2) fmtr) while_;
fpf "done"
| Write_file {file; lines; append} ->
fpf "{";
List.iter (fpf " printf '%%s\\n' \"%s\"") lines;
fpf "} %s \"%s\""
(if append then ">>" else ">") file
| Read_file {file; line_var; process_line} ->
fpf "while IFS= read -r %s || [ -n \"$%s\" ]; do" line_var line_var;
List.iter (pp_sh_command ~indent:(indent + 2) fmtr) process_line;
fpf "done < \"%s\"" file
| Def_fun {name; body} ->
fpf "%s() {" name;
List.iter (pp_sh_command ~indent:(indent + 2) fmtr) body;
fpf "}"
| Call_fun {name; args = []} ->
fpf "%s" name
| Call_fun {name; args} ->
fpf "%s %s" name (String.concat " " args)
and pp_sh_case ~indent fmtr {pattern; commands} =
let indent_str = String.make indent ' ' in
let fpf fmt = Format.fprintf fmtr ("%s" ^^ fmt ^^ "\n") indent_str in
match commands with
| [] -> fpf "%s) ;;" pattern
| _ ->
fpf "%s)" pattern;
List.iter (pp_sh_command ~indent:(indent + 2) fmtr) commands;
fpf ";;"
let pp_sh ~version fmtr t =
Format.fprintf fmtr "#!/usr/bin/env sh\n";
Format.fprintf fmtr "set -e\n";
if version then
Format.fprintf fmtr "# This script was generated by oui version %s%s\n"
Version.version
(match Version.commit_hash with
| None -> ""
| Some h -> ", commit "^h);
Format.fprintf fmtr "\n";
List.iter (pp_sh_command ~indent:0 fmtr) t
let save t file =
let file = OpamFilename.to_string file in
let out_ch = open_out file in
let formatter = Format.formatter_of_out_channel out_ch in
pp_sh ~version:true formatter t;
close_out out_ch