1(*
2    Title:      Standard Basis Library: Unix structure and signature.
3    Author:     David Matthews
4    Copyright   David Matthews 2000,2008
5
6    This library is free software; you can redistribute it and/or
7    modify it under the terms of the GNU Lesser General Public
8    License as published by the Free Software Foundation; either
9    version 2.1 of the License, or (at your option) any later version.
10    
11    This library is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
14    Lesser General Public License for more details.
15    
16    You should have received a copy of the GNU Lesser General Public
17    License along with this library; if not, write to the Free Software
18    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19*)
20
21signature UNIX =
22sig
23    type ('a,'b) proc
24    type signal
25    datatype exit_status
26       = W_EXITED
27       | W_EXITSTATUS of Word8.word
28       | W_SIGNALED (* sic *) of signal
29       | W_STOPPED of signal
30    val fromStatus : OS.Process.status -> exit_status
31    val executeInEnv : string * string list * string list -> ('a, 'b) proc
32    val execute : string * string list -> ('a, 'b) proc
33    val textInstreamOf : (TextIO.instream, 'a) proc  -> TextIO.instream
34    val binInstreamOf  : (BinIO.instream, 'a) proc -> BinIO.instream
35    val textOutstreamOf : ('a, TextIO.outstream) proc -> TextIO.outstream
36    val binOutstreamOf  : ('a, BinIO.outstream) proc -> BinIO.outstream
37    val streamsOf : (TextIO.instream, TextIO.outstream) proc
38                       -> TextIO.instream * TextIO.outstream
39    val reap : ('a, 'b) proc -> OS.Process.status
40    val kill : ('a, 'b) proc * signal -> unit
41    val exit : Word8.word -> 'a
42end;
43
44structure Unix :>
45    sig
46        (* We have to copy the signature since we can't establish the
47           connection between exit_status and Posix.Process.exit_status
48           with a "where type". *)
49        type ('a,'b) proc
50        type signal = Posix.Signal.signal
51        datatype exit_status = datatype Posix.Process.exit_status
52        val fromStatus : OS.Process.status -> exit_status
53        val executeInEnv : string * string list * string list -> ('a, 'b) proc
54        val execute : string * string list -> ('a, 'b) proc
55        val textInstreamOf : (TextIO.instream, 'a) proc  -> TextIO.instream
56        val binInstreamOf  : (BinIO.instream, 'a) proc -> BinIO.instream
57        val textOutstreamOf : ('a, TextIO.outstream) proc -> TextIO.outstream
58        val binOutstreamOf  : ('a, BinIO.outstream) proc -> BinIO.outstream
59        val streamsOf : (TextIO.instream, TextIO.outstream) proc
60                           -> TextIO.instream * TextIO.outstream
61        val reap : ('a, 'b) proc -> OS.Process.status
62        val kill : ('a, 'b) proc * signal -> unit
63        val exit : Word8.word -> 'a
64    end = 
65struct
66    type ('a,'b) proc =
67     { pid: Posix.Process.pid,
68       infd: Posix.IO.file_desc,
69       outfd: Posix.IO.file_desc,
70       (* We have to remember the result status. *)
71       result: OS.Process.status option ref
72     }
73    type signal = Posix.Signal.signal
74    datatype exit_status = datatype Posix.Process.exit_status
75
76    val fromStatus = Posix.Process.fromStatus
77
78    fun kill({pid, ... }: ('a, 'b) proc, signal) =
79        Posix.Process.kill(Posix.Process.K_PROC pid, signal)
80
81    (* Create a new process running a command and with pipes connecting the
82       standard input and output.
83       The command is supposed to be an executable and we should raise an
84       exception if it is not.  Since the exece is only done in the child we
85       need to test whether we have an executable at the beginning.
86       The definition does not say whether the first of the user-supplied
87       arguments includes the command or not.  Assume that only the "real"
88       arguments are provided and pass the last component of the command
89       name in the exece call. *)
90    fun executeInEnv (cmd, args, env) =
91    let
92        open Posix
93        (* Test first for presence of the file and then that we
94           have correct access rights. *)
95        val s = FileSys.stat cmd (* Raises SysErr if the file doesn't exist. *)
96        val () =
97           if not (FileSys.ST.isReg s) orelse not (FileSys.access(cmd, [FileSys.A_EXEC]))
98           then raise OS.SysErr(OS.errorMsg Error.acces, SOME Error.acces)
99           else ()
100        val toChild = IO.pipe()
101        and fromChild = IO.pipe()
102    in
103        case Process.fork() of
104            NONE => (* In the child *)
105            ((
106            (* Should really clean up the signals here and
107               turn off timers. *)
108            (* Close the unwanted ends of the pipes and
109               set the required ends up as stdin and stdout. *)
110            IO.close(#outfd toChild);
111            IO.close(#infd fromChild);
112            IO.dup2{old= #infd toChild,
113                      new=FileSys.wordToFD 0w0};
114            IO.dup2{old= #outfd fromChild,
115                      new= FileSys.wordToFD 0w1};
116            IO.close(#infd toChild);
117            IO.close(#outfd fromChild);
118            (* Run the command. *)
119            Process.exece(cmd, OS.Path.file cmd :: args, env);
120            (* If we get here the exec must have failed -
121               terminate this process.  We're supposed to
122               set the error code to 126 in this case. *)
123            Process.exit 0w126
124            ) handle _ => Process.exit 0w126)
125
126        |   SOME pid => (* In the parent *)
127            (
128            IO.close(#infd toChild);
129            IO.close(#outfd fromChild);
130            {pid=pid, infd= #infd fromChild, outfd= #outfd toChild, result = ref NONE}
131            )
132    end
133
134    fun execute (cmd, args) =
135        executeInEnv(cmd, args, Posix.ProcEnv.environ())
136
137    local (* Internal function to get the preferred buffer size. *)
138        val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral"
139    in
140        fun sys_get_buffsize (strm: OS.IO.iodesc): int = doIo(15, strm, 0)
141    end
142
143    fun textInstreamOf {infd, ...} =
144    let
145        val n = Posix.FileSys.fdToIOD infd
146        val textPrimRd =
147            LibraryIOSupport.wrapInFileDescr
148                {fd=n, name="TextPipeInput", initBlkMode=true}
149        val streamIo = TextIO.StreamIO.mkInstream(textPrimRd, "")
150    in
151        TextIO.mkInstream streamIo
152    end
153        
154    fun textOutstreamOf {outfd, ...} =
155    let
156        val n = Posix.FileSys.fdToIOD outfd
157        val buffSize = sys_get_buffsize n
158        val textPrimWr =
159            LibraryIOSupport.wrapOutFileDescr{fd=n, name="TextPipeOutput",
160                appendMode=false, initBlkMode=true, chunkSize=buffSize}
161        (* Construct a stream. *)
162        val streamIo = TextIO.StreamIO.mkOutstream(textPrimWr, IO.LINE_BUF)
163    in
164        TextIO.mkOutstream streamIo
165    end
166
167    fun binInstreamOf {infd, ...} =
168    let
169        val n = Posix.FileSys.fdToIOD infd
170        val binPrimRd =
171            LibraryIOSupport.wrapBinInFileDescr{fd=n, name="BinPipeInput", initBlkMode=true}
172        val streamIo =
173            BinIO.StreamIO.mkInstream(binPrimRd, Word8Vector.fromList [])
174    in
175        BinIO.mkInstream streamIo
176    end
177        
178    fun binOutstreamOf {outfd, ...} =
179    let
180        val n = Posix.FileSys.fdToIOD outfd
181        val buffSize = sys_get_buffsize n
182        val binPrimWr =
183            LibraryIOSupport.wrapBinOutFileDescr{fd=n, name="BinPipeOutput",
184                appendMode=false, chunkSize=buffSize, initBlkMode=true}
185        (* Construct a stream. *)
186        val streamIo = BinIO.StreamIO.mkOutstream(binPrimWr, IO.LINE_BUF)
187    in
188        BinIO.mkOutstream streamIo
189    end
190
191    fun streamsOf p = (textInstreamOf p, textOutstreamOf p)
192
193    (* Internal function - inverse of Posix.Process.fromStatus. *)
194    local
195        val doCall = RunCall.rtsCallFull2 "PolyOSSpecificGeneral"
196    in
197        fun toStatus W_EXITED: OS.Process.status = doCall(16, (1, 0))
198         |  toStatus(W_EXITSTATUS w) = doCall(16, (1, Word8.toInt w))
199         |  toStatus(W_SIGNALED s) =
200            doCall(16, (2, SysWord.toInt(Posix.Signal.toWord s)))
201         |  toStatus(W_STOPPED s) = 
202            doCall(16, (3, SysWord.toInt(Posix.Signal.toWord s)))
203    end
204
205    fun reap {result = ref(SOME r), ...} = r
206    |   reap(p as {pid, infd, outfd, result}) =
207    let
208        val () = Posix.IO.close infd;
209        val () = Posix.IO.close outfd;
210        val (_, status) =
211            Posix.Process.waitpid(Posix.Process.W_CHILD pid, [])
212    in
213        (* If the process is only stopped we need to wait again. *)
214        case status of
215            W_STOPPED _ => reap p
216        |   _ => let val s = toStatus status in result := SOME s; s end
217    end
218
219    fun exit w = OS.Process.exit(toStatus (W_EXITSTATUS w))
220end;
221