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