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