|
1 " |
|
2 COPYRIGHT (c) 1998 by eXept Software AG |
|
3 All Rights Reserved |
|
4 |
|
5 This software is furnished under a license and may be used |
|
6 only in accordance with the terms of that license and with the |
|
7 inclusion of the above copyright notice. This software may not |
|
8 be provided or otherwise made available to, or used by, any |
|
9 other person. No title to or ownership of the software is |
|
10 hereby transferred. |
|
11 " |
|
12 |
|
13 |
|
14 PipeStream subclass:#UnixPTYStream |
|
15 instanceVariableNames:'' |
|
16 classVariableNames:'' |
|
17 poolDictionaries:'' |
|
18 category:'OS-Unix' |
|
19 ! |
|
20 |
|
21 !UnixPTYStream class methodsFor:'documentation'! |
|
22 |
|
23 copyright |
|
24 " |
|
25 COPYRIGHT (c) 1998 by eXept Software AG |
|
26 All Rights Reserved |
|
27 |
|
28 This software is furnished under a license and may be used |
|
29 only in accordance with the terms of that license and with the |
|
30 inclusion of the above copyright notice. This software may not |
|
31 be provided or otherwise made available to, or used by, any |
|
32 other person. No title to or ownership of the software is |
|
33 hereby transferred. |
|
34 " |
|
35 |
|
36 ! |
|
37 |
|
38 documentation |
|
39 " |
|
40 These are much like PipeStreams, but allow bi-directional communication |
|
41 with a Unix command. (i.e. everything written to the PTYStream is seen |
|
42 by the commands standard-input, everything written by the command to its |
|
43 stdErr or stdOut can be read from me. |
|
44 |
|
45 In addition, sending control characters (such as INTR or QUIT), |
|
46 will be handled by the command as a signal (unless the command changed |
|
47 its standard input to raw mode). |
|
48 |
|
49 [author:] |
|
50 Claus Gittinger |
|
51 |
|
52 [see also:] |
|
53 TerminalView |
|
54 PipeStream ExternalStream FileStream Socket |
|
55 OperatingSystem |
|
56 " |
|
57 |
|
58 ! |
|
59 |
|
60 examples |
|
61 " |
|
62 that one is not special (could be done with a PipeStream): |
|
63 [exBegin] |
|
64 |pty| |
|
65 |
|
66 pty := UnixPTYStream to:'ls -l'. |
|
67 [pty atEnd] whileFalse:[ |
|
68 Transcript showCR:(pty nextLine). |
|
69 ]. |
|
70 pty close. |
|
71 [exEnd] |
|
72 [exBegin] |
|
73 |pty| |
|
74 |
|
75 pty := PipeStream readingFrom:'ls -l'. |
|
76 [pty atEnd] whileFalse:[ |
|
77 Transcript showCR:(pty nextLine). |
|
78 ]. |
|
79 pty close. |
|
80 [exEnd] |
|
81 [exBegin] |
|
82 |pty| |
|
83 |
|
84 pty := PipeStream readingFrom:'rsh ibm ls -l'. |
|
85 [pty atEnd] whileFalse:[ |
|
86 Transcript showCR:(pty nextLine). |
|
87 ]. |
|
88 pty close. |
|
89 [exEnd] |
|
90 |
|
91 but that one is (simulating an editor session): |
|
92 [exBegin] |
|
93 |pty| |
|
94 |
|
95 pty := UnixPTYStream to:'ed'. |
|
96 [ |
|
97 pty readWait. |
|
98 [pty atEnd] whileFalse:[ |
|
99 Transcript showCR:(pty nextLine). |
|
100 pty readWait. |
|
101 ]. |
|
102 pty close. |
|
103 ] forkAt:9. |
|
104 |
|
105 pty nextPutLine:'r Makefile'. |
|
106 pty nextPutLine:'1,2d'. |
|
107 pty nextPutLine:'$d'. |
|
108 pty nextPutLine:'w xxx'. |
|
109 pty nextPutLine:'q'. |
|
110 [exEnd] |
|
111 |
|
112 " |
|
113 ! ! |
|
114 |
|
115 !UnixPTYStream class methodsFor:'instance creation'! |
|
116 |
|
117 to:commandString |
|
118 "create and return a new ptyStream which can read/write to the unix command |
|
119 given by commandString." |
|
120 |
|
121 ^ (self basicNew) to:commandString |
|
122 |
|
123 "unix: |
|
124 UnixPTYStream to:'sh' |
|
125 " |
|
126 |
|
127 "Modified: / 9.7.1998 / 18:26:31 / cg" |
|
128 ! ! |
|
129 |
|
130 !UnixPTYStream class methodsFor:'blocked instance creation'! |
|
131 |
|
132 readingFrom:commandString |
|
133 ^ self shouldNotImplement |
|
134 |
|
135 "Created: / 9.7.1998 / 18:25:09 / cg" |
|
136 "Modified: / 9.7.1998 / 18:25:34 / cg" |
|
137 ! |
|
138 |
|
139 readingFrom:commandString errorDisposition:handleError inDirectory:aDirectory |
|
140 ^ self shouldNotImplement |
|
141 |
|
142 "Modified: / 9.7.1998 / 18:25:31 / cg" |
|
143 ! |
|
144 |
|
145 readingFrom:commandString inDirectory:aDirectory |
|
146 ^ self shouldNotImplement |
|
147 |
|
148 "Created: / 9.7.1998 / 18:25:38 / cg" |
|
149 ! |
|
150 |
|
151 writingTo:commandString |
|
152 ^ self shouldNotImplement |
|
153 |
|
154 "Created: / 9.7.1998 / 18:25:42 / cg" |
|
155 ! |
|
156 |
|
157 writingTo:commandString inDirectory:aDirectory |
|
158 ^ self shouldNotImplement |
|
159 |
|
160 "Created: / 9.7.1998 / 18:25:46 / cg" |
|
161 ! ! |
|
162 |
|
163 !UnixPTYStream methodsFor:'private'! |
|
164 |
|
165 openPTYFor:aCommandString withMode:mode inDirectory:aDirectrory |
|
166 "open a pty to the unix command in commandString" |
|
167 |
|
168 |blocked ptyFdArray execFdArray slaveFd masterFd shellAndArgs |
|
169 osType shellPath shellArgs closeFdArray mbx mbxName |
|
170 env shell args| |
|
171 |
|
172 filePointer notNil ifTrue:[ |
|
173 "the pipe was already open ... |
|
174 this should (can) not happen." |
|
175 ^ self errorOpen |
|
176 ]. |
|
177 |
|
178 lastErrorNumber := nil. |
|
179 exitStatus := nil. |
|
180 exitSema := Semaphore new name:'pty exitSema'. |
|
181 |
|
182 osType := OperatingSystem platformName. |
|
183 osType == #vms ifTrue:[ |
|
184 mbx := OperatingSystem createMailBox. |
|
185 mbx isNil ifTrue:[ |
|
186 lastErrorNumber := OperatingSystem currentErrorNumber. |
|
187 ^ self openError |
|
188 ]. |
|
189 mbxName := OperatingSystem mailBoxNameOf:mbx. |
|
190 "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR. |
|
191 |
|
192 shellPath := ''. |
|
193 shellArgs := aCommandString. |
|
194 |
|
195 execFdArray := Array with:mbx with:mbx with:mbx. |
|
196 closeFdArray := nil. |
|
197 ] ifFalse:[ |
|
198 ptyFdArray := OperatingSystem makePTYPair. |
|
199 ptyFdArray isNil ifTrue:[ |
|
200 lastErrorNumber := OperatingSystem currentErrorNumber. |
|
201 ^ self openError |
|
202 ]. |
|
203 |
|
204 shellAndArgs := OperatingSystem commandAndArgsForOSCommand:aCommandString. |
|
205 shellPath := shellAndArgs at:1. |
|
206 shellArgs := shellAndArgs at:2. |
|
207 |
|
208 masterFd := ptyFdArray at:1. |
|
209 slaveFd := ptyFdArray at:2. |
|
210 execFdArray := Array with:slaveFd with:slaveFd with:slaveFd. |
|
211 closeFdArray := Array with:masterFd. |
|
212 ]. |
|
213 |
|
214 env := Dictionary new. |
|
215 env at:'TERM' put:'dumb'. |
|
216 env at:'SHELL' put:shellPath. |
|
217 |
|
218 "/ must block here, to avoid races due to early finishing |
|
219 "/ subprocesses ... |
|
220 |
|
221 blocked := OperatingSystem blockInterrupts. |
|
222 |
|
223 pid := Processor |
|
224 monitor:[ |
|
225 OperatingSystem |
|
226 exec:shellPath |
|
227 withArguments:shellArgs |
|
228 environment:env |
|
229 fileDescriptors:execFdArray |
|
230 closeDescriptors:closeFdArray |
|
231 fork:true |
|
232 newPgrp:true |
|
233 "/ inDirectory:aDirectrory. |
|
234 ] |
|
235 action:[:status | |
|
236 status stillAlive ifFalse:[ |
|
237 exitStatus := status. |
|
238 OperatingSystem closePid:pid. |
|
239 pid := nil. |
|
240 exitSema signal. |
|
241 ]. |
|
242 ]. |
|
243 |
|
244 (osType ~~ #vms) ifTrue:[ |
|
245 OperatingSystem closeFd:slaveFd. |
|
246 ]. |
|
247 |
|
248 pid notNil ifTrue:[ |
|
249 (osType == #win32) ifTrue:[ |
|
250 self setFileDescriptor:masterFd mode:mode. |
|
251 "/ self setFileHandle:masterFd mode:mode |
|
252 ] ifFalse:[ |
|
253 (osType == #vms) ifTrue:[ |
|
254 "/ |
|
255 "/ reopen the mailbox as a file ... |
|
256 "/ |
|
257 mbxName := OperatingSystem mailBoxNameOf:mbx. |
|
258 mbxName notNil ifTrue:[ |
|
259 super open:mbxName withMode:mode |
|
260 ]. |
|
261 ] ifFalse:[ |
|
262 self setFileDescriptor:masterFd mode:mode. |
|
263 ] |
|
264 ] |
|
265 ] ifFalse:[ |
|
266 lastErrorNumber := OperatingSystem currentErrorNumber. |
|
267 osType == #vms ifTrue:[ |
|
268 OperatingSystem destroyMailBox:mbx |
|
269 ] ifFalse:[ |
|
270 OperatingSystem closeFd:masterFd. |
|
271 ]. |
|
272 ]. |
|
273 |
|
274 blocked ifFalse:[ |
|
275 OperatingSystem unblockInterrupts |
|
276 ]. |
|
277 |
|
278 lastErrorNumber notNil ifTrue:[ |
|
279 " |
|
280 the pipe open failed for some reason ... |
|
281 ... this may be either due to an invalid command string, |
|
282 or due to the system running out of memory (when forking |
|
283 the unix process) |
|
284 " |
|
285 ^ self openError |
|
286 ]. |
|
287 |
|
288 commandString := aCommandString. |
|
289 buffered := false. |
|
290 |
|
291 position := 1. |
|
292 hitEOF := false. |
|
293 binary := false. |
|
294 Lobby register:self. |
|
295 |
|
296 "Created: / 9.7.1998 / 20:21:42 / cg" |
|
297 "Modified: / 9.7.1998 / 20:28:31 / cg" |
|
298 ! |
|
299 |
|
300 to:command |
|
301 "setup the receiver to read/write to command" |
|
302 |
|
303 mode := #readwrite. didWrite := true. |
|
304 ^ self openPTYFor:command withMode:ReadWriteMode inDirectory:nil |
|
305 |
|
306 "Created: / 9.7.1998 / 18:27:40 / cg" |
|
307 "Modified: / 9.7.1998 / 20:22:39 / cg" |
|
308 ! ! |
|
309 |
|
310 !UnixPTYStream methodsFor:'testing'! |
|
311 |
|
312 atEnd |
|
313 ReadErrorSignal handle:[:ex | |
|
314 ex return |
|
315 ] do:[ |
|
316 ^ super atEnd. |
|
317 ]. |
|
318 ^ true |
|
319 |
|
320 "Created: / 9.7.1998 / 20:29:03 / cg" |
|
321 "Modified: / 9.7.1998 / 20:29:48 / cg" |
|
322 ! ! |
|
323 |
|
324 !UnixPTYStream class methodsFor:'documentation'! |
|
325 |
|
326 version |
|
327 ^ '$Header: /cvs/stx/stx/libbasic2/UnixPTYStream.st,v 1.1 1998-07-09 20:02:12 cg Exp $' |
|
328 ! ! |