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
(** *)
module XR = Xtmpl.Rewrite
module Xml = Xtmpl.Xml
type result = Ok of string | Error of string
let exec_command ?directory command =
let command = Stog_base.Misc.strip_string command in
let in_dir com = match directory with
| None -> com
| Some d -> Printf.sprintf "cd %s && %s" (Filename.quote d) com
in
let temp_file = Filename.temp_file "stogexec" ".txt" in
let com = Printf.sprintf "(%s) > %s 2>&1"
(in_dir command) (Filename.quote temp_file)
in
match Sys.command com with
0 ->
let output = Stog_base.Misc.string_of_file temp_file in
(try Sys.remove temp_file with _ -> ());
Ok output
| n ->
let output = Stog_base.Misc.string_of_file temp_file in
(try Sys.remove temp_file with _ -> ());
Error output
let concat_code =
let f b = function
XR.D code -> Buffer.add_string b code.Xml.text
| xml ->
failwith (Printf.sprintf "XML code in command: %s"
(XR.to_string [xml]))
in
fun xmls ->
let b = Buffer.create 256 in
List.iter (f b) xmls;
Buffer.contents b
let commands_of_xml xmls =
let f xml acc =
match xml with
XR.D _ | XR.C _ | XR.PI _ -> acc
| XR.E { XR.subs } -> (concat_code subs) :: acc
in
List.fold_right f xmls []
let concat_nl = Ocaml.concat_nl
let list_concat_nl = Ocaml.list_concat_nl
let fun_exec stog env ?loc args code =
try
let directory =
match XR.get_att_cdata args ("", "directory") with
None | Some "" -> None
| x -> x
in
let exc = XR.opt_att_cdata args ~def: "true" ("", "stop-on-error") = "true" in
let prompt =
match XR.get_att_cdata args ("", "prompt") with
None | Some "" -> None
| x -> x
in
let show_code = XR.opt_att_cdata args ~def: "true" ("", "show-code") <> "false" in
let show_stdout = XR.opt_att_cdata args
~def: (if prompt <> None then "true" else "false") ("", "show-stdout") <> "false"
in
let in_xml_block = XR.opt_att_cdata args ~def: "true" ("", "in-xml-block") <> "false" in
let id_opt = XR.opt_att_cdata args ("", "id") in
let atts = XR.atts_of_list
(match id_opt with "" -> [] | id -> [("","id"), [XR.cdata id]])
in
let list = XR.opt_att_cdata args ~def: "false" ("", "list") = "true" in
let commands =
if list
then commands_of_xml code
else [concat_code code]
in
let rec iter acc = function
[] -> List.rev acc
| command :: q ->
let lang_file =
let d = stog.Types.stog_dir in
Filename.concat d "sh.lang"
in
let opts = if Sys.file_exists lang_file then
Some (Printf.sprintf "--config-file=%s" lang_file)
else
None
in
let code =
if show_code then
Highlight.highlight ~lang: "sh" ?opts command
else
[XR.cdata ""]
in
let (output, error) =
match exec_command ?directory command with
Ok output -> (output, false)
| Error output -> (output, true)
in
if error && exc then
begin
let msg = Xtmpl.Xml.loc_sprintf loc
"Exec error with command:\n%s\n%s"
command output
in
failwith msg
end;
let acc =
let code =
if in_xml_block then
begin
let code =
match prompt with
None -> code
| Some str -> (Xtmpl.Xhtml.span ~classes: ["command-prompt"] [XR.cdata str]) :: code
in
[ XR.node ("","span") code ]
end
else
code
in
match output with
"" -> list_concat_nl code acc
| _ ->
let classes = Printf.sprintf "command-output%s"
(if error then " command-error" else "")
in
let xml =
XR.node ("","span")
~atts: (XR.atts_one ("","class") [XR.cdata classes])
[XR.cdata output]
in
list_concat_nl (concat_nl xml code) acc
in
iter acc q
in
let xml = iter [] commands in
if show_code || show_stdout then
let xml =
if in_xml_block then
[ XR.node ("","pre")
~atts: (XR.atts_of_list ~atts [("","class"), [XR.cdata "command-exec"]])
xml
]
else
xml
in
(stog, xml)
else
(stog, [ XR.cdata "" ])
with
e ->
raise e
;;