1(*
2    Title:      Standard Basis Library: Unix structure and signature.
3    Author:     David Matthews
4    Copyright   David Matthews 2000,2008, 2019, 2020
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, new=Posix.FileSys.stdin};
113            IO.dup2{old= #outfd fromChild, new=Posix.FileSys.stdout};
114            IO.close(#infd toChild);
115            IO.close(#outfd fromChild);
116            (* Run the command. *)
117            Process.exece(cmd, OS.Path.file cmd :: args, env);
118            (* If we get here the exec must have failed -
119               terminate this process.  We're supposed to
120               set the error code to 126 in this case. *)
121            OS.Process.terminate(RunCall.unsafeCast 0w126)
122            ) handle _ => OS.Process.terminate(RunCall.unsafeCast 0w126)
123            )
124        |   SOME pid => (* In the parent *)
125            (
126            IO.close(#infd toChild);
127            IO.close(#outfd fromChild);
128            {pid=pid, infd= #infd fromChild, outfd= #outfd toChild, result = ref NONE}
129            )
130    end
131
132    fun execute (cmd, args) =
133        executeInEnv(cmd, args, Posix.ProcEnv.environ())
134
135    local (* Internal function to get the preferred buffer size. *)
136        val doIo = RunCall.rtsCallFull3 "PolyBasicIOGeneral"
137    in
138        fun sys_get_buffsize (strm: OS.IO.iodesc): int = doIo(15, strm, 0)
139    end
140
141    fun textInstreamOf {infd, ...} =
142    let
143        val n = Posix.FileSys.fdToIOD infd
144        val textPrimRd =
145            LibraryIOSupport.wrapInFileDescr
146                {fd=n, name="TextPipeInput", initBlkMode=true}
147        val streamIo = TextIO.StreamIO.mkInstream(textPrimRd, "")
148    in
149        TextIO.mkInstream streamIo
150    end
151        
152    fun textOutstreamOf {outfd, ...} =
153    let
154        val n = Posix.FileSys.fdToIOD outfd
155        val buffSize = sys_get_buffsize n
156        val textPrimWr =
157            LibraryIOSupport.wrapOutFileDescr{fd=n, name="TextPipeOutput",
158                appendMode=false, initBlkMode=true, chunkSize=buffSize}
159        (* Construct a stream. *)
160        val streamIo = TextIO.StreamIO.mkOutstream(textPrimWr, IO.LINE_BUF)
161    in
162        TextIO.mkOutstream streamIo
163    end
164
165    fun binInstreamOf {infd, ...} =
166    let
167        val n = Posix.FileSys.fdToIOD infd
168        val binPrimRd =
169            LibraryIOSupport.wrapBinInFileDescr{fd=n, name="BinPipeInput", initBlkMode=true}
170        val streamIo =
171            BinIO.StreamIO.mkInstream(binPrimRd, Word8Vector.fromList [])
172    in
173        BinIO.mkInstream streamIo
174    end
175        
176    fun binOutstreamOf {outfd, ...} =
177    let
178        val n = Posix.FileSys.fdToIOD outfd
179        val buffSize = sys_get_buffsize n
180        val binPrimWr =
181            LibraryIOSupport.wrapBinOutFileDescr{fd=n, name="BinPipeOutput",
182                appendMode=false, chunkSize=buffSize, initBlkMode=true}
183        (* Construct a stream. *)
184        val streamIo = BinIO.StreamIO.mkOutstream(binPrimWr, IO.LINE_BUF)
185    in
186        BinIO.mkOutstream streamIo
187    end
188
189    fun streamsOf p = (textInstreamOf p, textOutstreamOf p)
190
191    (* Internal function - inverse of Posix.Process.fromStatus. *)
192    local
193        val doCall = RunCall.rtsCallFull2 "PolyOSSpecificGeneral"
194    in
195        fun toStatus W_EXITED: OS.Process.status = doCall(16, (1, 0))
196         |  toStatus(W_EXITSTATUS w) = doCall(16, (1, Word8.toInt w))
197         |  toStatus(W_SIGNALED s) =
198            doCall(16, (2, SysWord.toInt(Posix.Signal.toWord s)))
199         |  toStatus(W_STOPPED s) = 
200            doCall(16, (3, SysWord.toInt(Posix.Signal.toWord s)))
201    end
202
203    fun reap {result = ref(SOME r), ...} = r
204    |   reap(p as {pid, infd, outfd, result}) =
205    let
206        val () = Posix.IO.close infd;
207        val () = Posix.IO.close outfd;
208        val (_, status) =
209            Posix.Process.waitpid(Posix.Process.W_CHILD pid, [])
210    in
211        (* If the process is only stopped we need to wait again. *)
212        case status of
213            W_STOPPED _ => reap p
214        |   _ => let val s = toStatus status in result := SOME s; s end
215    end
216
217    fun exit w = OS.Process.exit(toStatus (W_EXITSTATUS w))
218end;
219