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
|
(*
Title: Standard Basis Library: Unix structure and signature.
Author: David Matthews
Copyright David Matthews 2000,2008
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.
This library 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
Lesser General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
signature UNIX =
sig
type ('a,'b) proc
type signal
datatype exit_status
= W_EXITED
| W_EXITSTATUS of Word8.word
| W_SIGNALED (* sic *) of signal
| W_STOPPED of signal
val fromStatus : OS.Process.status -> exit_status
val executeInEnv : string * string list * string list -> ('a, 'b) proc
val execute : string * string list -> ('a, 'b) proc
val textInstreamOf : (TextIO.instream, 'a) proc -> TextIO.instream
val binInstreamOf : (BinIO.instream, 'a) proc -> BinIO.instream
val textOutstreamOf : ('a, TextIO.outstream) proc -> TextIO.outstream
val binOutstreamOf : ('a, BinIO.outstream) proc -> BinIO.outstream
val streamsOf : (TextIO.instream, TextIO.outstream) proc
-> TextIO.instream * TextIO.outstream
val reap : ('a, 'b) proc -> OS.Process.status
val kill : ('a, 'b) proc * signal -> unit
val exit : Word8.word -> 'a
end;
structure Unix :>
sig
(* We have to copy the signature since we can't establish the
connection between exit_status and Posix.Process.exit_status
with a "where type". *)
type ('a,'b) proc
type signal = Posix.Signal.signal
datatype exit_status = datatype Posix.Process.exit_status
val fromStatus : OS.Process.status -> exit_status
val executeInEnv : string * string list * string list -> ('a, 'b) proc
val execute : string * string list -> ('a, 'b) proc
val textInstreamOf : (TextIO.instream, 'a) proc -> TextIO.instream
val binInstreamOf : (BinIO.instream, 'a) proc -> BinIO.instream
val textOutstreamOf : ('a, TextIO.outstream) proc -> TextIO.outstream
val binOutstreamOf : ('a, BinIO.outstream) proc -> BinIO.outstream
val streamsOf : (TextIO.instream, TextIO.outstream) proc
-> TextIO.instream * TextIO.outstream
val reap : ('a, 'b) proc -> OS.Process.status
val kill : ('a, 'b) proc * signal -> unit
val exit : Word8.word -> 'a
end =
struct
type ('a,'b) proc =
{ pid: Posix.Process.pid,
infd: Posix.IO.file_desc,
outfd: Posix.IO.file_desc,
(* We have to remember the result status. *)
result: OS.Process.status option ref
}
type signal = Posix.Signal.signal
datatype exit_status = datatype Posix.Process.exit_status
val fromStatus = Posix.Process.fromStatus
fun kill({pid, ... }: ('a, 'b) proc, signal) =
Posix.Process.kill(Posix.Process.K_PROC pid, signal)
(* Create a new process running a command and with pipes connecting the
standard input and output.
The command is supposed to be an executable and we should raise an
exception if it is not. Since the exece is only done in the child we
need to test whether we have an executable at the beginning.
The definition does not say whether the first of the user-supplied
arguments includes the command or not. Assume that only the "real"
arguments are provided and pass the last component of the command
name in the exece call. *)
fun executeInEnv (cmd, args, env) =
let
open Posix
(* Test first for presence of the file and then that we
have correct access rights. *)
val s = FileSys.stat cmd (* Raises SysErr if the file doesn't exist. *)
val () =
if not (FileSys.ST.isReg s) orelse not (FileSys.access(cmd, [FileSys.A_EXEC]))
then raise OS.SysErr(OS.errorMsg Error.acces, SOME Error.acces)
else ()
val toChild = IO.pipe()
and fromChild = IO.pipe()
in
case Process.fork() of
NONE => (* In the child *)
((
(* Should really clean up the signals here and
turn off timers. *)
(* Close the unwanted ends of the pipes and
set the required ends up as stdin and stdout. *)
IO.close(#outfd toChild);
IO.close(#infd fromChild);
IO.dup2{old= #infd toChild,
new=FileSys.wordToFD 0w0};
IO.dup2{old= #outfd fromChild,
new= FileSys.wordToFD 0w1};
IO.close(#infd toChild);
IO.close(#outfd fromChild);
(* Run the command. *)
Process.exece(cmd, OS.Path.file cmd :: args, env);
(* If we get here the exec must have failed -
terminate this process. We're supposed to
set the error code to 126 in this case. *)
Process.exit 0w126
) handle _ => Process.exit 0w126)
| SOME pid => (* In the parent *)
(
IO.close(#infd toChild);
IO.close(#outfd fromChild);
{pid=pid, infd= #infd fromChild, outfd= #outfd toChild, result = ref NONE}
)
end
fun execute (cmd, args) =
executeInEnv(cmd, args, Posix.ProcEnv.environ())
local (* Internal function to get the preferred buffer size. *)
val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral"
in
fun sys_get_buffsize (strm: OS.IO.iodesc): int = doIo(15, strm, 0)
end
fun textInstreamOf {infd, ...} =
let
val n = Posix.FileSys.fdToIOD infd
val textPrimRd =
LibraryIOSupport.wrapInFileDescr
{fd=n, name="TextPipeInput", initBlkMode=true}
val streamIo = TextIO.StreamIO.mkInstream(textPrimRd, "")
in
TextIO.mkInstream streamIo
end
fun textOutstreamOf {outfd, ...} =
let
val n = Posix.FileSys.fdToIOD outfd
val buffSize = sys_get_buffsize n
val textPrimWr =
LibraryIOSupport.wrapOutFileDescr{fd=n, name="TextPipeOutput",
appendMode=false, initBlkMode=true, chunkSize=buffSize}
(* Construct a stream. *)
val streamIo = TextIO.StreamIO.mkOutstream(textPrimWr, IO.LINE_BUF)
in
TextIO.mkOutstream streamIo
end
fun binInstreamOf {infd, ...} =
let
val n = Posix.FileSys.fdToIOD infd
val binPrimRd =
LibraryIOSupport.wrapBinInFileDescr{fd=n, name="BinPipeInput", initBlkMode=true}
val streamIo =
BinIO.StreamIO.mkInstream(binPrimRd, Word8Vector.fromList [])
in
BinIO.mkInstream streamIo
end
fun binOutstreamOf {outfd, ...} =
let
val n = Posix.FileSys.fdToIOD outfd
val buffSize = sys_get_buffsize n
val binPrimWr =
LibraryIOSupport.wrapBinOutFileDescr{fd=n, name="BinPipeOutput",
appendMode=false, chunkSize=buffSize, initBlkMode=true}
(* Construct a stream. *)
val streamIo = BinIO.StreamIO.mkOutstream(binPrimWr, IO.LINE_BUF)
in
BinIO.mkOutstream streamIo
end
fun streamsOf p = (textInstreamOf p, textOutstreamOf p)
(* Internal function - inverse of Posix.Process.fromStatus. *)
local
val doCall = RunCall.rtsCallFull2 "PolyOSSpecificGeneral"
in
fun toStatus W_EXITED: OS.Process.status = doCall(16, (1, 0))
| toStatus(W_EXITSTATUS w) = doCall(16, (1, Word8.toInt w))
| toStatus(W_SIGNALED s) =
doCall(16, (2, SysWord.toInt(Posix.Signal.toWord s)))
| toStatus(W_STOPPED s) =
doCall(16, (3, SysWord.toInt(Posix.Signal.toWord s)))
end
fun reap {result = ref(SOME r), ...} = r
| reap(p as {pid, infd, outfd, result}) =
let
val () = Posix.IO.close infd;
val () = Posix.IO.close outfd;
val (_, status) =
Posix.Process.waitpid(Posix.Process.W_CHILD pid, [])
in
(* If the process is only stopped we need to wait again. *)
case status of
W_STOPPED _ => reap p
| _ => let val s = toStatus status in result := SOME s; s end
end
fun exit w = OS.Process.exit(toStatus (W_EXITSTATUS w))
end;
|
