SystemOrganization addCategory: #'OSProcess-Base'! SystemOrganization addCategory: #'OSProcess-Mac'! SystemOrganization addCategory: #'OSProcess-OS2'! SystemOrganization addCategory: #'OSProcess-RiscOS'! SystemOrganization addCategory: #'OSProcess-Unix'! SystemOrganization addCategory: #'OSProcess-Win32'! SystemOrganization addCategory: #'OSProcess-AIO'! Model subclass: #AioEventHandler instanceVariableNames: 'semaphore semaIndex handlerProc descriptor' classVariableNames: 'AioPluginPresent' poolDictionaries: '' category: 'OSProcess-AIO'! !AioEventHandler commentStamp: 'dtl 11/25/2006 15:55' prior: 0! AioEventHandler responds to external IO events, such as data available on a file descriptor. When an external IO event is received, an instance of AioEventHandler sends #changed to itself to notify its dependents that the event has occurred.! !AioEventHandler class methodsFor: 'testing' stamp: 'dtl 11/25/2006 10:00'! aioPluginPresent "Answer true if an AIO plugin is available. The value of AioPluginPresent is cleared at startup time, and is reestablished once for each Squeak session." "AioEventHandler aioPluginPresent" ^ AioPluginPresent ifNil: [AioPluginPresent := self basicNew primAioModuleVersionString notNil. AioPluginPresent ifFalse: [self inform: 'AioPlugin not present, AioEventHandler will use polling input']. ^ AioPluginPresent]! ! !AioEventHandler class methodsFor: 'instance creation' stamp: 'dtl 7/5/2003 09:16'! for: aSocketOrFileStream "self for: SourceFiles first" "self for: Socket new" "self for: OSProcess thisOSProcess stdIn" ^ self new for: aSocketOrFileStream! ! !AioEventHandler class methodsFor: 'instance creation' stamp: 'dtl 7/5/2003 11:14'! for: aSocketOrFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag "Flag parameters are true or false, indicating types of events to be handled." ^ self new for: aSocketOrFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag! ! !AioEventHandler class methodsFor: 'instance creation' stamp: 'dtl 7/4/2003 18:47'! forFileStream: aFileStream "self forFileStream: SourceFiles first" ^ self new forFileStream: aFileStream ! ! !AioEventHandler class methodsFor: 'instance creation' stamp: 'dtl 7/5/2003 11:14'! forFileStream: aFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag "Flag parameters are true or false, indicating types of events to be handled." "self forFileStream: SourceFiles first" ^ self new forFileStream: aFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag ! ! !AioEventHandler class methodsFor: 'instance creation' stamp: 'dtl 7/4/2003 19:01'! forSocket: aSocket "self forSocket: Socket new" ^ self new forSocket: aSocket ! ! !AioEventHandler class methodsFor: 'instance creation' stamp: 'dtl 7/5/2003 11:14'! forSocket: aSocket exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag "Flag parameters are true or false, indicating types of events to be handled." "self forSocket: Socket new" ^ self new forSocket: aSocket exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag ! ! !AioEventHandler class methodsFor: 'system startup' stamp: 'dtl 11/25/2006 10:04'! startUp: resuming "Clear the value of AioPluginPresent. The value will be set once when #aioPluginPresent is first sent, and will remain set to that value for the duration of this Squeak session. This method is called by ThisOSProcess>>startUp. AioEventHandler does not need to be registered in the system startup list." resuming ifTrue: [AioPluginPresent := nil] ! ! !AioEventHandler methodsFor: 'aio event forwarding' stamp: 'dtl 7/4/2003 19:10'! aioDisable: ioDescriptor "Definitively disable asynchronous event notification for a descriptor. The ioDescriptor parameter is an object representing a low level OS file or socket descriptor." ^ self primAioDisable: ioDescriptor ! ! !AioEventHandler methodsFor: 'aio event forwarding' stamp: 'dtl 9/1/2003 16:58'! aioEnable: ioDescriptor forSemaphore: semaphoreIndex externalObject: trueOrFalse "Enable asynchronous notification for a descriptor. Send this message one time prior to beginning event handling for ioDescriptor. The ioDescriptor parameter is an object representing a low level OS file or socket descriptor. The semaphoreIndex is the index of a Semaphore to be notified, and the third parameter is a flag indicating that ioDescriptor represents an external object which should not be closed on termination of aio handling." ^ (self primAioEnable: ioDescriptor forSemaphore: semaphoreIndex externalObject: trueOrFalse) ifNil: [self notify: 'aio event forwarding not supported'] ! ! !AioEventHandler methodsFor: 'aio event forwarding' stamp: 'dtl 7/4/2003 18:52'! aioHandle: ioDescriptor exceptionEvents: exceptionFlag readEvents: readFlag writeEvents: writeFlag "Enable asynchronous notification for a descriptor. Send this message one time to enable a single event notification. Send it again after each event has been received and handled (in other words, the process which waits on the event semaphore is responsible for re-enabling the handler by calling this method each time an event is handled). The ioDescriptor parameter is an object representing a low level OS file or socket descriptor. The remaining three parameters are Boolean flags representing the types of events for which notification is being requested: handle exceptions, handle for read, and handle for write. It is common to watch for read events and exception events, or to watch for write events and exception events." ^ self primAioHandle: ioDescriptor exceptionEvents: exceptionFlag readEvents: readFlag writeEvents: writeFlag ! ! !AioEventHandler methodsFor: 'aio event forwarding' stamp: 'dtl 7/4/2003 19:10'! aioSuspend: ioDescriptor exceptionEvents: exceptionFlag readEvents: readFlag writeEvents: writeFlag "Temporarily suspend asynchronous event notification for a descriptor. The ioDescriptor parameter is an object representing a low level OS file or socket descriptor. The remaining three parameters are Boolean flags representing the types of events for which notification is being requested: handle exceptions, handle for read, and handle for write." ^ self primAioSuspend: ioDescriptor exceptionEvents: exceptionFlag readEvents: readFlag writeEvents: writeFlag ! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 8/20/2006 18:43'! close "When the FileStream or Socket handled by this aio handler is closed, it should send #close to this handler." | p | self breakDependents. Smalltalk unregisterExternalObject: semaphore. self aioDisable: self descriptor. semaphore := nil. semaIndex := nil. p := handlerProc. handlerProc := nil. p ifNotNil: [p terminate] "p may be the active process, do this last" ! ! !AioEventHandler methodsFor: 'handler process' stamp: 'dtl 7/5/2003 10:50'! defaultHandlerProcess "Generate a #changed notification whenever an external aio event occurs" ^ self handleReadAndExceptionsEvents! ! !AioEventHandler methodsFor: 'accessing' stamp: 'dtl 3/30/2003 19:05'! descriptor ^ descriptor! ! !AioEventHandler methodsFor: 'accessing' stamp: 'dtl 3/30/2003 19:05'! descriptor: aLowLevelIODescriptor descriptor := aLowLevelIODescriptor! ! !AioEventHandler methodsFor: 'finalization' stamp: 'dtl 9/4/2003 06:54'! finalize "Note: An aio handler will not be garbage collected until the semaphore is unregistered. When the FileStream or Socket handled by this aio handler is closed, it should send #close to this handler." self close ! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/5/2003 09:15'! for: aSocketOrFileStream "Answer an event handler for any kind of IO stream that can be associated with an OS handle for aio events. Currently, subclasses of FileStream and Socket can have aio event handlers." (aSocketOrFileStream isKindOf: Socket) ifTrue: [^ self forSocket: aSocketOrFileStream]. (aSocketOrFileStream isKindOf: FileStream) ifTrue: [^ self forFileStream: aSocketOrFileStream]. self error: 'expected a FileStream or Socket subclass'! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/5/2003 11:03'! for: aSocketOrFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag "Answer an event handler for any kind of IO stream that can be associated with an OS handle for aio events. Currently, subclasses of FileStream and Socket can have aio event handlers." (aSocketOrFileStream isKindOf: Socket) ifTrue: [^ self forSocket: aSocketOrFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag]. (aSocketOrFileStream isKindOf: FileStream) ifTrue: [^ self forFileStream: aSocketOrFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag]. self error: 'expected a FileStream or Socket subclass'! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/9/2005 14:00'! forFileStream: aFileStream self descriptor: (self handleForFile: aFileStream). self setDefaultEventMask. ! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/5/2003 11:01'! forFileStream: aFileStream exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag self descriptor: (self handleForFile: aFileStream). self initializeForExceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag ! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/9/2005 14:00'! forSocket: aSocket "Any existing event handling for aSocket will be disabled. Note that this will make the socket useless for any applications that expect the prior event handling behavior." self descriptor: (self handleForSocket: aSocket). self aioDisable: self descriptor. self setDefaultEventMask. ! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/5/2003 12:46'! forSocket: aSocket exceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag "Any existing event handling for aSocket will be disabled. Note that this will make the socket useless for any applications that expect the prior event handling behavior." self descriptor: (self handleForSocket: aSocket). self aioDisable: self descriptor. self initializeForExceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag ! ! !AioEventHandler methodsFor: 'handler process' stamp: 'dtl 2/11/2007 11:57'! handleExceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag "Generate a #changed notification whenever the requested type of external aio event occurs." ^ [[self hasValidHandler] whileTrue: [self aioHandle: self descriptor exceptionEvents: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag. self semaphore wait. self changed]] forkAt: Processor userBackgroundPriority! ! !AioEventHandler methodsFor: 'private' stamp: 'dtl 9/4/2003 06:40'! handleForFile: aFileStream "self new handleForFile: SourceFiles first" | ioHandle | ioHandle := self useIOHandle ifTrue: [aFileStream ioHandle] ifFalse: [aFileStream fileID]. ^ self primOSFileHandle: ioHandle ! ! !AioEventHandler methodsFor: 'private' stamp: 'dtl 7/4/2003 15:16'! handleForSocket: aSocket "self new handleForSocket: Socket newTCP" | ioHandle | ioHandle := self useIOHandle ifTrue: [aSocket ioHandle] ifFalse: [aSocket socketHandle]. ^ self primOSSocketHandle: ioHandle ! ! !AioEventHandler methodsFor: 'handler process' stamp: 'dtl 7/5/2003 10:49'! handleReadAndExceptionsEvents "Generate a #changed notification whenever data is available for reading or an exception occurs on the external IO channel." ^ self handleExceptions: true readEvents: true writeEvents: false ! ! !AioEventHandler methodsFor: 'handler process' stamp: 'dtl 7/5/2003 10:49'! handleReadEvents "Generate a #changed notification whenever data is available for reading" ^ self handleExceptions: false readEvents: true writeEvents: false ! ! !AioEventHandler methodsFor: 'accessing' stamp: 'dtl 3/30/2003 19:04'! handlerProc ^ handlerProc! ! !AioEventHandler methodsFor: 'handler process' stamp: 'dtl 7/6/2003 10:24'! hasValidHandler "True if the event handler is running, and if it refers to the correct external object semaphore. For protection following an image restart." ^ semaIndex notNil and: [(Smalltalk externalObjects at: semaIndex) == semaphore]! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 9/1/2003 17:09'! initializeForExceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag semaphore := Semaphore new. semaIndex := Smalltalk registerExternalObject: semaphore. ([self aioEnable: self descriptor forSemaphore: self semaIndex externalObject: true] on: Warning do: [:e | self close. "unregister the semaphore" self notify: e messageText. nil]) ifNotNilDo: [:h | handlerProc := self handleExceptions: exceptionEventFlag readEvents: readEventFlag writeEvents: writeEventFlag] ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:53'! primAioDisable: aDescriptor "Definitively disable asynchronous event notification for a descriptor. The descriptor parameter is an object representing a low level OS file or socket descriptor." ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:53'! primAioEnable: aDescriptor forSemaphore: semaphoreIndex externalObject: trueOrFalse "Enable asynchronous notification for a descriptor. The descriptor parameter is an object representing a low level OS file or socket descriptor. The semaphoreIndex is the index of a Semaphore to be notified, and the third parameter is a flag indicating that descriptor represents an external object which should not be closed on termination of aio handling." ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:53'! primAioHandle: aDescriptor exceptionEvents: exceptionFlag readEvents: readFlag writeEvents: writeFlag "Enable asynchronous notification for a descriptor. The descriptor parameter is an object representing a low level OS file or socket descriptor. The second parameter is the index of a Semaphore to be notified, the remaining three parameters are Boolean flags representing the types of events for which notification is being requested: handle exceptions, handle for read, and handle for write. It is common to watch for read events and exception events, or to watch for write events and exception events." ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:26'! primAioModuleName "Module name of the installed plugin, if any." "self new primAioModuleName" ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:28'! primAioModuleVersionString "Module name of the installed plugin, if any." "self new primAioModuleVersionString" ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:54'! primAioSuspend: aDescriptor exceptionEvents: exceptionFlag readEvents: readFlag writeEvents: writeFlag "Temporarily suspend asynchronous event notification for a descriptor. The descriptor parameter is an object representing a low level OS file or socket descriptor. The remaining three parameters are Boolean flags representing the types of events for which notification is being requested: handle exceptions, handle for read, and handle for write." ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:54'! primOSFileHandle: sqFile "Answer the low level file descriptor for a file IO handle." ^ nil ! ! !AioEventHandler methodsFor: 'primitive access' stamp: 'dtl 9/1/2003 17:54'! primOSSocketHandle: sqFile "Answer the low level socket descriptor for a socket IO handle." ^ nil ! ! !AioEventHandler methodsFor: 'accessing' stamp: 'dtl 3/30/2003 19:04'! semaIndex ^ semaIndex! ! !AioEventHandler methodsFor: 'accessing' stamp: 'dtl 3/30/2003 19:04'! semaphore ^ semaphore! ! !AioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 7/9/2005 14:00'! setDefaultEventMask "Default initialization for read events and exception events" ^ self initializeForExceptions: true readEvents: true writeEvents: false ! ! !AioEventHandler methodsFor: 'private' stamp: 'dtl 3/30/2003 19:26'! useIOHandle ^ Smalltalk hasClassNamed: #IOHandle! ! Model subclass: #OSProcessAccessor instanceVariableNames: 'sessionIdentifier canObtainSessionIdentifierFromPlugin hasTestEof' classVariableNames: 'EmulateWin32FileLocking FileLockRegistry ThisOSProcessAccessor UseIOHandle' poolDictionaries: '' category: 'OSProcess-Base'! !OSProcessAccessor commentStamp: '' prior: 0! I am an abstract class whose subclasses provide access to an operating system process, such as the process in which the Squeak VM is currently running. My subclasses collaborate with instances of OSProcess subclasses.! OSProcessAccessor subclass: #MacOSProcessAccessor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Mac'! !MacOSProcessAccessor commentStamp: '' prior: 0! I provide access to an operating system process, such as the process in which the Squeak VM is currently running. I am based on the Macintosh process model.! !MacOSProcessAccessor class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:44'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ OSProcess isNonUnixMac ! ! !MacOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/23/2002 05:57'! primGetSession "Answer the unique identifier for this session of Smalltalk running in this OS Process." ^ nil ! ! OSProcessAccessor subclass: #OS2OSProcessAccessor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-OS2'! !OS2OSProcessAccessor commentStamp: '' prior: 0! I provide access to an operating system process, such as the process in which the Squeak VM is currently running. I am based on the OS2 process model.! !OS2OSProcessAccessor class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:47'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ OSProcess isOS2 ! ! !OS2OSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/23/2002 05:56'! primGetSession "Answer the unique identifier for this session of Smalltalk running in this OS Process." ^ nil ! ! !OSProcessAccessor class methodsFor: 'concrete subclasses' stamp: 'dtl 3/5/2005 12:04'! concreteClass "OSProcessAccessor concreteClass" ^ self subclasses detect: [:c | c isResponsibleForThisPlatform] ifNone: [self notify: self printString, ': No concrete class implementation available for system type ', OSProcess platformName printString. nil] ! ! !OSProcessAccessor class methodsFor: 'initialize-release' stamp: 'dtl 3/5/2005 13:24'! emulateWin32FileLocking: trueOrFalse "This is a preference that controls whether file locking will attempt to emulation Win32 behavior, in which a lock request will fail if the requested region overlaps a region for which there is an existing lock. This behavior is valid only for locks managed within a single Squeak image, and will not produce the expected results for a Squeak image cooperating with another Squeak image, or with some other external program. Use of the Win32 emulation may result in performance penalties for an application that performs a large number of lock requests, such as a database." "self emulateWin32FileLocking: true" "self emulateWin32FileLocking: false" EmulateWin32FileLocking := trueOrFalse ! ! !OSProcessAccessor class methodsFor: 'instance creation' stamp: 'dtl 2/26/2002 08:15'! forThisOSProcess "Answer a single instance corresponding to the OS process in which this Smalltalk image is executing." "OSProcessAccessor forThisOSProcess" | oldAccessor | (ThisOSProcessAccessor notNil and: [ThisOSProcessAccessor isResponsibleForThisPlatform]) ifTrue: [^ ThisOSProcessAccessor] ifFalse: ["We are running on a different platform, so start a new accessor" oldAccessor := ThisOSProcessAccessor. oldAccessor changed: #invalidProcessAccessor. oldAccessor release; finalize. ^ ThisOSProcessAccessor := self concreteClass basicNew initialize] ! ! !OSProcessAccessor class methodsFor: 'initialize-release' stamp: 'dtl 12/27/2005 10:59'! initialize "OSProcessAccessor initialize" UseIOHandle := (Smalltalk hasClassNamed: #IOHandle). ThisOSProcessAccessor := nil. self emulateWin32FileLocking: false. self allSubInstances do: [:e | e finalize; release] ! ! !OSProcessAccessor class methodsFor: 'platform identification' stamp: 'dtl 8/24/2003 09:17'! isResponsibleForThisPlatform "Answer true if an instance of this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ self subclassResponsibility! ! !OSProcessAccessor class methodsFor: 'instance creation' stamp: 'dtl 3/2/2002 08:29'! new self inform: 'use OSProcessAccessor>>forThisOSProcess to create or obtain the OSProcess instance for this Smalltalk session.'. ^ nil! ! !OSProcessAccessor class methodsFor: 'system startup' stamp: 'dtl 3/5/2005 13:16'! startUp: resuming "Initialize my singleton instance. On Unix, set its signal handler to respond to externally generated sigchld signals. This must be done after each image restart in order to call a primitive which informs the VM of the identity of the semaphore to signal. When not running on a Unix system, the primitive fails and this method has no effect. Notify dependents of the singleton instance if the image has restarted in a different OS process (this is not the case when #startUp is called after a simple image save). The notification is done in the instance initialization. This method is called by ThisOSProcess>>startUp. OSProcessAccessor does not need to be registered in the system startup list." resuming ifTrue: [FileLockRegistry := nil]. ThisOSProcessAccessor ifNotNil: [ThisOSProcessAccessor changed: #invalidProcessAccessor; release; finalize. ThisOSProcessAccessor := nil]. self forThisOSProcess initialize ! ! !OSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:41'! aioModuleName "Answer a string containing the module name string for the AIO plugin." "OSProcess accessor aioModuleName" ^ self subclassResponsibility! ! !OSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:41'! aioVersionString "Answer a string containing the version string for the AIO plugin." "OSProcess accessor aioVersionString" ^ self subclassResponsibility! ! !OSProcessAccessor methodsFor: 'testing' stamp: 'dtl 10/18/2001 22:58'! canAccessSystem "Answer true if it is possible to access the external process. Concrete subclasses should know how to answer true." ^ false ! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 4/9/2005 22:44'! canAcquireLock: anOSFileLockDescriptor "Answer true if the file lock cache will permit fileLock to be acquired. This method does not guarantee that the underlying OS will grant the lock." ^ (self fileLockRegistry anySatisfy: [:ld | ld isActive and: [ld conflictsWith: anOSFileLockDescriptor]]) not! ! !OSProcessAccessor methodsFor: 'testing' stamp: 'dtl 2/14/2004 11:43'! canForwardExternalSignals "Answer true if it is possible to forward OS signals to a Smalltalk Semaphore." ^ false ! ! !OSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 4/7/2007 10:19'! canObtainSessionIdentifierFromPlugin ^ canObtainSessionIdentifierFromPlugin ifNil: [canObtainSessionIdentifierFromPlugin := self primGetSession notNil]! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 3/5/2005 13:21'! emulateWin32FileLocking "Answer the current value of this preference" ^ EmulateWin32FileLocking! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 3/5/2005 13:04'! fileLockRegistry ^ FileLockRegistry ifNil: [FileLockRegistry := WeakSet new] ! ! !OSProcessAccessor methodsFor: 'session identification' stamp: 'dtl 8/6/2003 21:39'! getSessionIdentifier "Call a primitive to obtain the unique identifier for this Squeak session. If the primitive fails, try to deduce the session identifier from an instance of StandardFileStream. Some versions of the OSProcessPlugin may not be able to obtain a session ID, so this provides a mechanism for obtaining the session ID indirectly if necessary." "OSProcess accessor getSessionIdentifier" | session | session := self primGetSession. session ifNil: [session := self getSessionIdentifierFromSourcesFile]. session ifNil: [session := self getSessionIdentifierFromFileInSqueakDirectory]. ^ session ! ! !OSProcessAccessor methodsFor: 'session identification' stamp: 'dtl 8/7/2005 22:03'! getSessionIdentifierFromFileInSqueakDirectory "Deduce the session identifier using method of last resort. This is an unreliable method, because it assumes knowledge of the internal structure of the SQFile data structure. Deprecated: As of approximately Squeak 3.8 and beyond, the session id has been moved to the first slot of the data structure. This method will not work for a Squeak VM beyond that point, and will not work for any 64 bit VM. However, an reliable means of obtaining sessionID is now available (#getSessionIdentifier), so this method is retained only for backwards compatibility to allow OSPP to be built on an older VMMaker." "OSProcess accessor getSessionIdentifierFromFileInSqueakDirectory" | id | FileDirectory default fileNames do: [:n | (FileStream readOnlyFileNamed: n) ifNotNilDo: [:s | (Smalltalk hasClassNamed: #IOHandle) ifTrue: [id := s ioHandle getHandle copyFrom: 5 to: 8] ifFalse: [id := (id := s fileID) ifNotNil: [id copyFrom: 5 to: 8]]. s close. ^ id]]. ^ nil ! ! !OSProcessAccessor methodsFor: 'session identification' stamp: 'dtl 8/7/2005 22:02'! getSessionIdentifierFromSourcesFile "Deduce the session identifier from an existing open FileStream on the sources file. This is an unreliable method, because it assumes knowledge of the internal structure of the SQFile data structure. Deprecated: As of approximately Squeak 3.8 and beyond, the session id has been moved to the first slot of the data structure. This method will not work for a Squeak VM beyond that point, and will not work for any 64 bit VM. However, an reliable means of obtaining sessionID is now available (#getSessionIdentifier), so this method is retained only for backwards compatibility to allow OSPP to be built on an older VMMaker." "OSProcess accessor getSessionIdentifierFromSourcesFile" | s id | s := SourceFiles first. s ifNil: [^ nil]. ^ (Smalltalk hasClassNamed: #IOHandle) ifTrue: [s ioHandle getHandle copyFrom: 5 to: 8] ifFalse: [(id := s fileID) ifNotNil: [id copyFrom: 5 to: 8]] ! ! !OSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:07'! getStdErrHandle "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." ^ self subclassResponsibility ! ! !OSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:07'! getStdInHandle "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." ^ self subclassResponsibility ! ! !OSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:06'! getStdOutHandle "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." ^ self subclassResponsibility ! ! !OSProcessAccessor methodsFor: 'private - IOHandle' stamp: 'dtl 3/1/2002 15:19'! handleFromAccessor: aByteArrayOrIOAccessor UseIOHandle ifTrue: [aByteArrayOrIOAccessor isNil ifTrue: [^ nil] ifFalse: [^ aByteArrayOrIOAccessor asSQFileStruct]] ifFalse: [^ aByteArrayOrIOAccessor]! ! !OSProcessAccessor methodsFor: 'private - IOHandle' stamp: 'dtl 1/3/2004 21:21'! handleFromFileStream: aFileStream ^ UseIOHandle ifTrue: [self handleFromAccessor: aFileStream ioHandle] ifFalse: [aFileStream fileID] ! ! !OSProcessAccessor methodsFor: 'testing' stamp: 'dtl 8/8/2002 15:13'! handlesOsSignals "True if OS signals can be handled and forwarded to the image" ^ false! ! !OSProcessAccessor methodsFor: 'testing' stamp: 'dtl 4/8/2007 11:11'! hasTestEof "True if OSPP supports #primitiveTestEndOfFileFlag. Check this to prevent console error message when running with older OSPP." ^ hasTestEof ifNil: [hasTestEof := OSProcess accessor osppModuleVersionString asNumber >= 4.2]! ! !OSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 4/8/2007 11:09'! initialize canObtainSessionIdentifierFromPlugin := nil. self canObtainSessionIdentifierFromPlugin. sessionIdentifier := nil. hasTestEof := nil. self sessionIdentifier. ! ! !OSProcessAccessor methodsFor: 'private - IOHandle' stamp: 'dtl 7/12/2003 12:17'! ioAccessorFromSQFile: aByteArray "Answer an object which represents an IO channel. If IOHandle is present in this image, use it; otherwise just answer aByteArray." UseIOHandle ifTrue: [^ (Smalltalk at: #IOHandle) newFromSqFileStruct: aByteArray] ifFalse: [^ aByteArray]! ! !OSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 4/8/2007 11:15'! isAtEndOfFile: anIOHandle "Answer whether the file represented by anIOHandle is at end of file, as determined by a call to feof(). This is different from StandardFileStream>>primAtEnd: which answers true if the file pointer is at the end of the file, but which does not call feof() to determine that an end of file condition has occurred. The difference is significant if aSqFileStruct represents a pipe or a device file, which may not be positionable in the sense of a conventional disk file." self flag: 'FIXME'. "The #hasTestEof check can be eliminated after newer OSPP is distibuted" ^ self hasTestEof ifTrue: [self primTestEndOfFileFlag: (self handleFromAccessor: anIOHandle)] ifFalse: [self primIsAtEndOfFile: (self handleFromAccessor: anIOHandle)] ! ! !OSProcessAccessor methodsFor: 'platform identification' stamp: 'dtl 8/24/2003 09:18'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self class isResponsibleForThisPlatform! ! !OSProcessAccessor methodsFor: 'pipe open' stamp: 'dtl 1/31/2004 18:55'! makePipeHandles "Create a pipe, and answer an array of two IO accessors for the pipe reader and writer." "OSProcess accessor makePipeHandles" | p | self canObtainSessionIdentifierFromPlugin ifTrue: [p := self primCreatePipe] ifFalse: [p := self primCreatePipeWithSessionIdentifier: self sessionIdentifier]. p isNil ifTrue: [^ nil] ifFalse: [^ p collect: [:e | self ioAccessorFromSQFile: e]]! ! !OSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:41'! osppModuleName "Answer a string containing the module name string for the OSPP plugin." "OSProcess accessor osppModuleName" ^ self subclassResponsibility! ! !OSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:41'! osppModuleVersionString "Answer a string containing the version string for the OSPP plugin." "OSProcess accessor osppModuleVersionString" ^ self subclassResponsibility! ! !OSProcessAccessor methodsFor: 'session identification' stamp: 'dtl 3/2/2002 09:07'! primGetSession "Subclasses should override if they know how to obtain the session identifier." ^ nil! ! !OSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 4/8/2007 10:49'! primTestEndOfFileFlag: aSqFileStruct "Answer whether the file represented by aSqFileStruct is at end of file, as determined by a call to feof(). This is different from StandardFileStream>>primAtEnd: which answers true if the file pointer is at the end of the file, but which does not call feof() to determine that an end of file condition has occurred. The difference is significant if aSqFileStruct represents a pipe or a device file, which may not be positionable in the sense of a conventional disk file." ^ self subclassResponsibility ! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 3/5/2005 13:06'! register: fileRegionLock "If an object equal to fileRegionLock exists in the registry, answer it. Otherwise, add fileRegionLock to the registry and answer fileRegionLock." ^ (self fileLockRegistry like: fileRegionLock) ifNil: [self fileLockRegistry add: fileRegionLock] ! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 4/10/2005 15:05'! registeredLocksForFile: aFileStream "Answer all lock descriptors associated with aFileStream" ^ self fileLockRegistry select: [:ea | ea fileStream = aFileStream] ! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'jf 2/26/2004 18:06'! removeInactiveLocks "Go through the lock cache and remove any that have been left behind after their streams were closed." ^ self fileLockRegistry copy do: [:ea | ea isActive ifFalse: [self fileLockCache remove: ea]]! ! !OSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 3/2/2002 08:32'! sessionIdentifier ^ sessionIdentifier ifNil: [sessionIdentifier := self getSessionIdentifier] ! ! !OSProcessAccessor methodsFor: 'file control' stamp: 'dtl 2/11/2001 15:37'! setNonBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set it non-blocking." ^ self subclassResponsibility ! ! !OSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 3/5/2005 13:07'! unregister: fileRegionLock "If an object equal to fileRegionLock exists in the registry, remove it and answer the object. Otherwise answer nil." ^ self fileLockRegistry remove: fileRegionLock ifAbsent: [nil] ! ! !OSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:41'! xdcpModuleName "Answer a string containing the module name string for the display control plugin." "OSProcess accessor xdcpModuleName" ^ self subclassResponsibility! ! !OSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:42'! xdcpVersionString "Answer a string containing the version string for the display control plugin." "OSProcess accessor xdcpVersionString" ^ self subclassResponsibility! ! OSProcessAccessor subclass: #RiscOSProcessAccessor instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-RiscOS'! !RiscOSProcessAccessor commentStamp: '' prior: 0! I provide access to the operating system process in which the Squeak VM is currently running. I am based on the RiscOS task model. There is only one instance of me, and instances of RiscOSProcess depend on me to provide access to the operating system process which they represent. I know how to create child processes. I use a semaphore to receive signals when child processes die, and I notify my dependents (instances ofRiscOSProcess) when these events occur. ! !RiscOSProcessAccessor class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:48'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ OSProcess isRiscOS ! ! !RiscOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 1/6/2001 23:15'! primForkAndExec: executableFile withArgs: anArrayOfArgumentStrings argCount: numberOfArgumentStrings withEnv: anArrayOfEnvironmentStrings envCount: numberOfEnvironmentStrings stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle "Parameters are expected to have been properly prepared by the caller, including string values which are to be null terminated strings. In other words, all strings should have (Character value: 0) as the last element in the string."! ! !RiscOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/23/2002 05:56'! primGetSession "Answer the unique identifier for this session of Smalltalk running in this OS Process." ^ nil ! ! OSProcessAccessor subclass: #UnixOSProcessAccessor instanceVariableNames: 'grimReaper sigChldSemaphore' classVariableNames: 'ThisProcessPid' poolDictionaries: '' category: 'OSProcess-Unix'! !UnixOSProcessAccessor commentStamp: '' prior: 0! I provide access to the operating system process in which the Squeak VM is currently running. I am based on the Unix process model. There is only one instance of me, and instances of UnixOSProcess depend on me to provide access to the operating system process which they represent. I know how to create child processes. I use a semaphore to receive signals when child processes die, and I notify my dependents (instances of UnixOSProcess) when these events occur. ! !UnixOSProcessAccessor class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:49'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ OSProcess isUnix ! ! !UnixOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:43'! aioModuleName "Answer a string containing the module name string for the AIO plugin." "OSProcess accessor aioModuleName" ^ self primAioPluginModuleName ! ! !UnixOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:44'! aioVersionString "Answer a string containing the version string for the AIO plugin." "OSProcess accessor aioVersionString" ^ self primAioPluginVersionString ! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 10/7/2000 13:39'! canAccessChildProcess: anExternalProcess "Is the child process still there? Maybe not if we have restarted the image and anExternalProcess refers to a process which died while we were not watching." ^ self primCanReceiveSignals: anExternalProcess pid! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 9/9/2000 15:45'! canAccessSystem "Answer true if it is possible to access the external process, else false. Failure to access the external process is probably due to lack of a UnixOSProcessPlugin module." ^ self primGetPid notNil ! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 8/30/2003 18:43'! canControlXDisplay "True if the XDisplayControlPlugin is accessible. Older versions of OSProcess relied on the X display control to be embedded in the OSProcessPlugin module. This has been moved to a separate display control plugin to allow support of non-X platforms and other display media on Unix platforms (OS X)." "OSProcess accessor canControlXDisplay" ^ self primXDisplayControlPluginModuleName notNil ! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 2/14/2004 12:17'! canForwardExternalSignals "Answer true if it is possible to forward OS signals to a Smalltalk Semaphore." ^ true ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/31/2001 15:07'! chDir: pathString "Change current working directory. The $PWD environment variable is not updated (but see UnixProcess>>chDir:). Answer nil for success, or an error message." "OSProcess accessor chDir: '/tmp'" "OSProcess accessor chDir: '/no/such/path'" "OSProcess accessor chDir: FileDirectory default name" | result message | result := self primChdir: pathString. result isNil ifTrue: [^ nil] ifFalse: [message := self primErrorMessageAt: result. ^ message] ! ! !UnixOSProcessAccessor methodsFor: 'debugging' stamp: 'dtl 11/19/2006 09:02'! currentSigHandlerAddress: signalNumber "Answer the current machine address of the signal handler for signalNumber, expressed as a ByteArray. Temporarily set a signal forwarded for signalNumber, and remember the machine address of the prior signal handler. Restore the signal handler to its previous value, and answer the machine address of the handler." "OSProcess accessor currentSigHandlerAddress: OSProcess accessor primSigIntNumber" | sema index previousHandlerAddress | sema := Semaphore new. index := Smalltalk registerExternalObject: sema. (previousHandlerAddress := self primForwardSignal: signalNumber toSemaphore: index) ifNil: [Smalltalk unregisterExternalObject: sema. ^ self error: 'could not forward signal number ', signalNumber asString]. self restoreSignal: signalNumber. ^ previousHandlerAddress! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 7/2/2000 19:59'! environmentAt: aSymbolOrString "Get an environment variable from the external OS process." "OSProcess thisOSProcess environmentAt: 'PATH'" ^ self primEnvironmentAtSymbol: aSymbolOrString ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 10/7/2001 01:18'! environmentAt: aSymbolOrString put: aString "Add or update an environment variable in the external OS process. Convert aSymbol and aString into a KEY=value string and pass this to the OS process environment. Standard C libraries provide a putenv() function for this purpose, with a parameter in the form KEY=value. Note: Maintain a reference to the return value, see note in primitivePutEnv." "OSProcess accessor environmentAt: 'AAAA' put: 'this is the value of AAAA'" "OSProcess accessor environmentAt: 'AAAA' put: nil" "OSProcess accessor environmentAt: 'AAAA'" aString isNil ifTrue: [^ self primUnsetEnv: aSymbolOrString, (Character value: 0) asString] ifFalse: [^ self environmentPut: (aSymbolOrString asString, '=', aString)] ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 9/10/2000 09:48'! environmentPut: aString "Add or update an environment variable in the external OS process using a 'KEY=value' string. Create a null terminated string for use by the external putenv() call in a pluggable primitive." "OSProcess thisOSProcess processAccessor environmentPut: 'SOMEKEY=somevalue'" | cString | cString := aString, (Character value: 0) asString. ^ self primPutEnv: cString ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 05:49'! fileProtectionMask: aPathString "Call stat(2) to obtain the file protection mask for a file." "OSProcess accessor fileProtectionMask: '/bin/sh'" "OSProcess accessor fileProtectionMask: '/etc/hosts'" "OSProcess accessor fileProtectionMask: '/bin/su'" "OSProcess accessor fileProtectionMask: '/bin/NOSUCHFILE'" "OSProcess accessor fileProtectionMask: 12345" | mask | (aPathString isKindOf: String) ifFalse: [self error: 'expected a path string'. ^ nil]. mask := self primFileProtectionMask: aPathString. (mask == nil) ifTrue: [^ nil]. (mask isKindOf: Integer) ifTrue: [^ self primErrorMessageAt: mask]. ^ mask ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 05:49'! fileStat: aPathString "Call stat(2) to obtain the UID, GID, and file protection mask for a file." "OSProcess accessor fileStat: '/var/spool/news'" "OSProcess accessor fileStat: '/etc/hosts'" "OSProcess accessor fileStat: '/bin/su'" "OSProcess accessor fileStat: '/bin/NOSUCHFILE'" "OSProcess accessor fileStat: 12345" | mask | (aPathString isKindOf: String) ifFalse: [self error: 'expected a path string'. ^ nil]. mask := self primFileStat: aPathString. (mask == nil) ifTrue: [^ nil]. (mask isKindOf: Integer) ifTrue: [^ self primErrorMessageAt: mask]. ^ mask ! ! !UnixOSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 1/25/2004 21:51'! finalize "Clean up grimReaper and associated semaphore." self grimReaper ifNotNil: [grimReaper terminate. grimReaper := nil]. self sigChldSemaphore ifNotNil: [self restoreSignal: self primSigChldNumber. self sigChldSemaphore: nil] ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 3/3/2002 16:33'! flushExternalStream: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to flush the external I/O stream." ^ self canObtainSessionIdentifierFromPlugin ifTrue: [self primSQFileFlush: (self handleFromAccessor: anIOHandle)] ifFalse: [self primSQFileFlush: (self handleFromAccessor: anIOHandle) withSessionIdentifier: self sessionIdentifier] ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 1/25/2004 21:43'! forkAndExec: executableFile stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle argBuf: argVec argOffsets: argOffsets envBuf: envVec envOffsets: envOffsets workingDir: pathString "Parameters are expected to have been properly prepared by the caller, including string values which are to be null terminated strings. In other words, all strings should have (Character value: 0) as the last element in the string. Parameters should be: executableFile: a string with the name of a file to execute. stdIn: a fileID ByteArray (struct SQFile in C) to be used as standard input. stdOut: a fileID ByteArray to be used as standard output. stdErr: a fileID ByteArray to be used as standard error. argVec: a String arranged to look more or less like a char **, but with the addresses not yet fixed. argOffsets: an Array of offsets for fixing up the argVec addresses. envVec: a String arranged to look more or less like a char **, but with the addresses not yet fixed. envOffsets: an Array of offsets for fixing up the envVec addresses. workingDir: a null terminated path name String, or nil. The envVec parameter may be nil, in which case envOffsets is ignored. workingDir may be nil. The other parameters are required. Parameters with nil value indicate that current values for this process should be used." ^ self primForkExec: executableFile stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle argBuf: argVec argOffsets: argOffsets envBuf: envVec envOffsets: envOffsets workingDir: pathString ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 1/26/2004 06:02'! forkSqueak "Clone this Squeak Smalltalk image in a child OSProcess. The child is the same as the parent, except for its new X session connection, and the return value of this method, which is zero for the child process, and a positive integer equal to the pid of the child for the parent process. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." ^ self primForkSqueak ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:51'! forwardSigChld "Set a signal handler for SIGCHLD. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigChld" ^ self forwardSignal: self primSigChldNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:51'! forwardSigHup "Set a signal handler for SIGHUP. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigHup" ^ self forwardSignal: self primSigHupNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:51'! forwardSigInt "Set a signal handler for SIGINT. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigInt" ^ self forwardSignal: self primSigIntNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:51'! forwardSigKill "Set a signal handler for SIGKILL. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigKill" self notify: 'SIGKILL and SIGSTOP signals cannot be caught, see man signal(2)'. ^ self forwardSignal: self primSigKillNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:52'! forwardSigPipe "Set a signal handler for SIGPIPE. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigPipe" ^ self forwardSignal: self primSigPipeNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:52'! forwardSigQuit "Set a signal handler for SIGQUIT. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigQuit" ^ self forwardSignal: self primSigQuitNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:52'! forwardSigTerm "Set a signal handler for SIGTERM. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigTerm" ^ self forwardSignal: self primSigTermNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:52'! forwardSigUsr1 "Set a signal handler for SIGUSR1. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigUsr1" ^ self forwardSignal: self primSigUsr1Number ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:52'! forwardSigUsr2 "Set a signal handler for SIGUSR2. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set)." "OSProcess accessor forwardSigUsr1" ^ self forwardSignal: self primSigUsr2Number ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 12/6/2002 18:28'! forwardSignal: signalNumber "Set a signal handler in the VM which will signal a Smalltalk semaphore at semaphoreIndex whenever an external signal sigNum is received. Answer a new Semaphore, or nil if unable to set the handler (possibly because it has already been set). A Smalltalk process can wait on the Semaphore, and take action when a signal is detected. See man(7) signal for signal number definitions on your unix system." "OSProcess accessor forwardSignal: OSProcess accessor primSigIntNumber" | sema index | sema := Semaphore new. index := Smalltalk registerExternalObject: sema. (self primForwardSignal: signalNumber toSemaphore: index) ifNil: [Smalltalk unregisterExternalObject: sema. ^ nil]. ^ sema! ! !UnixOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:05'! getStdErrHandle "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." | handle | handle := self canObtainSessionIdentifierFromPlugin ifTrue: [handle := self primGetStdErrHandle] ifFalse: [handle := self primGetStdErrHandleWithSessionIdentifier: self sessionIdentifier]. handle ifNil: [^ nil]. ^ self ioAccessorFromSQFile: handle ! ! !UnixOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:05'! getStdInHandle "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." | handle | handle := self canObtainSessionIdentifierFromPlugin ifTrue: [handle := self primGetStdInHandle] ifFalse: [handle := self primGetStdInHandleWithSessionIdentifier: self sessionIdentifier]. handle ifNil: [^ nil]. ^ self ioAccessorFromSQFile: handle ! ! !UnixOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:06'! getStdOutHandle "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." | handle | handle := self canObtainSessionIdentifierFromPlugin ifTrue: [handle := self primGetStdOutHandle] ifFalse: [handle := self primGetStdOutHandleWithSessionIdentifier: self sessionIdentifier]. handle ifNil: [^ nil]. ^ self ioAccessorFromSQFile: handle ! ! !UnixOSProcessAccessor methodsFor: 'pthreads' stamp: 'dtl 3/17/2007 23:14'! getThreadID "Answer the ID of the pthread that is currently executing (the interpreter thread). A thread ID may be a 64 bit value on some platforms, so answer a byte array containing the value in machine-dependent byte order." "OSProcess accessor getThreadID" | osppVer | [osppVer := OSProcess accessor osppModuleVersionString asNumber] on: Error do: [^ nil]. (osppVer notNil and: [osppVer >= 4.2]) ifTrue: [^ self primGetThreadID] ifFalse: [^ nil] ! ! !UnixOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 1/25/2004 21:29'! grimReaper "Answer the value of grimReaper" ^ grimReaper! ! !UnixOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 2/14/2004 11:45'! grimReaper: anObject "Set the value of grimReaper" grimReaper := anObject! ! !UnixOSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 2/20/2004 18:29'! grimReaperProcess "This is a process which waits for the death of a child OSProcess, and informs any dependents of the change. Use SIGCHLD events if possible, otherwise a Delay to poll for exiting child processes." | event processSynchronizationDelay | ^ self canAccessSystem ifTrue: [event := (self canAccessSystem and: [self canForwardExternalSignals]) ifTrue: [self sigChldSemaphore] ifFalse: [Delay forMilliseconds: 200]. processSynchronizationDelay := Delay forMilliseconds: 20. grimReaper ifNil: [grimReaper := [[event wait. processSynchronizationDelay wait. "Avoids lost signals in heavy process switching" self changed: #childProcessStatus] repeat] fork]] ifFalse: [nil] ! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 8/8/2002 15:13'! handlesOsSignals "True if OS signals can be handled and forwarded to the image" ^ true! ! !UnixOSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 1/25/2004 21:32'! initialize "Call this method when an instance is first created, or to refresh after an image restart to clean up from the previous session. Notify dependents of my singleton instance if the image has restarted in a different OS process (this is not the case when #startUp is called after a simple image save)." self finalize. super initialize. self sigChldSemaphore. self grimReaperProcess. ThisProcessPid ~~ self primGetPid ifTrue: ["Image has been restarted and is now running in a different OS process" ThisProcessPid := self primGetPid. self changed: #startUp]. self changed ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 10/6/2001 12:08'! isExecutable: aPathName "Answer true if file at aPathName has execute permission for this process." "OSProcess accessor isExecutable: '/bin/sh'" "OSProcess accessor isExecutable: '/no/such/file'" ^ self isExecutable: aPathName forUser: self primGetUid inGroup: self primGetGid ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 22:53'! isExecutable: aPathName forUser: uid inGroup: gid "Answer true if file at aPathName has execute permission for a user identified by user uid and group gid." "OSProcess accessor isExecutable: '/bin/sh' forUser: OSProcess accessor primGetUid inGroup: OSProcess accessor primGetGid" | fStat suid sgid user group protectionMask | fStat := self fileStat: aPathName. (fStat isKindOf: String) ifTrue: [self inform: aPathName, ': ', fStat. ^ nil]. protectionMask := fStat at: 3. ((protectionMask at: 4) allMask: 1) ifTrue: [^ true]. "Test executable by any user ID" sgid := (protectionMask at: 1) allMask: 2. sgid ifTrue: [group := gid] ifFalse: [group := fStat at: 2]. ((gid == group) and: [(protectionMask at: 3) allMask: 1]) ifTrue: [^ true]. "Test executable by my group ID" suid := (protectionMask at: 1) allMask: 4. suid ifTrue: [user := uid] ifFalse: [user := fStat at: 1]. ((uid == user) and: [(protectionMask at: 2) allMask: 1]) ifTrue: [^ true]. "Test executable by my user ID" ^ false ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/14/2004 15:10'! isLockableFile: aFileStream "Check for ability to place an exclusive lock on the entire file represented by aFileStream. An exclusive lock (write lock) permits only one OS process to hold the lock. Answer true if the region is lockable." ^ self isLockableFile: aFileStream exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'jf 2/22/2004 17:30'! isLockableFile: aFileStream exclusive: flag "Check for ability to place an exclusive lock on the entire file represented by aFileStream. An exclusive lock (write lock) permits only one OS process to hold the lock. Answer true if the region is lockable." | fileLock | aFileStream ifNil: [^ false]. fileLock := OSFileLock onFile: aFileStream exclusive: flag. ^ self isLockableFileRegion: fileLock ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/14/2004 15:09'! isLockableFile: aFileStream from: start to: end "Pass a struct SQFile on the stack, and check for ability to lock the specified region. If the exclusive flag is true, then specify an exclusive (F:=WRLCK) lock on the file. Otherwise, specify a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Answer true if the region is lockable." ^ self isLockableFile: aFileStream from: start to: end exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/22/2004 15:10'! isLockableFile: aFileStream from: start to: end exclusive: flag "Pass a struct SQFile on the stack, and check for ability to lock the specified region. If the exclusive flag is true, then specify an exclusive (F:=WRLCK) lock on the file. Otherwise, specify a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Answer true if the region is lockable." | fileRegion | aFileStream ifNil: [^ false]. fileRegion := OSFileRegionLock onFile: aFileStream from: start to: end exclusive: flag. ^ self isLockableFileRegion: fileRegion ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 1/4/2004 00:20'! isLockableFile: aFileStream region: anInterval "Pass a struct SQFile on the stack, and check for ability to place an exclusive lock on the specified region. An exclusive lock (write lock) permits only one OS process to hold the lock. Answer true if the region is lockable. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file." ^ self isLockableFile: aFileStream region: anInterval exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 2/22/2004 15:10'! isLockableFile: aFileStream region: anInterval exclusive: flag "Pass a struct SQFile on the stack, and check for ability to lock the specified region. If the exclusive flag is true, then specify an exclusive (F:=WRLCK) lock on the file. Otherwise, specify a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Answer true if the region is lockable." | fileRegion | aFileStream ifNil: [^ false]. fileRegion := OSFileRegionLock onFile: aFileStream interval: anInterval exclusive: flag. ^ self isLockableFileRegion: fileRegion ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'jf 2/22/2004 18:42'! isLockableFileRegion: aFileLock "Pass a struct SQFile on the stack, and check for ability to lock the specified region. If the exclusive flag is true, then specify an exclusive (F:=WRLCK) lock on the file. Otherwise, specify a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Answer true if the region is lockable." aFileLock ifNil: [^ false]. (self canAcquireLock: aFileLock) ifFalse: [^ false]. ^ aFileLock test ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 23:09'! isReadable: aPathName "Answer true if file at aPathName has read permission for this process." "OSProcess accessor isWritable: '/bin/sh'" ^ self isReadable: aPathName forUser: self primGetUid inGroup: self primGetGid ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 23:00'! isReadable: aPathName forUser: uid inGroup: gid "Answer true if file at aPathName has read permission for a user identified by user uid and group gid." "OSProcess accessor isReadable: '/bin/sh' forUser: OSProcess accessor primGetUid inGroup: OSProcess accessor primGetGid" | fStat user group protectionMask | fStat := self fileStat: aPathName. (fStat isKindOf: String) ifTrue: [self inform: aPathName, ': ', fStat. ^ nil]. protectionMask := fStat at: 3. ((protectionMask at: 4) allMask: 4) ifTrue: [^ true]. "Test readable by any user ID" group := fStat at: 2. ((gid == group) and: [(protectionMask at: 3) allMask: 4]) ifTrue: [^ true]. "Test readable by my group ID" user := fStat at: 1. ((uid == user) and: [(protectionMask at: 2) allMask: 4]) ifTrue: [^ true]. "Test readable by my user ID" ^ false ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 23:09'! isWritable: aPathName "Answer true if file at aPathName has write permission for this process." "OSProcess accessor isWritable: '/bin/sh'" ^ self isWritable: aPathName forUser: self primGetUid inGroup: self primGetGid ! ! !UnixOSProcessAccessor methodsFor: 'file testing' stamp: 'dtl 5/1/2001 23:08'! isWritable: aPathName forUser: uid inGroup: gid "Answer true if file at aPathName has read permission for a user identified by user uid and group gid." "OSProcess accessor isWritable: '/bin/sh' forUser: OSProcess accessor primGetUid inGroup: OSProcess accessor primGetGid" | fStat user group protectionMask | fStat := self fileStat: aPathName. (fStat isKindOf: String) ifTrue: [self inform: aPathName, ': ', fStat. ^ nil]. protectionMask := fStat at: 3. ((protectionMask at: 4) allMask: 2) ifTrue: [^ true]. "Test writable by any user ID" group := fStat at: 2. ((gid == group) and: [(protectionMask at: 3) allMask: 2]) ifTrue: [^ true]. "Test writable by my group ID" user := fStat at: 1. ((uid == user) and: [(protectionMask at: 2) allMask: 2]) ifTrue: [^ true]. "Test writable by my user ID" ^ false ! ! !UnixOSProcessAccessor methodsFor: 'VM atexit' stamp: 'dtl 3/17/2007 18:39'! kill: listOfPids withSignal: signumOrNil "On exit of the VM process, send signal to the external processes identified by listOfPids. If signumOrNil is nil, the default SIGTERM signal will be sent to listOfPids." ^ self primKill: listOfPids withSignal: signumOrNil ! ! !UnixOSProcessAccessor methodsFor: 'VM atexit' stamp: 'dtl 3/18/2007 10:39'! killOnVmExit: proxies withSignal: signumOrNil "When Squeak uses OSProcess to start a long running external process, it may be useful to guarantee that one or more child processes is killed when the Squeak VM exits, regardless of whether the normal Squeak shutdown processing has occurred. This method arranges for a collection of external process proxies to receive a signal when the Squeak VM exits. If signumOrNil is nil, the default SIGTERM will be used. Each invocation of this method will override the effects of previous calls." "OSProcess accessor killOnVmExit: OSProcess thisOSProcess allMyChildren withSignal: nil" | pids | pids := (proxies select: [:p | p isRunning] thenCollect: [:e | e pid]) asArray. ^ self kill: pids withSignal: signumOrNil ! ! !UnixOSProcessAccessor methodsFor: 'debugging' stamp: 'dtl 11/19/2006 09:05'! listSigHandlerAddressesOnConsole "OSProcess accessor listSigHandlerAddressesOnConsole" (0 to: 67) do: [:sigNum | | prev | [prev := OSProcess accessor currentSigHandlerAddress: sigNum. OSProcess debugMessage: 'signal ', sigNum asString,' hander is ', prev printString] on: Error do: [:ex | OSProcess debugMessage: ex printString]] ! ! !UnixOSProcessAccessor methodsFor: 'debugging' stamp: 'dtl 11/19/2006 09:07'! listSigHandlerAddressesOnTranscript "OSProcess accessor listSigHandlerAddressesOnTranscript" Transcript cr. (0 to: 67) do: [:sigNum | | prev | [prev := OSProcess accessor currentSigHandlerAddress: sigNum. Transcript show: 'signal ', sigNum asString,' hander is ', prev printString; cr] on: Error do: [:ex | Transcript show: ex printString; cr]] ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/14/2004 15:01'! lockFile: aFileStream "Request an exclusive lock on the entire file represented by aFileStream. The exclusive lock (write lock) permits only one OS process to hold the lock. Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self lockFile: aFileStream exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/11/2006 23:40'! lockFile: aFileStream exclusive: flag "Request an exclusive lock on the entire file represented by aFileStream. The exclusive lock (write lock) permits only one OS process to hold the lock. Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self lockFile: aFileStream exclusive: flag ifFail: nil ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/11/2006 23:39'! lockFile: aFileStream exclusive: flag ifFail: failBlock "Request an exclusive lock on the entire file represented by aFileStream. The exclusive lock (write lock) permits only one OS process to hold the lock. Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileLock | aFileStream ifNil: [^ failBlock value]. fileLock := OSFileLock onFile: aFileStream exclusive: flag. ^ self lockFileRegion: fileLock ifFail: failBlock ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/14/2004 15:01'! lockFile: aFileStream from: start to: end "Pass a struct SQFile on the stack, and request a lock on the specified region. If the exclusive flag is true, then request an exclusive (F:=WRLCK) lock on the file. Otherwise, request a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self lockFile: aFileStream from: start to: end exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/22/2004 15:10'! lockFile: aFileStream from: start to: end exclusive: flag "Pass a struct SQFile on the stack, and request a lock on the specified region. If the exclusive flag is true, then request an exclusive (F:=WRLCK) lock on the file. Otherwise, request a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileRegion | aFileStream ifNil: [^ nil]. fileRegion := OSFileRegionLock onFile: aFileStream from: start to: end exclusive: flag. ^ self lockFileRegion: fileRegion ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/11/2006 23:41'! lockFile: aFileStream ifFail: failBlock "Request an exclusive lock on the entire file represented by aFileStream. The exclusive lock (write lock) permits only one OS process to hold the lock. Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self lockFile: aFileStream exclusive: true ifFail: failBlock ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 1/4/2004 00:29'! lockFile: aFileStream region: anInterval "Pass a struct SQFile on the stack, and request an exclusive lock on the specified region. The exclusive lock (write lock) permits only one OS process to hold the lock. Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self lockFile: aFileStream region: anInterval exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 2/22/2004 15:10'! lockFile: aFileStream region: anInterval exclusive: flag "Pass a struct SQFile on the stack, and request a lock on the specified region. If the exclusive flag is true, then request an exclusive (F:=WRLCK) lock on the file. Otherwise, request a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileRegion | aFileStream ifNil: [^ nil]. fileRegion := OSFileRegionLock onFile: aFileStream interval: anInterval exclusive: flag. ^ self lockFileRegion: fileRegion ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/8/2006 07:04'! lockFileRegion: aFileLock "Pass a struct SQFile on the stack, and request a lock on the specified region. If the exclusive flag is true, then request an exclusive (F:=WRLCK) lock on the file. Otherwise, request a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self lockFileRegion: aFileLock ifFail: [nil] ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/12/2006 07:20'! lockFileRegion: fileStream from: start to: end exclusive: writeLockFlag ifFail: failBlock | lock | lock := OSFileRegionLock onFile: fileStream from: start to: end exclusive: writeLockFlag. ^ self lockFileRegion: lock ifFail: [failBlock value]! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/12/2006 07:23'! lockFileRegion: fileStream from: start to: end ifFail: failBlock ^ self lockFileRegion: fileStream from: start to: end exclusive: true ifFail: failBlock ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/8/2006 07:03'! lockFileRegion: aFileLock ifFail: failBlock "Pass a struct SQFile on the stack, and request a lock on the specified region. If the exclusive flag is true, then request an exclusive (F:=WRLCK) lock on the file. Otherwise, request a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). Answer a descriptor for the locked file region, an Array of file handle and region interval; or answer nil on error. If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." aFileLock ifNil: [^ failBlock value]. "Check region lock overlap for Win32 compatibility" (self canAcquireLock: aFileLock) ifFalse: [^ failBlock value]. aFileLock lock ifFalse: [^ failBlock value] ifTrue: [self register: aFileLock. ^ aFileLock] ! ! !UnixOSProcessAccessor methodsFor: 'pipe open' stamp: 'dtl 1/31/2004 19:08'! makePipeHandles "Create a pipe, and answer an array of two IO accessors for the pipe reader and writer. Set a signal handler to cause SIGPIPE signals to be ignored. This will register a Semaphore to receive the SIGPIPE events, but we will simply ignore the semaphore, effectively ignoring the external OS signals. This is done instead of explicitly telling the OS to ignore the signals because it allows the use of a uniform signal forwarding mechanism in Squeak, even for signals that are ultimately ignored." self forwardSigPipe. ^ super makePipeHandles ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 10/8/2005 09:55'! nice: inc "Change the scheduling priority of this OS process by the given nice increment. A positive increment decreases the priority. Only the superuser can specify a negative value to increase the priority. A typical use is to increase the nice value by 1 in order to make the Squeak VM run at lower priority. This may be useful for a background Squeak doing an image save or other non- interactive process." "OSProcess accessor nice: 1" ^ self primNice: inc ! ! !UnixOSProcessAccessor methodsFor: 'display handling - old plugin compatibility' stamp: 'dtl 8/3/2003 20:34'! oldPrimCanConnectToXDisplay: xDisplayName "Deprecated - install the XDisplayControlPlugin to eliminate the need to call this method" "Open and close a connection to displayName. It the connection was successfully opened, answer true; otherwise false. This is intended to check for the ability to open an X display prior to actually making the attempt." "OSProcess accessor primCanConnectToXDisplay: ':0.0' " "OSProcess accessor primCanConnectToXDisplay: ':1' " ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'display handling - old plugin compatibility' stamp: 'dtl 8/3/2003 20:34'! oldPrimGetXDisplayName "Deprecated - install the XDisplayControlPlugin to eliminate the need to call this method" "Answer a string containing the name for the X display, or nil if the display was opened using the $DISPLAY environment variable. This answers the name of the X display as of the time it was last opened, which may be different from the current setting of $DISPLAY." "OSProcess accessor primGetXDisplayName" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'display handling - old plugin compatibility' stamp: 'dtl 8/3/2003 20:35'! oldPrimIsConnectedToXServer "Deprecated - install the XDisplayControlPlugin to eliminate the need to call this method" "Answer true if VM is currently connected to an X server." "OSProcess accessor primIsConnectedToXServer inspect" "| x | OSProcess accessor primKillDisplay. x := OSProcess accessor primIsConnectedToXServer. OSProcess accessor primOpenXDisplay. x inspect" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'display handling - old plugin compatibility' stamp: 'dtl 8/3/2003 20:35'! oldPrimKillDisplay "Deprecated - install the XDisplayControlPlugin to eliminate the need to call this method" "Call an internal function which will disconnect the X display session." "OSProcess thisOSProcess processAccessor primKillDisplay" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'display handling - old plugin compatibility' stamp: 'dtl 8/3/2003 20:35'! oldPrimOpenXDisplay "Deprecated - install the XDisplayControlPlugin to eliminate the need to call this method" "Call an internal function which will open the X display session." "OSProcess thisOSProcess processAccessor primKillDisplay. (Delay forSeconds: 5) wait. OSProcess thisOSProcess processAccessor primOpenXDisplay" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'display handling - old plugin compatibility' stamp: 'dtl 8/3/2003 20:35'! oldPrimSetXDisplayName: aStringOrNil "Deprecated - install the XDisplayControlPlugin to eliminate the need to call this method" "Set the name for the X display for use in the next call to primitiveOpenXDisplay. aStringOrNil must be either a String (such as 'myhost:0') or nil, indicating that the current value of $DISPLAY should be used." "OSProcess accessor primSetXDisplayName: ':0.0' " "OSProcess accessor primSetXDisplayName: nil " ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 11:48'! osppModuleName "Answer a string containing the module name string for the OSPP plugin." "OSProcess accessor osppModuleName" ^ self primOSProcessPluginModuleName ! ! !UnixOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 11:49'! osppModuleVersionString "Answer a string containing the version string for the OSPP plugin." "OSProcess accessor osppModuleVersionString" ^ self primOSProcessPluginModuleVersionString ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 10:37'! primAioPluginModuleName "Answer a string containing the module name string for the AIO plugin." "OSProcess accessor primAioPluginModuleName" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 10:38'! primAioPluginVersionString "Answer a string containing the version string for the AIO plugin." "OSProcess accessor primAioPluginVersionString" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 7/22/2000 17:19'! primArgumentAt: index "Answer the argument string in the argument OS process argument list at position index. In Unix, the first element of the list is the program name, and any additional elements of the list are optional command line arguments passed to the program. This convention may be simulated by the C runtime libraries on other operating systems, but argument list handling should be assumed to be operating system dependent." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/3/2003 18:26'! primCanConnectToXDisplay: xDisplayName "Open and close a connection to displayName. It the connection was successfully opened, answer true; otherwise false. This is intended to check for the ability to open an X display prior to actually making the attempt." "OSProcess accessor primCanConnectToXDisplay: ':0.0' " "OSProcess accessor primCanConnectToXDisplay: ':1' " ^ self oldPrimCanConnectToXDisplay: xDisplayName ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 2/24/2001 14:28'! primCanReceiveSignals: anIntegerPid "Answer true if an external OS process can receive signals. In most cases, if the process identified by anIntegerPid cannot receive signals, it is because the process does not exist and anIntegerPid is a stale reference (possibly left over from a previous Squeak session). Answer nil if the primitive does not exist (possibly because the VM is using an older version of the plugin)." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/31/2001 11:18'! primChdir: pathString "Change current working directory. Does not update the $PWD environment variable." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 2/17/2004 23:37'! primCreatePipe "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ self primMakePipe "try the older deprecated version"! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 2/17/2004 23:37'! primCreatePipeWithSessionIdentifier: aByteArray "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ self primMakePipeWithSessionIdentifier: aByteArray "try the older deprecated version"! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/6/2003 06:24'! primDisconnectDisplay "Disconnect the X display session. The actual Squeak window on the X server is not effected, but this instance of Squeak will not have any further interaction with it." "OSProcess thisOSProcess processAccessor primDisconnectDisplay" ^ self oldPrimKillDisplay ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 7/22/2000 17:20'! primEnvironmentAt: index "Answer the environment string at index position in the OS process environment list. This returns a 'KEY=value' string, which the caller is expected to parse into #KEY and 'value' to be stored an environment dictionary." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:28'! primEnvironmentAtSymbol: aSymbol "Answer the value of an environment variable in the external OS process." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/31/2001 11:03'! primErrorMessageAt: anInteger "Answer an error message string from the sys:=errlist array, indexed by anInteger." "OSProcess accessor primErrorMessageAt: 0" "OSProcess accessor primErrorMessageAt: 100" "OSProcess accessor primErrorMessageAt: 1000" "OSProcess accessor primErrorMessageAt: -1" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 4/30/2001 05:49'! primFileProtectionMask: aPathString "Call stat(2) to obtain the file protection mask for a file. Answer an Array of four integers representing the protection mask, or answer errno on failure. The protection mask is four Integers, each of which may be considered an octal digit (0-7), with bit values 4, 2, and 1. The first digit selects the set user ID (4) and set group ID (2) and save text image (1) attributes. The second digit selects permissions for the user who owns the file: read (4), write (2), and execute (1); the third selects permissions for other users in the file's group, with the same values; and the fourth for other users not in the file's group, with the same values." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 4/30/2001 20:56'! primFileStat: aPathString "Call stat(2) to obtain the file protection mask for a file. Answer errno on failure, or on success answer an array with: UID with: GID with: protectionMask. The protectionMask is an Array of four integers representing the protection mask, or answer errno on failure. The protection mask is four Integers, each of which may be considered an octal digit (0-7), with bit values 4, 2, and 1. The first digit selects the set user ID (4) and set group ID (2) and save text image (1) attributes. The second digit selects permissions for the user who owns the file: read (4), write (2), and execute (1); the third selects permissions for other users in the file's group, with the same values; and the fourth for other users not in the file's group, with the same values." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/24/2003 10:13'! primFlushXDisplay "Call an internal function to synchronize output to the X display." "OSProcess thisOSProcess processAccessor primFlushXDisplay" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 3/31/2001 16:35'! primForkAndExec: executableFile stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle argBuf: argVec argOffsets: argOffsets envBuf: envVec envOffsets: envOffsets workingDir: pathString "Parameters are expected to have been properly prepared by the caller, including string values which are to be null terminated strings. In other words, all strings should have (Character value: 0) as the last element in the string. Parameters should be: executableFile: a string with the name of a file to execute. stdIn: a fileID ByteArray (struct SQFile in C) to be used as standard input. stdOut: a fileID ByteArray to be used as standard output. stdErr: a fileID ByteArray to be used as standard error. argVec: a String arranged to look more or less like a char **, but with the addresses not yet fixed. argOffsets: an Array of offsets for fixing up the argVec addresses. envVec: a String arranged to look more or less like a char **, but with the addresses not yet fixed. envOffsets: an Array of offsets for fixing up the envVec addresses. workingDir: a null terminated path name String, or nil. The envVec parameter may be nil, in which case envOffsets is ignored. workingDir may be nil. The other parameters are required. Parameters with nil value indicate that current values for this process should be used." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 2/4/2001 16:04'! primForkAndExec: executableFile withArgs: anArrayOfArgumentStrings argCount: numberOfArgumentStrings withEnv: anArrayOfEnvironmentStrings envCount: numberOfEnvironmentStrings stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle "Obsolete as of OSProcess version 1.6 or later (early 2001). This method is retained in order to maintain backward compatibility with older versions of UnixOSProcessPlugin." "Parameters are expected to have been properly prepared by the caller, including string values which are to be null terminated strings. In other words, all strings should have (Character value: 0) as the last element in the string. Parameters should be: executableFile: a string with the name of a file to execute args: a possibly empty array of strings env: either nil, or an array of 'KEY=value' strings stdIn: either nil, or a fileID ByteArray (struct SQFile in C) to be used as standard input stdOut: either nil, or fileID ByteArray to be used as standard output stdErr: either nil, or a fileID ByteArray to be used as standard error Parameters with nil value indicate that current values for this process should be used." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 2/18/2004 19:06'! primForkExec: executableFile stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle argBuf: argVec argOffsets: argOffsets envBuf: envVec envOffsets: envOffsets workingDir: pathString "Parameters are expected to have been properly prepared by the caller, including string values which are to be null terminated strings. In other words, all strings should have (Character value: 0) as the last element in the string. Parameters should be: executableFile: a string with the name of a file to execute. stdIn: a fileID ByteArray (struct SQFile in C) to be used as standard input. stdOut: a fileID ByteArray to be used as standard output. stdErr: a fileID ByteArray to be used as standard error. argVec: a String arranged to look more or less like a char **, but with the addresses not yet fixed. argOffsets: an Array of offsets for fixing up the argVec addresses. envVec: a String arranged to look more or less like a char **, but with the addresses not yet fixed. envOffsets: an Array of offsets for fixing up the envVec addresses. workingDir: a null terminated path name String, or nil. The envVec parameter may be nil, in which case envOffsets is ignored. workingDir may be nil. The other parameters are required. Parameters with nil value indicate that current values for this process should be used." "On failure, try the older deprecated version. First tell the plugin what semaphore to use." self primSetSemaIndex: (Smalltalk externalObjects indexOf: OSProcess accessor sigChldSemaphore). ^ self primForkAndExec: executableFile stdIn: inputFileHandle stdOut: outputFileHandle stdErr: errorFileHandle argBuf: argVec argOffsets: argOffsets envBuf: envVec envOffsets: envOffsets workingDir: pathString ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 2/18/2004 19:11'! primForkSqueak "Clone this Squeak Smalltalk image in a child OSProcess. The child is the same as the parent, except for its new X session connection, and the return value of this method, which is zero for the child process, and a positive integer equal to the pid of the child for the parent process. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "On failure, try the older deprecated version. First tell the plugin what semaphore to use." self primSetSemaIndex: (Smalltalk externalObjects indexOf: OSProcess accessor sigChldSemaphore). ^ self primOldForkSqueak ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 8/3/2002 20:29'! primForwardSignal: signalNumber toSemaphore: semaphoreIndex "Set a signal handler in the VM which will signal a Smalltalk semaphore at semaphoreIndex whenever an external signal sigNum is received. Answer the prior value of the signal handler. If semaphoreIndex is zero, the handler is unregistered, and the VM returns to its default behavior for handling that signal. The Smalltalk semaphore is expected to be kept at the same index location indefinitely during the lifetime of a Squeak session. If that is not the case, the handler must be unregistered prior to unregistering the Smalltalk semaphore." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 10/14/2001 11:15'! primGetChildExitStatus: childPid "Clean up after the death of a child process, and answer the exit status of the child process." ^ Array with: childPid with: nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 7/22/2000 17:20'! primGetCurrentWorkingDirectory "Call getcwd() to get the current working directory." "OSProcess thisOSProcess processAccessor primGetCurrentWorkingDirectory" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 4/30/2001 21:07'! primGetEGid "Answer the effective group ID for the OS process in which I am currently executing." "OSProcess accessor primGetEGid" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 4/30/2001 21:01'! primGetEUid "Answer the effective user ID for the OS process in which I am currently executing." "OSProcess accessor primGetEUid" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 4/30/2001 21:01'! primGetGid "Answer the group ID for the OS process in which I am currently executing." "OSProcess accessor primGetGid" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/15/2007 19:43'! primGetPGid: pid "Answer the process group ID of the process identified by pid" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/15/2007 19:39'! primGetPGrp "Answer the process group ID of this OS process" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 7/22/2000 17:20'! primGetPPid "Answer the OS process ID for the parent process of the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 7/22/2000 17:20'! primGetPid "Answer the OS process ID for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/2/2002 08:15'! primGetSession "Answer the unique identifier for this session of Smalltalk running in this OS Process." "OSProcess accessor primGetSession" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:28'! primGetStdErrHandle "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 15:34'! primGetStdErrHandleWithSessionIdentifier: aByteArray "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:28'! primGetStdInHandle "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 15:41'! primGetStdInHandleWithSessionIdentifier: aByteArray "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:28'! primGetStdOutHandle "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 15:41'! primGetStdOutHandleWithSessionIdentifier: aByteArray "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'pthreads' stamp: 'dtl 3/5/2006 10:51'! primGetThreadID "Answer the ID of the pthread that is currently executing (the interpreter thread). A thread ID may be a 64 bit value on some platforms, so answer a byte array containing the value in machine-dependent byte order." "OSProcess accessor primGetThreadID" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 4/30/2001 21:00'! primGetUid "Answer the user ID for the OS process in which I am currently executing." "OSProcess accessor primGetUid" ^ nil! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/3/2003 18:27'! primGetXDisplayName "Answer a string containing the name for the X display, or nil if the display was opened using the $DISPLAY environment variable. This answers the name of the X display as of the time it was last opened, which may be different from the current setting of $DISPLAY." "OSProcess accessor primGetXDisplayName" ^ self oldPrimGetXDisplayName ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 4/7/2007 19:32'! primIsAtEndOfFile: aSqFileStruct "Answer whether the file represented by aSqFileStruct is at end of file, as determined by a call to feof(). This is different from StandardFileStream>>primAtEnd: which answers true if the file pointer is at the end of the file, but which does not call feof() to determine that an end of file condition has occurred. The difference is significant if aSqFileStruct represents a pipe or a device file, which may not be positionable in the sense of a conventional disk file." "WARNING: Do not use this method. In some versions of OSPP, the sense of the return value is reversed. Use #primTestEndOfFileFlag: instead. This method is retained to support use of older versions of OSPP." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/3/2003 18:29'! primIsConnectedToXServer "Answer true if VM is currently connected to an X server." "OSProcess accessor primIsConnectedToXServer inspect" "| x | OSProcess accessor primKillDisplay. x := OSProcess accessor primIsConnectedToXServer. OSProcess accessor primOpenXDisplay. x inspect" ^ self oldPrimIsConnectedToXServer ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/18/2007 10:35'! primKill: listOfPids withSignal: signumOrNil "Set a list of pids to kill with signum when VM exits. If the signum parameter is nil, the default value of SIGTERM will be used." ^ self primitiveFailed! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/6/2003 06:22'! primKillDisplay "Disconnect the X display session and destroy the Squeak window on the X display." "OSProcess thisOSProcess processAccessor primKillDisplay" ^ self oldPrimKillDisplay ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 1/3/2004 19:59'! primLockFileRegion: aSQFileStruct offset: begin length: len exclusive: flag "Pass a struct SQFile on the stack, and request a lock on the specified region. If the exclusive flag is true, then request an exclusive (F:=WRLCK) lock on the file. Otherwise, request a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). Answer the result of the call to fcntl()." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 7/22/2000 17:28'! primMakePipe "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 3/3/2002 15:22'! primMakePipeWithSessionIdentifier: aByteArray "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'fork and exec' stamp: 'dtl 10/8/2005 09:55'! primNice: inc "Change the scheduling priority of this OS process by the given nice increment." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 11:48'! primOSProcessPluginModuleName "Answer a string containing the module name string for the OSPP plugin." "OSProcess accessor primOSProcessPluginModuleName" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 11:48'! primOSProcessPluginModuleVersionString "Answer a string containing the version string for the OSPP plugin." "OSProcess accessor primOSProcessPluginModuleVersionString" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 2/18/2004 19:08'! primOldForkSqueak "Clone this Squeak Smalltalk image in a child OSProcess. The child is the same as the parent, except for its new X session connection, and the return value of this method, which is zero for the child process, and a positive integer equal to the pid of the child for the parent process. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/3/2003 18:31'! primOpenXDisplay "Call an internal function which will open the X display session." "OSProcess thisOSProcess processAccessor primKillDisplay. (Delay forSeconds: 5) wait. OSProcess thisOSProcess processAccessor primOpenXDisplay" ^ self oldPrimOpenXDisplay ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:28'! primPutEnv: aString "Add or update an environment variable in the external OS process using a 'KEY=value' string." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/31/2001 15:44'! primRealpath: pathString "Resolve pathString into a real path if possible, or answer nil." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:28'! primSQFileFlush: aSQFileStruct "Pass a struct SQFile on the stack, flush the external file stream." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 16:30'! primSQFileFlush: aSQFileStruct withSessionIdentifier: aByteArray "Pass a struct SQFile on the stack, flush the external file stream." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:29'! primSQFileSetBlocking: aSQFileStruct "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 16:30'! primSQFileSetBlocking: aSQFileStruct withSessionIdentifier: aByteArray "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:29'! primSQFileSetNonBlocking: aSQFileStruct "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 16:31'! primSQFileSetNonBlocking: aSQFileStruct withSessionIdentifier: aByteArray "Pass a struct SQFile on the stack, and call fcntl() to set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 7/22/2000 17:29'! primSQFileSetUnbuffered: aSQFileStruct "Pass a struct SQFile on the stack, set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 3/3/2002 16:31'! primSQFileSetUnbuffered: aSQFileStruct withSessionIdentifier: aByteArray "Pass a struct SQFile on the stack, set the file non-blocking." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 8/4/2002 01:13'! primSemaIndexFor: sigNum "Answer the registration index of the semaphore currently associated with the signal handler for sigNum." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:24'! primSendSigabrtTo: anIntegerPid "Send SIGABRT (abort) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:24'! primSendSigalrmTo: anIntegerPid "Send SIGALRM (alarm) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:24'! primSendSigchldTo: anIntegerPid "Send SIGCHLD (child status has changed, usually death of child) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSigcontTo: anIntegerPid "Send SIGCONT (continue) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSighupTo: anIntegerPid "Send SIGHUP (hangup) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSigintTo: anIntegerPid "Send SIGINT (interrupt) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSigkillTo: anIntegerPid "Send SIGKILL (kill, unblockable) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSigpipeTo: anIntegerPid "Send SIGPIPE (broken pipe) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSigquitTo: anIntegerPid "Send SIGQUIT (quit) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:25'! primSendSigstopTo: anIntegerPid "Send SIGSTOP (stop, unblockable) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:26'! primSendSigtermTo: anIntegerPid "Send SIGTERM (termination) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:26'! primSendSigusr1To: anIntegerPid "Send SIGUSR1 (User-defined signal 1) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'OS signal sending' stamp: 'dtl 7/22/2000 17:26'! primSendSigusr2To: anIntegerPid "Send SIGUSR2 (User-defined signal 2) to the OS process identified by anIntegerPid. Answer 0 on success, -1 on failure, and nil if the pluggable primitive is not present." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/15/2007 19:47'! primSet: pid pGid: processGroupId "Set the process group ID of the process identified by pid to a new process group ID." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/15/2007 19:40'! primSetPGrp "Set a new process group for this OS process. Newly created child processes will be members of the new process group." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 7/22/2000 17:29'! primSetSemaIndex: anInteger "Tell the virtual machine what semaphore to use when handling a death of child signal." ^ anInteger! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/18/2007 10:50'! primSetSid "Quoted from Linux man pages: setsid() creates a new session if the calling process is not a process group leader. The calling process is the leader of the new session, the process group leader of the new process group, and has no controlling tty. The process group ID and session ID of the calling process are set to the PID of the calling process. The calling process will be the only process in this new process group and in this new session." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'display handling' stamp: 'dtl 8/3/2003 18:32'! primSetXDisplayName: aStringOrNil "Set the name for the X display for use in the next call to primitiveOpenXDisplay. aStringOrNil must be either a String (such as 'myhost:0') or nil, indicating that the current value of $DISPLAY should be used." "OSProcess accessor primSetXDisplayName: ':0.0' " "OSProcess accessor primSetXDisplayName: nil " ^ self oldPrimSetXDisplayName: aStringOrNil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 8/3/2002 20:36'! primSigChldNumber "Integer value corresponding to SIGCHLD" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 12/6/2002 18:04'! primSigHupNumber "Integer value corresponding to SIGHUP" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 8/4/2002 00:19'! primSigIntNumber "Integer value corresponding to SIGINT" "OSProcess accessor primSigIntNumber" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 12/6/2002 18:05'! primSigKillNumber "Integer value corresponding to SIGKILL" "OSProcess accessor primSigKillNumber" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 8/3/2002 20:35'! primSigPipeNumber "Integer value corresponding to SIGPIPE" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 12/6/2002 18:06'! primSigQuitNumber "Integer value corresponding to SIGQUIT" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 12/6/2002 18:06'! primSigTermNumber "Integer value corresponding to SIGTERM" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 11/4/2005 06:41'! primSigUsr1Number "Integer value corresponding to SIGUSR1" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - signal forwarding' stamp: 'dtl 11/4/2005 06:42'! primSigUsr2Number "Integer value corresponding to SIGUSR2" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 8/7/2005 12:33'! primSizeOfInt "Size of an integer for this C compiler on this machine." ^ self primitiveFailed ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 8/7/2005 12:33'! primSizeOfPointer "Size of a void pointer for this C compiler on this machine." ^ self primitiveFailed ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 4/7/2007 19:31'! primTestEndOfFileFlag: aSqFileStruct "Answer whether the file represented by aSqFileStruct is at end of file, as determined by a call to feof(). This is different from StandardFileStream>>primAtEnd: which answers true if the file pointer is at the end of the file, but which does not call feof() to determine that an end of file condition has occurred. The difference is significant if aSqFileStruct represents a pipe or a device file, which may not be positionable in the sense of a conventional disk file." ^ self primIsAtEndOfFile: aSqFileStruct ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 1/4/2004 15:29'! primTestLockableFileRegion: aSQFileStruct offset: begin length: len exclusive: flag "Pass a struct SQFile on the stack, and check for ability to lock the specified region. If the exclusive flag is true, then specify an exclusive (F:=WRLCK) lock on the file. Otherwise, specify a shared (F:=RDLCK) lock. Any number of Unix processes may hold a read lock (shared lock) on a file region, but only one process may hold a write lock (exclusive lock). If length is zero, then the request is for the entire file to be locked, including region extents that have not yet been allocated for the file. If the fcntl() call fails, answer -1 (the result of the failed call). Otherwise, answer an array with the following six fields: lockable (true or false) l:=pid (pid of the process preventing this lock request, or nil) l:=type (request type F:=WRLCK or F:=RDLOCK of the process preventing this lock request) l:=whence (the SEEK:=SET, SEEK:=CUR, or SEEK:=END value of the lock preventing this lock request). l:=start (offset of the region lock preventing this lock request) l:=len (length of the region lock preventing this lock request)" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 2/11/2001 16:23'! primUnixFileNumber: aSQFileStruct "Pass a struct SQFile on the stack, and answer the corresponding Unix file number." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 1/3/2004 23:08'! primUnlockFileRegion: aSQFileStruct offset: begin length: len "Pass a struct SQFile on tthe stack, and unlock the specified region. Answer the result of the call to fcntl(). If the region is in the file lock cache, remove it, but otherwise ignore the cache. The cache supports Win32 semantics within a single Squeak image, but not across separate images, therefore the unlock should be attempted regardless of whether this image thinks that the region has previously been locked. Answer the result of the call to fcntl()." ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/7/2001 00:37'! primUnsetEnv: aKeyString "Remove an environment variable from the external OS process environment." ^ nil! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 8/30/2003 18:29'! primXDisplayControlPluginModuleName "Answer a string containing the module name string for the display control plugin." "OSProcess accessor primXDisplayControlPluginModuleName" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 8/30/2003 18:32'! primXDisplayControlPluginModuleVersionString "Answer a string containing the version string for the display control plugin." "OSProcess accessor primXDisplayControlPluginModuleVersionString" ^ nil ! ! !UnixOSProcessAccessor methodsFor: 'printing' stamp: 'dtl 9/10/2000 10:16'! printOn: aStream "In English, say 'a Unix' rather than 'an Unix'. Therefore do not use super printOn, which treats $U as a vowel." aStream nextPutAll: 'a '; nextPutAll: self class name; nextPutAll: ' on pid '; nextPutAll: self primGetPid printString ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/10/2000 11:59'! putPath: aString "Convenience method. Set the environment PATH variable to aString." | pathString | pathString := 'PATH=', aString, ((Character value: 0) asString). ^ self environmentPut: pathString ! ! !UnixOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 10/6/2001 10:04'! realpath: pathString "Get the real path for pathString from the external OS process." "OSProcess accessor realpath: '/tmp'" "OSProcess accessor realpath: FileDirectory default pathName" "OSProcess accessor realpath: '/bogus/path/name'" ^ self primRealpath: pathString ! ! !UnixOSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 3/5/2005 13:10'! register: fileRegionLock "If an object equal to fileRegionLock exists in the registry, answer it. Otherwise, add fileRegionLock to the registry and answer fileRegionLock. Caching is enabled when EmulateWin32FileLocking is true." ^ self emulateWin32FileLocking ifTrue: [super register: fileRegionLock] ifFalse: [fileRegionLock] ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:45'! restoreSigChld "Unset a SIGCHLD signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigChld" ^ self restoreSignal: self primSigChldNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:47'! restoreSigHup "Unset a SIGHUP signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigHup" ^ self restoreSignal: self primSigHupNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:46'! restoreSigInt "Unset a SIGINT signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigInt" ^ self restoreSignal: self primSigIntNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:48'! restoreSigKill "Unset a SIGKILL signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigKill" self notify: 'SIGKILL and SIGSTOP signals cannot be caught, see man signal(2)'. ^ self restoreSignal: self primSigIntNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:48'! restoreSigPipe "Unset a SIGPIPE signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigPipe" ^ self restoreSignal: self primSigPipeNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:49'! restoreSigQuit "Unset a SIGQUIT signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigQuit" ^ self restoreSignal: self primSigQuitNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:49'! restoreSigTerm "Unset a SIGTERM signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigTerm" ^ self restoreSignal: self primSigTermNumber ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:49'! restoreSigUsr1 "Unset a SIGUSR1 signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigUsr1" ^ self restoreSignal: self primSigUsr1Number ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 11/4/2005 06:50'! restoreSigUsr2 "Unset a SIGUSR2 signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSigUsr2" ^ self restoreSignal: self primSigUsr2Number ! ! !UnixOSProcessAccessor methodsFor: 'signal forwarding' stamp: 'dtl 12/28/2002 15:33'! restoreSignal: signalNumber "Unset a signal handler and unregister the Smalltalk semaphore. Answer the unregistered Semaphore, or nil if unable to restore the signal (possibly because no handler had been set)." "OSProcess accessor restoreSignal: OSProcess accessor primSigIntNumber" | semaphoreIndex sema | semaphoreIndex := self primSemaIndexFor: signalNumber. semaphoreIndex ifNotNil: [sema := Smalltalk externalObjects at: semaphoreIndex ifAbsent: []. sema ifNotNil: [self primForwardSignal: signalNumber toSemaphore: nil. Smalltalk unregisterExternalObject: sema]]. ^ sema ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 3/3/2002 16:33'! setBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set for blocking I/O." ^ self canObtainSessionIdentifierFromPlugin ifTrue: [self primSQFileSetBlocking: (self handleFromAccessor: anIOHandle)] ifFalse: [self primSQFileSetBlocking: (self handleFromAccessor: anIOHandle) withSessionIdentifier: self sessionIdentifier] ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 3/3/2002 16:34'! setNonBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set it non-blocking." ^ self canObtainSessionIdentifierFromPlugin ifTrue: [self primSQFileSetNonBlocking: (self handleFromAccessor: anIOHandle)] ifFalse: [self primSQFileSetNonBlocking: (self handleFromAccessor: anIOHandle) withSessionIdentifier: self sessionIdentifier] ! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 3/3/2002 16:34'! setUnbuffered: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set unbuffered I/O." ^ self canObtainSessionIdentifierFromPlugin ifTrue: [self primSQFileSetUnbuffered: (self handleFromAccessor: anIOHandle)] ifFalse: [self primSQFileSetUnbuffered: (self handleFromAccessor: anIOHandle) withSessionIdentifier: self sessionIdentifier] ! ! !UnixOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 1/25/2004 21:31'! sigChldSemaphore "Answer the value of sigChldSemaphore" ^ sigChldSemaphore ifNil: [sigChldSemaphore := self forwardSigChld]. ! ! !UnixOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 1/25/2004 21:29'! sigChldSemaphore: anObject "Set the value of sigChldSemaphore" sigChldSemaphore := anObject! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 3/25/2001 15:34'! sizeOfInt "Size of an integer on this machine with this C compiler." ^ self primSizeOfInt! ! !UnixOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 3/25/2001 20:55'! sizeOfPointer "Size of a void pointer on this machine with this C compiler." ^ self primSizeOfPointer! ! !UnixOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 10/6/2001 07:27'! unixFileNumber: anIOHandle "Answer the integer Unix file number corresponding to anIOHandle." ^ anIOHandle ifNotNil: [self primUnixFileNumber: (self handleFromAccessor: anIOHandle)] ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 4/10/2005 15:17'! unlockAllForFile: aFileStream "Unlock and uncache all locks associated with aFileStream. This could be called before closing a stream, for example." (self registeredLocksForFile: aFileStream) do: [:ea | self unlockFileRegion: ea] ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/22/2004 15:02'! unlockFile: aFileStream "Unlock the file represented by aFileStream. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self unlockFile: aFileStream exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'jf 2/22/2004 17:30'! unlockFile: aFileStream exclusive: flag "Unlock the file represented by aFileStream. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileLock | aFileStream ifNil: [^ nil]. fileLock := OSFileLock onFile: aFileStream exclusive: flag. ^ self unlockFileRegion: fileLock ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/12/2006 07:05'! unlockFile: aFileStream exclusive: flag ifFail: failBlock "Unlock the file represented by aFileStream. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileLock | aFileStream ifNil: [^ failBlock value]. fileLock := OSFileLock onFile: aFileStream exclusive: flag. ^ self unlockFileRegion: fileLock ifFail: failBlock ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/22/2004 15:01'! unlockFile: aFileStream from: start to: end "Pass a struct SQFile on the stack, and unlock the specified region. Answer the result of the call to fcntl(). If the region is in the file lock cache, remove it, but otherwise ignore the cache. The cache supports Win32 semantics within a single Squeak image, but not across separate images, therefore the unlock should be attempted regardless of whether this image thinks that the region has previously been locked. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self unlockFile: aFileStream from: start to: end exclusive: true ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 2/22/2004 15:09'! unlockFile: aFileStream from: start to: end exclusive: flag "Pass a struct SQFile on the stack, and unlock the specified region. Answer the result of the call to fcntl(). If the region is in the file lock cache, remove it, but otherwise ignore the cache. The cache supports Win32 semantics within a single Squeak image, but not across separate images, therefore the unlock should be attempted regardless of whether this image thinks that the region has previously been locked. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileRegion | aFileStream ifNil: [^ nil]. fileRegion := OSFileRegionLock onFile: aFileStream from: start to: end exclusive: flag. ^ self unlockFileRegion: fileRegion ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/12/2006 07:06'! unlockFile: aFileStream ifFail: failBlock "Unlock the file represented by aFileStream. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self unlockFile: aFileStream exclusive: true ifFail: failBlock ! ! !UnixOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 2/22/2004 15:09'! unlockFile: aFileStream region: anInterval "Pass a struct SQFile on the stack, and unlock the specified region. Answer the result of the call to fcntl(). If the region is in the file lock cache, remove it, but otherwise ignore the cache. The cache supports Win32 semantics within a single Squeak image, but not across separate images, therefore the unlock should be attempted regardless of whether this image thinks that the region has previously been locked. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." | fileRegion | aFileStream ifNil: [^ nil]. fileRegion := OSFileRegionLock onFile: aFileStream interval: anInterval exclusive: true. ^ self unlockFileRegion: fileRegion ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/8/2006 07:12'! unlockFileRegion: aFileLock "Pass a struct SQFile on the stack, and unlock the specified region. Answer the result of the call to fcntl(). If the region is in the file lock cache, remove it, but otherwise ignore the cache. The cache supports Win32 semantics within a single Squeak image, but not across separate images, therefore the unlock should be attempted regardless of whether this image thinks that the region has previously been locked. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." ^ self unlockFileRegion: aFileLock ifFail: [nil] ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/12/2006 07:27'! unlockFileRegion: fileStream from: start to: end exclusive: writeLockFlag ifFail: failBlock | lock | lock := OSFileRegionLock onFile: fileStream from: start to: end exclusive: writeLockFlag. ^ self unlockFileRegion: lock ifFail: [failBlock value]! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/12/2006 07:28'! unlockFileRegion: fileStream from: start to: end ifFail: failBlock ^ self unlockFileRegion: fileStream from: start to: end exclusive: true ifFail: failBlock ! ! !UnixOSProcessAccessor methodsFor: 'file locking' stamp: 'dtl 5/20/2006 12:46'! unlockFileRegion: aFileLock ifFail: failBlock "Pass a struct SQFile on the stack, and unlock the specified region. Answer the result of the call to fcntl(). If the region is in the file lock cache, remove it, but otherwise ignore the cache. The cache supports Win32 semantics within a single Squeak image, but not across separate images, therefore the unlock should be attempted regardless of whether this image thinks that the region has previously been locked. Answer a descriptor for the unlocked file region, an Array of file handle and region interval; or answer nil on error or if the region did not appear in the cache. Warning: The registry permits compatibility with Win32 file locking semantics, but only within a single Squeak image. Multiple cooperating images must not rely on the overlap checking, because the registry is local to this image and cannot be shared across images in different OS process contexts." aFileLock ifNil: [^ failBlock value]. "Check region lock overlap for Win32 compatibility" self emulateWin32FileLocking ifTrue: [ | unregisteredLock | (unregisteredLock := self unregister: aFileLock) ifNil: [^ failBlock value] ifNotNil: [unregisteredLock unlock ifTrue: [^ unregisteredLock] ifFalse: [^ failBlock value]]] ifFalse: [aFileLock unlock ifTrue: [^ aFileLock] ifFalse: [^ failBlock value]] ! ! !UnixOSProcessAccessor methodsFor: 'file lock registry' stamp: 'dtl 3/5/2005 13:10'! unregister: fileRegionLock "If an object equal to fileRegionLock exists in the registry, remove it and answer the object. Otherwise answer nil. Caching is enabled when EmulateWin32FileLocking is true." ^ self emulateWin32FileLocking ifTrue: [super unregister: fileRegionLock] ifFalse: [nil] ! ! !UnixOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:45'! xdcpModuleName "Answer a string containing the module name string for the display control plugin." "OSProcess accessor xdcpModuleName" ^ self primXDisplayControlPluginModuleName ! ! !UnixOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 10:46'! xdcpVersionString "Answer a string containing the version string for the display control plugin." "OSProcess accessor xdcpVersionString" ^ self primXDisplayControlPluginModuleVersionString ! ! OSProcessAccessor subclass: #WindowsOSProcessAccessor instanceVariableNames: 'sigChldSemaphore semaIndex grimReaper childWatcherThread' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Win32'! !WindowsOSProcessAccessor commentStamp: '' prior: 0! I provide access to an operating system process, such as the process in which the Squeak VM is currently running. I am based on the Win32 process model for Windows and Windows NT.! !WindowsOSProcessAccessor class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:50'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ OSProcess isWindows ! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/26/2002 16:11'! activeHandles "Answer an Array of handles for all children that are believed to be running." ^ OSProcess thisOSProcess activeHandles ! ! !WindowsOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 9/10/2002 09:24'! canAccessChildProcess: anExternalProcess "Is the child process still there? Maybe not if we have restarted the image and anExternalProcess refers to a process which died while we were not watching." | handle | ^ (handle := anExternalProcess handle) notNil ifTrue: [self primCanAccessChildProcess: handle] ifFalse: [false] ! ! !WindowsOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 2/22/2002 22:17'! canAccessSystem "Answer true if it is possible to access the external process, else false. Failure to access the external process is probably due to lack of a UnixOSProcessPlugin module." ^ self primGetPid notNil ! ! !WindowsOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 2/27/2002 11:56'! childWatcherThread "A thread which signals my sigChldSemaphore when any child process exits." ^ childWatcherThread! ! !WindowsOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 2/27/2002 11:44'! childWatcherThread: aThreadObject "A thread which signals my sigChldSemaphore when any child process exits." childWatcherThread := aThreadObject ! ! !WindowsOSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 2/26/2002 08:43'! finalize "Clean up grimReaper and associated semaphore." grimReaper ifNotNil: [grimReaper terminate. grimReaper := nil]. sigChldSemaphore ifNotNil: [Smalltalk unregisterExternalObject: sigChldSemaphore. sigChldSemaphore := nil]. semaIndex := nil ! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/27/2002 13:22'! getMainThread "Answer the main thread of this OS process. The handle for this thread is a pseudo-handle, and cannot be used to terminate the thread." "OSProcess accessor getMainThread" ^ WindowsThread threadID: self primGetPid handle: self primGetPidHandle running: true ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/7/2002 20:09'! getStdErr "Answer an IO handle (representing a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing, or nil if the IO handle cannot be obtained." "OSProcess accessor getStdErr" | error | error := self primGetStdErrorForSession: self sessionIdentifier. ^ (error notNil and: [error last]) ifTrue: [self ioAccessorFromSQFile: error first] ifFalse: [nil] ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:11'! getStdErrHandle "Answer the handle (a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing." ^ self ioAccessorFromSQFile: self getStdErr ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/7/2002 20:11'! getStdIn "Answer an IO handle (representing a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing, or nil if the IO handle cannot be obtained." "OSProcess accessor getStdIn" | input | input := self primGetStdInputForSession: self sessionIdentifier. ^ (input notNil and: [input last]) ifTrue: [self ioAccessorFromSQFile: input first] ifFalse: [nil] ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:10'! getStdInHandle "Answer the handle (a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing." ^ self ioAccessorFromSQFile: self getStdIn ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/7/2002 20:11'! getStdOut "Answer an IO handle (representing a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing, or nil if the IO handle cannot be obtained." "OSProcess accessor getStdOut" | output | output := self primGetStdOutputForSession: self sessionIdentifier. ^ (output notNil and: [output last]) ifTrue: [self ioAccessorFromSQFile: output first] ifFalse: [nil] ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/25/2005 16:09'! getStdOutHandle "Answer the handle (a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing." ^ self ioAccessorFromSQFile: self getStdOut ! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:14'! grimReaperProcess "This is a process which waits for the death of a child OSProcess, and informs any dependents of the change." grimReaper ifNil: [grimReaper := [ [self sigChldSemaphoreSet wait. self changed: #childProcessStatus] repeat] fork]. ^ grimReaper! ! !WindowsOSProcessAccessor methodsFor: 'initialize - release' stamp: 'dtl 3/2/2002 08:33'! initialize "Create and register a semaphore to be used for signaling external process exits" super initialize. self sigChldSemaphoreSet. self grimReaperProcess ! ! !WindowsOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 9/26/2005 07:45'! isExecutable: aPathName "Answer true if file at aPathName has execute permission for this process." "FIXME: Default to true for Windows" ^ true ! ! !WindowsOSProcessAccessor methodsFor: 'nonblocking read' stamp: 'dtl 10/1/2005 09:26'! lastReadFor: aSemaphoreIndex "A character has been read into an external buffer corresponding to aSemaphoreIndex, and is now available. Answer integer value of the character, or nil if no character was read, or -1 if an error occurred on the read." | c readResult | readResult := Array new: 3. c := self primLastReadFor: aSemaphoreIndex storeIn: readResult. (c < 1) ifTrue: [self error: 'primLastReadFor: error, returned negative value']. ^ c ! ! !WindowsOSProcessAccessor methodsFor: 'nonblocking read' stamp: 'dtl 10/1/2005 09:26'! lastReadFor: aSemaphoreIndex storeIn: aThreeElementArray "A character has been read into an external buffer corresponding to aSemaphoreIndex, and is now available. Answer integer value of the character, or nil if no character was read, or -1 if an error occurred on the read. The results of the read call are stored in aThreeElementArray as a side effect." ^ self primLastReadFor: aSemaphoreIndex storeIn: aThreeElementArray ! ! !WindowsOSProcessAccessor methodsFor: 'nonblocking read' stamp: 'dtl 4/1/2002 11:02'! nextFrom: aFileStream signaling: aSemaphoreIndex "Read the next character from aFileStream into a buffer in the VM. When the read completes, signal the specified Semaphore to notify that the character is available." | sqFile | sqFile := UseIOHandle ifTrue: [aFileStream ioHandle handle] ifFalse: [aFileStream fileID]. ^ self primNextFrom: sqFile signaling: aSemaphoreIndex ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/7/2002 20:03'! openStdErr "Answer an IO handle (representing a SQFile data structure in interp.c) for the standard error for the OS process in which I am currently executing. Open a console if necessary to make standard error available." "OSProcess accessor openStdErr" | error | error := self primGetStdErrorForSession: self sessionIdentifier. error ifNil: [^ nil]. error last ifFalse: [self primAllocConsole. error := self primGetStdOutputForSession: self sessionIdentifier]. ^ self ioAccessorFromSQFile: error first ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/7/2002 20:04'! openStdIn "Answer an IO handle (representing a SQFile data structure in interp.c) for the standard input for the OS process in which I am currently executing. Open a console if necessary to make standard input available." "OSProcess accessor openStdIn" | input | input := self primGetStdInputForSession: self sessionIdentifier. input ifNil: [^ nil]. input last ifFalse: [self primAllocConsole. input := self primGetStdOutputForSession: self sessionIdentifier]. ^ self ioAccessorFromSQFile: input first ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/7/2002 20:05'! openStdOut "Answer an IO handle (representing a SQFile data structure in interp.c) for the standard output for the OS process in which I am currently executing. Open a console if necessary to make standard input available." "OSProcess accessor openStdOut" | output | output := self primGetStdOutputForSession: self sessionIdentifier. output ifNil: [^ nil]. output last ifFalse: [self primAllocConsole. output := self primGetStdOutputForSession: self sessionIdentifier]. ^ self ioAccessorFromSQFile: output first ! ! !WindowsOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 11:46'! osppModuleName "Answer a string containing the module name string for the OSPP plugin." "OSProcess accessor osppModuleName" ^ self primOSProcessPluginModuleName ! ! !WindowsOSProcessAccessor methodsFor: 'plugin identification' stamp: 'dtl 10/1/2005 11:46'! osppModuleVersionString "Answer a string containing the version string for the OSPP plugin." "OSProcess accessor osppModuleVersionString" ^ self primOSProcessPluginModuleVersionString ! ! !WindowsOSProcessAccessor methodsFor: 'console' stamp: 'dtl 3/25/2002 06:28'! primAllocConsole "Allocate a console if not already allocated." "OSProcess accessor primAllocConsole" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 8/17/2002 12:46'! primBufferValuesAt: aSemaphoreIndex "For debugging only. Answer the current values of readCharBufferArray, readCharCountArray, and readCharStatusArray at index, an integer corresponding to a semaphore for one read handler thread. Answer an Array with the buffered character, the character count, and the status value." "OSProcess accessor primBufferValuesAt: 1" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 9/10/2002 09:19'! primCanAccessChildProcess: handleObject "Answer true if the OS process represented by a HANDLE can be accessed by this OS process." ^ false! ! !WindowsOSProcessAccessor methodsFor: 'handles' stamp: 'dtl 2/25/2002 07:37'! primCloseHandle: handleObject "Close the specified handle, which may refer to a process, a thread, or some other Win32 object." "| procInfo | procInfo := OSProcess accessor primCommand: 'SOL'. OSProcess accessor primCloseHandle: procInfo first" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 9/9/2002 09:24'! primCommand: commandString "Run a command in a new external process. Answer a result array with hProcess, hThread, dwProcessId, dwThreadId. This primitive has been replaced by #primCommand:stdIn:stdOut:stdErr:, and will be removed in future versions of OSProcess." "OSProcess accessor primCommand: 'C:\WINDOWS\SOL'" "OSProcess accessor primCommand: 'SOL'" "OSProcess accessor primCommand: 'NoSuchProgram'" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'process creation' stamp: 'dtl 9/9/2002 09:19'! primCommand: commandString stdIn: inputFileIoHandle stdOut: outputFileIoHandle stdErr: errorFileIoHandle "Run a command in a new external process. The standard input, output and error stream handles are sqFile byte arrays (not Win32 HANDLE arrays), and may be nil. Answer a result array with hProcess, hThread, dwProcessId, dwThreadId." "OSProcess accessor primCommand: 'C:\WINDOWS\SOL' stdIn: nil stdOut: nil stdErr: nil" "OSProcess accessor primCommand: 'SOL' stdIn: nil stdOut: nil stdErr: nil" "OSProcess accessor primCommand: 'NoSuchProgram' stdIn: nil stdOut: nil stdErr: nil" "OSProcess accessor primCommand: 'SOL' stdIn: (FileStream fileNamed: 'output.tmp') fileID stdOut: nil stdErr: nil" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'pipe open' stamp: 'dtl 9/10/2005 09:10'! primCreatePipe "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ self primMakePipe "try the older deprecated version"! ! !WindowsOSProcessAccessor methodsFor: 'pipe open' stamp: 'dtl 9/10/2005 09:10'! primCreatePipeWithSessionIdentifier: aByteArray "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ self primMakePipeWithSessionIdentifier: aByteArray "try the older deprecated version"! ! !WindowsOSProcessAccessor methodsFor: 'console' stamp: 'dtl 3/25/2002 06:27'! primFreeConsole "Deallocate the console if allocated." "OSProcess accessor primFreeConsole" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 9/6/2002 14:58'! primGetCurrentWorkingDirectory "Call getcwd() to get the current working directory." "OSProcess accessor primGetCurrentWorkingDirectory" ^ nil ! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/22/2002 18:23'! primGetEnvironmentStrings "Answer the environment block in the form of an Array of Strings. The caller is expected to parse the strings into a dictionary of keys and values." ^ nil ! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/25/2002 08:23'! primGetExitStatusForHandle: handleObject "Answer the exit status for the process represented by a HANDLE. Fail if the process is still active, or if the GetExitCodeProcess call fails." "| procInfo | procInfo := OSProcess accessor primCommand: 'SOL'. (Delay forSeconds: 5) wait. OSProcess accessor primGetExitStatusForHandle: procInfo first" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/27/2002 13:20'! primGetMainThreadHandle "Answer a pseudo-handle for my main thread." "OSProcess accessor primGetMainThreadHandle" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 3/4/2006 17:57'! primGetMainThreadID "Answer the ID of my main thread." "OSProcess accessor primGetMainThreadID" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/22/2002 16:06'! primGetPid "Answer the OS process ID for the OS process in which I am currently executing." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'external process access' stamp: 'dtl 2/27/2002 13:21'! primGetPidHandle "Answer the pseudo-handle for my OS process" "OSProcess accessor primGetPidHandle" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'session identification' stamp: 'dtl 3/2/2002 08:15'! primGetSession "Answer the unique identifier for this session of Smalltalk running in this OS Process." "OSProcess accessor primGetSession" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 9/7/2002 14:55'! primGetStdErrorForSession: sessionIdentifierByteArray "Answer a two element array containing the sqFile data structure representing standard error stream for my OS process, and a flag (true or false) to indicate whether the sqFile data structure contains a valid HANDLE. If no standard error stream is available for this OS process, the sqFile data structure will contain an invalid HANDLE value, which will result in failures on subsequent accesses." "OSProcess accessor primGetStdError" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 9/7/2002 14:55'! primGetStdInputForSession: sessionIdentifierByteArray "Answer a two element array containing the sqFile data structure representing standard input stream for my OS process, and a flag (true or false) to indicate whether the sqFile data structure contains a valid HANDLE. If no standard input stream is available for this OS process, the sqFile data structure will contain an invalid HANDLE value, which will result in failures on subsequent accesses." "OSProcess accessor primGetStdInput" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 9/7/2002 14:55'! primGetStdOutputForSession: sessionIdentifierByteArray "Answer a two element array containing the sqFile data structure representing standard output stream for my OS process, and a flag (true or false) to indicate whether the sqFile data structure contains a valid HANDLE. If no standard output stream is available for this OS process, the sqFile data structure will contain an invalid HANDLE value, which will result in failures on subsequent accesses." "OSProcess accessor primGetStdOutput" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 09:26'! primLastReadFor: aSemaphoreIndex "A character has been read into an external buffer corresponding to aSemaphoreIndex, and is now available. Answer integer value of the character, or nil if no character was read, or -1 if an error occurred on the read." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 09:27'! primLastReadFor: aSemaphoreIndex storeIn: aThreeElementArray "A character has been read into an external buffer corresponding to aSemaphoreIndex, and is now available. Answer integer value of the character, or nil if no character was read, or -1 if an error occurred on the read. Contents of the aThreeElementArray will be status of the read call, character read, and character count (which should always be 1)." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 9/10/2005 09:11'! primMakePipe "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'deprecated' stamp: 'dtl 9/10/2005 09:11'! primMakePipeWithSessionIdentifier: aByteArray "Create a pipe, and answer an array of two file handles (SQFile data structures in interp.c) for the pipe reader and writer." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 4/1/2002 10:58'! primNextFrom: anIOHandle signaling: aSemaphoreIndex "Read the next character from anIOHandle (a SQFile struct) into a buffer in the VM. When the read completes, signal the specified Semaphore to notify that the character is available." ^ nil ! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 11:50'! primOSProcessPluginModuleName "Answer a string containing the module name string for the OSPP plugin." "OSProcess accessor primOSProcessPluginModuleName" ^ nil ! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 10/1/2005 11:51'! primOSProcessPluginModuleVersionString "Answer a string containing the version string for the OSPP plugin." "OSProcess accessor primOSProcessPluginModuleVersionString" ^ nil ! ! !WindowsOSProcessAccessor methodsFor: 'testing' stamp: 'dtl 2/26/2002 11:04'! primOneShot "Anwer true the first time this is called in a Squeak session, and false thereafter." "OSProcess accessor primOneShot" ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'handles' stamp: 'dtl 3/29/2002 17:47'! primSetStdErr: anIOHandle "Set the standard error handle to that of anIOHandle, where anIOHandle is a ByteArray representation of a SQFile structure." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'handles' stamp: 'dtl 3/29/2002 17:48'! primSetStdIn: anIOHandle "Set the standard input handle to that of anIOHandle, where anIOHandle is a ByteArray representation of a SQFile structure." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'handles' stamp: 'dtl 3/29/2002 17:48'! primSetStdOut: anIOHandle "Set the standard output handle to that of anIOHandle, where anIOHandle is a ByteArray representation of a SQFile structure." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/26/2002 16:14'! primSetWaitForAnyProcessExit: arrayOfProcessHandleObjects thenSignalSemaphoreWithIndex: index "Set up a thread to wait for a process HANDLE to exit, then signal the Semaphore at index. This provides asychronous notification of an external process exit." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/27/2002 11:34'! primTerminateThread: aThreadHandle "Kill the thread. No cleanup is performed, so use with caution for a thread which is (for example) manipulating a mutex. Answer true for success, else false." ^ nil! ! !WindowsOSProcessAccessor methodsFor: 'private - primitive access' stamp: 'dtl 4/8/2007 10:54'! primTestEndOfFileFlag: aSqFileStruct "Answer whether the file represented by aSqFileStruct is at end of file, as determined by a call to feof(). This is different from StandardFileStream>>primAtEnd: which answers true if the file pointer is at the end of the file, but which does not call feof() to determine that an end of file condition has occurred. The difference is significant if aSqFileStruct represents a pipe or a device file, which may not be positionable in the sense of a conventional disk file." self flag: 'FIXME'. "not yet implemented in OSPP for Windows" ^ self primitiveFailed ! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 1/13/2007 09:48'! restartChildWatcherThread: arrayOfProcessHandleObjects "Start a new child watcher thread. If a thread is alread active, terminate it before starting a new one." self childWatcherThread ifNotNil: [childWatcherThread terminate]. self childWatcherThread: (self setWaitForAnyProcessExit: arrayOfProcessHandleObjects). ^ childWatcherThread ! ! !WindowsOSProcessAccessor methodsFor: 'accessing' stamp: 'dtl 2/25/2002 21:17'! semaIndex "Index of the registered Semaphore" semaIndex ifNil: [self initialize]. ^ semaIndex! ! !WindowsOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 9/26/2005 07:35'! setBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set for blocking I/O." "FIXME: need to implement this for Win32" "self notify: 'there is no general mechanism to set blocking IO on Win32'" ! ! !WindowsOSProcessAccessor methodsFor: 'file control' stamp: 'dtl 9/26/2005 07:36'! setNonBlocking: anIOHandle "Convert anIOHandle to an SQFile data structure and call primitive to set it non-blocking." "FIXME: need to implement this for Win32" "self notify: 'there is no general mechanism to set nonblocking IO on Win32'" ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/9/2002 07:22'! setStdErr: aFileStream "Set the standard error handle for this OSProcess to be that of aFileStream" "| fs | fs := FileStream fileNamed: 'stdError.tmp'. OSProcess accessor setStdErr: fs" | sqFile | aFileStream ifNil: [^ false]. sqFile := UseIOHandle ifTrue: [aFileStream ioHandle handle] ifFalse: [aFileStream fileID]. ^ self primSetStdErr: sqFile ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/9/2002 07:22'! setStdIn: aFileStream "Set the standard input handle for this OSProcess to be that of aFileStream" "| fs | fs := FileStream fileNamed: 'stdInput.tmp'. fs nextPutAll: 'this is a line of text'; cr. fs position: 0. OSProcess accessor setStdIn: fs" | sqFile | aFileStream ifNil: [^ false]. sqFile := UseIOHandle ifTrue: [aFileStream ioHandle handle] ifFalse: [aFileStream fileID]. ^ self primSetStdIn: sqFile ! ! !WindowsOSProcessAccessor methodsFor: 'standard IO handles' stamp: 'dtl 9/9/2002 07:22'! setStdOut: aFileStream "Set the standard output handle for this OSProcess to be that of aFileStream" "| fs | fs := FileStream fileNamed: 'stdOutput.tmp'. OSProcess accessor setStdOut: fs" | sqFile | aFileStream ifNil: [^ false]. sqFile := UseIOHandle ifTrue: [aFileStream ioHandle handle] ifFalse: [aFileStream fileID]. ^ self primSetStdOut: sqFile ! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/26/2002 19:08'! setWaitForAnyProcessExit: arrayOfProcessHandleObjects "Set up a thread to wait for a process HANDLE to exit, then signal the Semaphore at index. This provides asychronous notification of an external process exit. The caller should close the thread handle when it is no longer needed." "OSProcess command: 'SOL'. OSProcess accessor setWaitForAnyProcessExit: OSProcess thisOSProcess activeHandles." | threadInfo | arrayOfProcessHandleObjects isEmpty ifTrue: [^ nil]. threadInfo := self primSetWaitForAnyProcessExit: arrayOfProcessHandleObjects thenSignalSemaphoreWithIndex: self semaIndex. ^ WindowsThread threadID: threadInfo last handle: threadInfo first running: true ! ! !WindowsOSProcessAccessor methodsFor: 'child process management' stamp: 'dtl 2/25/2002 21:12'! sigChldSemaphoreSet sigChldSemaphore ifNil: [sigChldSemaphore := Semaphore new. semaIndex := Smalltalk registerExternalObject: sigChldSemaphore]. ^ sigChldSemaphore! ! Model subclass: #PseudoAioEventHandler instanceVariableNames: 'eventGenerator' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-AIO'! !PseudoAioEventHandler commentStamp: 'dtl 11/25/2006 10:42' prior: 0! PseudoAioEventHandler is a replacement for AioEventHandler for use when an AioPlugin is not present. It creates a polling loop by generating #changed: events periodically. With a real AioEventHandler, events are generated only when actual IO activity occurs, while the PseudoAioEventHandler produces regularly timed events regardless of whether any actual IO changes have happened.! !PseudoAioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 11/25/2006 10:49'! close "When the FileStream or Socket handled by this aio handler is closed, it should send #close to this handler." eventGenerator ifNotNil: [eventGenerator terminate]! ! !PseudoAioEventHandler methodsFor: 'accessing' stamp: 'dtl 11/25/2006 13:17'! eventGenerator "Answer the value of eventGenerator" ^ eventGenerator ifNil: [eventGenerator := self eventGeneratorProcess]! ! !PseudoAioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 11/25/2006 13:38'! eventGeneratorProcess "A process that generates periodic #changed events" | d | d := Delay forMilliseconds: 125. ^ [[self changed. d wait] repeat] fork! ! !PseudoAioEventHandler methodsFor: 'initialize-release' stamp: 'dtl 11/25/2006 13:15'! initialize self eventGenerator. ^ super initialize! ! Stream subclass: #ExternalPipe instanceVariableNames: 'writer reader blocking' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !ExternalPipe commentStamp: 'dtl 3/10/2006 11:06' prior: 0! I represent a pipe provided by the underlying operating system, such as a Unix pipe. I have a reader stream and a writer stream which behave similarly to a read-only FileStream and a writeable FileStream. Subclasses implement buffering behavior for the reader end of a pipe.! !ExternalPipe class methodsFor: 'instance creation' stamp: 'dtl 4/2/2006 21:34'! blockingPipe "Warning: a read on a blocking pipe will hang the VM if there is insufficient data in the pipe to fulfill the read request." "OSPipe blockingPipe" ^ super basicNew initialize; setBlocking ! ! !ExternalPipe class methodsFor: 'instance creation' stamp: 'dtl 4/2/2006 21:34'! bufferedBlockingPipe "Warning: a read on a blocking pipe will hang the VM if there is insufficient data in the pipe to fulfill the read request." "OSPipe bufferedBlockingPipe" ^ (super basicNew initialize; setBlocking) setBufferedReader; yourself ! ! !ExternalPipe class methodsFor: 'instance creation' stamp: 'dtl 4/2/2006 21:33'! bufferedNonBlockingPipe "OSPipe bufferedNonBlockingPipe" ^ (super basicNew initialize; setNonBlocking) setBufferedReader; yourself ! ! !ExternalPipe class methodsFor: 'instance creation' stamp: 'dtl 4/2/2006 21:35'! new "ExternalPipe new" ^ self nonBlockingPipe ! ! !ExternalPipe class methodsFor: 'instance creation' stamp: 'dtl 3/25/2006 14:14'! nonBlockingPipe "OSPipe nonBlockingPipe" ^ super basicNew initialize; setNonBlocking ! ! !ExternalPipe class methodsFor: 'examples' stamp: 'dtl 3/7/2006 19:44'! testPipe "OSPipe testPipe inspect" | pipe result | pipe := self new. pipe nextPutAll: 'string to send through an OSPipe'. pipe writer close. result := pipe upToEnd. pipe close. ^ result ! ! !ExternalPipe methodsFor: 'testing' stamp: 'dtl 4/2/2006 21:14'! atEnd "Answer whether the receiver can access any more objects." ^ writer closed and: [self peek == nil] ! ! !ExternalPipe methodsFor: 'testing' stamp: 'dtl 6/4/2006 16:01'! atEndOfFile "Answer whether the receiver is at its end based on the result of the last read operation. This uses feof() to test the underlying file stream status, and can be used as an alternative to #atEnd, which does not properly report end of file status for an OSPipe." ^ reader atEndOfFile ! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 20:00'! blocking "True if reader end is set to blocking mode." ^ blocking ifNil: [blocking := true]! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 20:00'! blocking: trueOrFalse "True if reader end is set to blocking mode." blocking := trueOrFalse! ! !ExternalPipe methodsFor: 'finalization' stamp: 'dtl 3/7/2006 19:44'! close self closeWriter; closeReader ! ! !ExternalPipe methodsFor: 'finalization' stamp: 'dtl 3/7/2006 19:44'! closeReader reader ifNotNil: [reader close] ! ! !ExternalPipe methodsFor: 'finalization' stamp: 'dtl 3/7/2006 19:44'! closeWriter writer ifNotNil: [writer close] ! ! !ExternalPipe methodsFor: 'testing' stamp: 'dtl 9/16/2002 17:35'! closed ^ reader closed! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 4/16/2003 06:01'! contents "Answer contents of the pipe, and return the contents to the pipe so it can still be read." "ExternalPipe new nextPutAll: 'hello'; contents" | s | self closed ifTrue: [self notify: self printString, ' ', self reader printString, ' closed'. ^ nil]. s := self reader upToEnd. s isEmpty ifFalse: [self writer closed ifTrue: [self notify: self printString, ' ', self writer printString, ' closed, cannot replace contents'] ifFalse: [self nextPutAll: s]]. ^ s! ! !ExternalPipe methodsFor: 'character writing' stamp: 'dtl 3/7/2006 19:44'! cr "Append a return character to the receiver." self writer cr! ! !ExternalPipe methodsFor: 'initialize-release' stamp: 'dtl 3/25/2006 14:08'! initialize ^ self makePipe ! ! !ExternalPipe methodsFor: 'testing' stamp: 'dtl 3/26/2006 15:48'! isPipe ^ true ! ! !ExternalPipe methodsFor: 'initialize-release' stamp: 'dtl 3/7/2006 19:44'! makePipe "Create an OS pipe and attach it to my input and output streams." | handleArray | handleArray := OSProcess accessor makePipeHandles. handleArray isNil ifTrue: [self error: 'cannot create OS pipe'] ifFalse: [self reader: (AttachableFileStream name: 'pipeReader' attachTo: (handleArray at: 1) writable: false). self writer: (AttachableFileStream name: 'pipeWriter' attachTo: (handleArray at: 2) writable: true)] ! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 9/16/2002 17:33'! next "Answer the next object accessible by the receiver." ^ reader next! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 9/16/2002 17:33'! next: anInteger "Answer the next anInteger elements of my collection." ^ reader next: anInteger ! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 19:44'! nextPut: anObject "Insert the argument, anObject, as the next object accessible by the receiver. Answer anObject." ^ writer nextPut: anObject! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 19:44'! nextPutAll: aCollection "Append the elements of aCollection to the sequence of objects accessible by the receiver. Answer aCollection." ^ writer nextPutAll: aCollection! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 9/16/2002 17:34'! peek ^ reader peek! ! !ExternalPipe methodsFor: 'printing' stamp: 'dtl 4/2/2006 11:40'! printOn: aStream "The implementation of Stream>>printOn: has bad side effects when used for OSPipe. This implementation is copied from Object." | title | title := self class name. aStream nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']); nextPutAll: title! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 19:44'! reader "Answer a stream on the read end of the pipe." ^ reader! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 19:44'! reader: aReadStream reader := aReadStream! ! !ExternalPipe methodsFor: 'initialize-release' stamp: 'dtl 3/9/2006 06:40'! setBlocking "Set the reader side of the pipe for blocking reads." reader ifNotNil: [OSProcess accessor setBlocking: reader ioHandle]. self blocking: true ! ! !ExternalPipe methodsFor: 'initialize-release' stamp: 'dtl 4/2/2006 19:06'! setBufferedReader "Use an event driven AsyncFileReadStream to represent the reader end of the pipe. This should be used if the pipe will be read by a Smalltalk process. It should not be used if the pipe is to be read by an external OS process." reader ifNotNil: [reader removeDependent: self. reader unregister. self reader: reader asBufferedAsyncFileReadStream. self setNonBlocking. reader addDependent: self. ^ true]. ^ false ! ! !ExternalPipe methodsFor: 'initialize-release' stamp: 'dtl 3/9/2006 06:40'! setNonBlocking "Set the reader side of the pipe for non-blocking reads." reader ifNotNil: [OSProcess accessor setNonBlocking: reader ioHandle]. self blocking: false ! ! !ExternalPipe methodsFor: 'updating' stamp: 'dtl 3/15/2006 07:17'! triggerDataReady "Notify any object waiting for data ready on the pipe." self triggerEvent: #dataReady. ! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 9/18/2002 20:29'! upToEnd "Answer the remaining elements in the string" reader closed ifTrue: [^ ''] ifFalse: [^ reader upToEnd]! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 6/3/2006 10:26'! upToEndOfFile "Answer the remaining elements in the pipe. Use #testEndOfFile to determine end of file status with feof(), required for reliable end of file test on OS pipes." reader closed ifTrue: [^ ''] ifFalse: [^ reader upToEndOfFile]! ! !ExternalPipe methodsFor: 'updating' stamp: 'dtl 1/18/2003 14:31'! update: aParameter "Notify any object waiting for data ready on the pipe." self changed. self triggerDataReady. ^ super update: aParameter ! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 19:44'! writer "Answer a stream on the write end of the pipe." ^ writer! ! !ExternalPipe methodsFor: 'accessing' stamp: 'dtl 3/7/2006 19:44'! writer: aWriteStream writer := aWriteStream! ! ExternalPipe subclass: #OSPipe instanceVariableNames: 'nextChar' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !OSPipe commentStamp: 'dtl 3/8/2006 07:27' prior: 0! I represent a pipe provided by the underlying operating system, such as a Unix pipe. I have a reader stream and a writer stream which behave similarly to a read-only FileStream and a writeable FileStream. I use a single-character buffer to implement #peek without losing data from the external OS pipe.! !OSPipe methodsFor: 'accessing' stamp: 'dtl 10/14/2001 12:16'! next "Answer the next object accessible by the receiver." | c | nextChar isNil ifTrue: [^ [reader next] on: Error do: [nil]] ifFalse: [c := nextChar. nextChar := nil. ^ c] ! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 9/12/2001 19:32'! next: anInteger "Answer the next anInteger elements of my collection." | c strm | strm := WriteStream on: ''. (1 to: anInteger) do: [:index | c := self next. c isNil ifTrue: [^ strm contents] ifFalse: [strm nextPut: c. false]]. ^ strm contents ! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 5/16/2006 06:52'! peek ^ nextChar isNil ifTrue: [reader closed ifFalse: [nextChar := reader next]] ifFalse: [nextChar]! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 9/2/2006 21:52'! upToEnd "Answer the remaining elements in the string. This method is retained for backward compatibility with older versions of CommandShell." | strm s | strm := WriteStream on: ''. [(s := self next: 2000) isEmpty ifTrue: [^ strm contents] ifFalse: [strm nextPutAll: s]] repeat ! ! !OSPipe methodsFor: 'accessing' stamp: 'dtl 6/4/2006 16:02'! upToEndOfFile "Answer the remaining elements in the pipe. Use #atEndOfFile to determine end of file status with feof(), required for reliable end of file test on OS pipes. Compare #upToEnd, which uses the generic end of file test in FilePlugin." | strm d s | strm := WriteStream on: ''. d := Delay forMilliseconds: 200. [(s := self next: 2000) isEmpty ifTrue: [self atEndOfFile ifTrue: [^ strm contents] ifFalse: [d wait]] ifFalse: [strm nextPutAll: s]] repeat ! ! Object subclass: #AioEventHandlerExample instanceVariableNames: 'handler ioStream' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-AIO'! !AioEventHandlerExample commentStamp: 'dtl 7/5/2003 18:38' prior: 0! Demonstrate asynchronous read handers for file streams, OS pipes, standard input, and sockets. See class category "examples". Some examples require OSProcess.! !AioEventHandlerExample class methodsFor: 'examples' stamp: 'dtl 9/4/2003 06:22'! osPipeExample "Demonstrate an asynchronous read hander on an OS pipe. Output will be displayed on the Transcript." "self osPipeExample" | pipe aio | (Smalltalk hasClassNamed: #OSProcess) ifFalse: [self notify: 'this example requires OSProcess'] ifTrue: [pipe := (Smalltalk at: #OSPipe) new. aio := super new handler: (AioEventHandler for: pipe reader); ioStream: pipe reader. aio handler addDependent: aio. (1 to: 10) do: [:i | pipe nextPutAll: 'this is line ', i asString; cr. (Delay forMilliseconds: 500) wait]. ^ aio handler close] ! ! !AioEventHandlerExample class methodsFor: 'examples' stamp: 'dtl 9/4/2003 06:22'! showTtyOnTranscript: ttyName "Enter lines on /dev/tty, and watch them show up on the Transcript. Normally, /dev/tty corresponds to standard input for the Squeak process, so if you have a serial port connected to something that generates data, try this example with /dev/whatever to demonstrate asych input on a serial port. Warning: This method does not set the file stream for nonblocking input, so it can block the Squeak VM. The #getAvailableData attempts to work around this, but save your image before testing with another serial interfaces." "self showTtyOnTranscript: '/dev/tty'" | inputStream handler example | inputStream := FileStream readOnlyFileNamed: '/dev/tty'. handler := AioEventHandler for: inputStream exceptions: true readEvents: true writeEvents: false. example := super new handler: handler; ioStream: inputStream. handler addDependent: example. Transcript cr; show: ''. self notify: 'Enter lines on ', ttyName, ', watch the Transcript, and select "Proceed" when done'. ^ example handler close ! ! !AioEventHandlerExample class methodsFor: 'examples' stamp: 'dtl 9/4/2003 06:23'! standardInputExample "Enter lines on stdin, and watch them show up on the Transcript." "self standardInputExample" | aio stdin | (Smalltalk hasClassNamed: #OSProcess) ifFalse: [self notify: 'this example requires OSProcess'] ifTrue: [Transcript cr; show: ''. stdin := (Smalltalk at: #OSProcess) thisOSProcess stdIn. aio := super new handler: (AioEventHandler for: stdin); ioStream: stdin. aio handler addDependent: aio. self notify: 'Enter lines on standard input, watch the Transcript, and select "Proceed" when done'. ^ aio handler close] ! ! !AioEventHandlerExample class methodsFor: 'examples' stamp: 'dtl 9/4/2003 06:24'! tcpSocketExample "Loosely based on OldSocket>>remoteTestServerTCP. Output is displayed on the Transcript." "self tcpSocketExample" | port serverTcpSocket serverName clientTcpSocket handler example useOldStyleSockets | port := 8086. serverName := '127.0.0.1'. "The networking code was updated for Squeak 3.6. This checks for which version to use." useOldStyleSockets := Socket respondsTo: #initializeNetworkIfFail:. Transcript show: 'initializing network ... '. useOldStyleSockets ifTrue: [Socket initializeNetworkIfFail: [^Transcript show:'failed']] ifFalse: [[Socket initializeNetwork] on: Error do: [:ex | ^Transcript show:'failed']]. Transcript show:'ok';cr. "Create the server (reader) socket" serverTcpSocket := Socket newTCP. serverTcpSocket listenOn: port. [Transcript show: 'server endpoint created on port ', port asString; cr. useOldStyleSockets ifTrue: [serverTcpSocket waitForConnectionUntil: Socket standardDeadline] ifFalse: [serverTcpSocket waitForConnectionFor: 10]] fork. (Delay forMilliseconds: 1000) wait. "Create the client (writer) socket" clientTcpSocket := Socket newTCP. clientTcpSocket connectTo: (NetNameResolver addressFromString: serverName) port: port. useOldStyleSockets ifTrue: [clientTcpSocket waitForConnectionUntil: Socket standardDeadline] ifFalse: [clientTcpSocket waitForConnectionFor: 10]. Transcript show: 'client endpoint connected to ', serverName, ' port ', port asString; cr. "Set up a read event handler on the server socket" handler := AioEventHandler for: serverTcpSocket exceptions: true readEvents: true writeEvents: false. example := super new handler: handler; ioStream: serverTcpSocket. handler addDependent: example. Transcript show: 'event handler started'; cr. "Send a few lines of data to the client socket, waiting briefly between lines. The event handler will watch the server socket, and copy data to the Transcript each time a new line of data is available to the server." (1 to: 10) do: [:i | clientTcpSocket sendData: 'this is line ', i asString, Character cr asString. (Delay forMilliseconds: 500) wait]. clientTcpSocket closeAndDestroy. Transcript show: 'client endpoint closed'; cr. serverTcpSocket closeAndDestroy. Transcript show: 'server endpoint closed'; cr. example close. Transcript show: 'event handler stopped'; cr. ^ Array with: example with: serverTcpSocket with: clientTcpSocket! ! !AioEventHandlerExample class methodsFor: 'version identification' stamp: 'dtl 8/20/2005 08:43'! versionString ^ '1.2'! ! !AioEventHandlerExample methodsFor: 'initialize-release' stamp: 'dtl 9/4/2003 06:20'! close self handler close. self handler removeDependent: self ! ! !AioEventHandlerExample methodsFor: 'updating' stamp: 'dtl 7/5/2003 18:22'! getAvailableData "Obtain all available data from ioStream. For a FileStream, keep reading until a line terminator is reached. This allows use with a FileStream that has not been set for nonblocking input." | ws c buffer n | buffer := String new: 4000. (self ioStream isKindOf: FileStream) ifTrue: [ws := WriteStream on: ''. [c := ioStream next. (c == Character lf) ifTrue: [ws nextPut: Character cr] ifFalse: [ws nextPut: c]. (c ~= Character lf) and: [c ~= Character cr]] whileTrue. ^ ws contents] ifFalse: [ioStream dataAvailable ifTrue: [n := ioStream receiveDataInto: buffer. ^ buffer copyFrom: 1 to: n] ifFalse: [^ '']] ! ! !AioEventHandlerExample methodsFor: 'accessing' stamp: 'dtl 7/5/2003 09:40'! handler ^ handler! ! !AioEventHandlerExample methodsFor: 'accessing' stamp: 'dtl 7/5/2003 09:40'! handler: anAioHandler handler := anAioHandler! ! !AioEventHandlerExample methodsFor: 'accessing' stamp: 'dtl 7/5/2003 09:57'! ioStream ^ ioStream! ! !AioEventHandlerExample methodsFor: 'accessing' stamp: 'dtl 7/5/2003 09:57'! ioStream: aFileStream ioStream := aFileStream! ! !AioEventHandlerExample methodsFor: 'updating' stamp: 'dtl 7/5/2003 18:23'! update: anObject (anObject isKindOf: AioEventHandler) ifTrue: [Transcript show: self getAvailableData] ! ! Object subclass: #OSFileLock instanceVariableNames: 'fileStream exclusive' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !OSFileLock commentStamp: 'dtl 2/23/2004 19:36' prior: 0! I describe the region representing the entire addressable space of an external file, including regions that have not yet been allocated for use by the file. On platforms that support file locking, an OSFileLock is used to describe a lock on the entire file. ! !OSFileLock class methodsFor: 'instance creation' stamp: 'jf 2/22/2004 17:35'! onFile: aFileStream exclusive: writeLockFlag "A region representing the whole file" ^ super new onFile: aFileStream exclusive: writeLockFlag ! ! !OSFileLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 18:33'! = aFileLock ^ (self species = aFileLock species) and: [self fileStream == aFileLock fileStream] and: [self exclusive == aFileLock exclusive]! ! !OSFileLock methodsFor: 'conflict testing' stamp: 'jf 2/22/2004 16:38'! conflictsWith: otherFileLock ^ (self isExclusive or: [otherFileLock isExclusive]) and: [self overlaps: otherFileLock]! ! !OSFileLock methodsFor: 'accessing' stamp: 'jf 2/22/2004 16:00'! exclusive "Answer the value of exclusive. Default is true, indicating a read-write lock as opposed to a shared read lock." ^ exclusive ifNil: [exclusive := true].! ! !OSFileLock methodsFor: 'accessing' stamp: 'jf 2/22/2004 16:00'! exclusive: anObject "Set the value of exclusive" exclusive := anObject! ! !OSFileLock methodsFor: 'accessing' stamp: 'jf 2/22/2004 16:00'! fileStream "Answer the value of fileStream" ^ fileStream! ! !OSFileLock methodsFor: 'accessing' stamp: 'jf 2/22/2004 16:00'! fileStream: anObject "Set the value of fileStream" fileStream := anObject! ! !OSFileLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 18:32'! hash ^ (self fileStream hash + self exclusive hash) hashMultiply! ! !OSFileLock methodsFor: 'testing' stamp: 'jf 2/22/2004 18:13'! isActive ^ self fileStream closed not! ! !OSFileLock methodsFor: 'testing' stamp: 'jf 2/22/2004 16:01'! isExclusive ^ self exclusive! ! !OSFileLock methodsFor: 'private' stamp: 'jf 2/22/2004 18:07'! length ^ 0! ! !OSFileLock methodsFor: 'system locking' stamp: 'dtl 5/8/2006 06:52'! lock "Answer true on success" ^ self lockIfFail: [false] ! ! !OSFileLock methodsFor: 'system locking' stamp: 'dtl 5/8/2006 06:57'! lockIfFail: failBlock | handle result | handle := ThisOSProcess accessor handleFromFileStream: self fileStream. result := ThisOSProcess accessor primLockFileRegion: handle offset: self offset length: self length exclusive: self isExclusive. result == 0 ifTrue: [^ true] ifFalse: [^ failBlock value] ! ! !OSFileLock methodsFor: 'private' stamp: 'jf 2/22/2004 18:02'! offset ^ 0! ! !OSFileLock methodsFor: 'initialize-release' stamp: 'jf 2/22/2004 16:02'! onFile: aFileStream exclusive: writeLockFlag self fileStream: aFileStream. self exclusive: writeLockFlag ! ! !OSFileLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 16:31'! overlaps: aFileLock "Answer true if the receiver represents an addressable region that overlaps aFileLock" ^ aFileLock fileStream fullName = self fileStream fullName! ! !OSFileLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 16:35'! overlapsRegion: aFileRegionLock ^ aFileRegionLock fileStream fullName = self fileStream fullName! ! !OSFileLock methodsFor: 'system locking' stamp: 'dtl 5/8/2006 07:00'! test "Answer true if this is a lockable file or region" | handle result | handle := ThisOSProcess accessor handleFromFileStream: self fileStream. result := ThisOSProcess accessor primTestLockableFileRegion: handle offset: self offset length: self length exclusive: self isExclusive. ^ (result == -1 or: [result isNil]) ifTrue: [false] ifFalse: [result first]! ! !OSFileLock methodsFor: 'system locking' stamp: 'dtl 5/8/2006 06:58'! unlock "Answer true on success" ^ self unlockIfFail: [false] ! ! !OSFileLock methodsFor: 'system locking' stamp: 'dtl 5/8/2006 06:57'! unlockIfFail: failBlock | handle result | handle := ThisOSProcess accessor handleFromFileStream: self fileStream. result := ThisOSProcess accessor primUnlockFileRegion: handle offset: self offset length: self length. result == 0 ifTrue: [^ true] ifFalse: [^ failBlock value] ! ! OSFileLock subclass: #OSFileRegionLock instanceVariableNames: 'interval' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !OSFileRegionLock commentStamp: 'jf 2/22/2004 19:50' prior: 0! I describe an addressable region of contiguous bytes in an external file. On platforms that support file locking, an OSFileRegionLock is used to specify a portion of the file to be locked. ! !OSFileRegionLock class methodsFor: 'instance creation' stamp: 'dtl 2/22/2004 13:58'! onFile: aFileStream from: start to: end exclusive: writeLockFlag "A region representing part of a file" ^ self onFile: aFileStream interval: (start to: end) exclusive: writeLockFlag ! ! !OSFileRegionLock class methodsFor: 'instance creation' stamp: 'dtl 2/22/2004 13:59'! onFile: aFileStream interval: anInterval exclusive: writeLockFlag "A region representing part of a file" ^ super new onFile: aFileStream interval: anInterval exclusive: writeLockFlag ! ! !OSFileRegionLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 18:33'! = aFileRegion ^ (super = aFileRegion) and: [self interval = aFileRegion interval] ! ! !OSFileRegionLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 18:33'! hash ^ (super hash + self interval hash) hashMultiply ! ! !OSFileRegionLock methodsFor: 'accessing' stamp: 'dtl 3/10/2005 20:23'! interval "Answer the value of interval" ^ interval! ! !OSFileRegionLock methodsFor: 'accessing' stamp: 'dtl 3/10/2005 20:23'! interval: anObject "Set the value of interval" interval := anObject! ! !OSFileRegionLock methodsFor: 'private' stamp: 'jf 2/22/2004 18:02'! length ^ self interval size! ! !OSFileRegionLock methodsFor: 'private' stamp: 'jf 2/22/2004 18:02'! offset ^ self interval first! ! !OSFileRegionLock methodsFor: 'initialize-release' stamp: 'jf 2/22/2004 16:03'! onFile: aFileStream interval: anInterval exclusive: writeLockFlag self onFile: aFileStream exclusive: writeLockFlag. self interval: anInterval.! ! !OSFileRegionLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 19:47'! overlaps: aFileLock "Call #overlapsRegion: on aFileLock since we know we're a region but we don't know whether aFileLock is" ^ aFileLock overlapsRegion: self! ! !OSFileRegionLock methodsFor: 'comparing' stamp: 'jf 2/22/2004 18:56'! overlapsRegion: aFileRegionLock ^ (super overlapsRegion: aFileRegionLock) and: [(self interval intersection: aFileRegionLock interval) isEmpty not]! ! Object subclass: #OSProcess instanceVariableNames: 'pid' classVariableNames: 'UseIOHandle' poolDictionaries: '' category: 'OSProcess-Base'! !OSProcess commentStamp: '' prior: 0! I represent an operating system process, such as the process in which the Squeak VM is currently running. My subclasses implement system specific features for Unix, Windows, MacOS, or other operating systems. ! OSProcess subclass: #ExternalOSProcess instanceVariableNames: 'runState initialStdIn initialStdOut initialStdErr' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !ExternalOSProcess commentStamp: '' prior: 0! I represent an OSProcess other than the process in which this Squeak is executing. I maintain information about the state of the external process during and after the lifetime of the process.! ExternalOSProcess subclass: #ExternalMacOSProcess instanceVariableNames: 'ppid exitStatus' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Mac'! !ExternalMacOSProcess commentStamp: '' prior: 0! I represent an external MacOS process other than the process in which this Squeak is executing. I maintain information about the state of the external process during and after the lifetime of the process. In particular, I hold the exit status of the process after it completes execution. When the external process changes state (e.g. it exits), the VM signals a Squeak semaphore. A singleton MacOSProcessAccessor maintains a process which waits on the semaphore, and sends a changed: #childProcessStatus message to itself, thereby notifying its dependent MacOSProcess (a singleton) to check the status of all its ExternalMacOSProcess children, and #update: them accordingly.! !ExternalMacOSProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:45'! isResponsibleForThisPlatform "Answer true if, for the current platform, this class is responsible for representing an OS process other than that in which the Squeak VM is currently running." ^ self isNonUnixMac ! ! ExternalOSProcess subclass: #ExternalOS2Process instanceVariableNames: 'ppid exitStatus' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-OS2'! !ExternalOS2Process commentStamp: '' prior: 0! I represent an external OS2 process other than the process in which this Squeak is executing. I maintain information about the state of the external process during and after the lifetime of the process. In particular, I hold the exit status of the process after it completes execution. When the external process changes state (e.g. it exits), the VM signals a Squeak semaphore. A singleton OS2ProcessAccessor maintains a process which waits on the semaphore, and sends a changed: #childProcessStatus message to itself, thereby notifying its dependent OS2Process (a singleton) to check the status of all its ExternalOS2Process children, and #update: them accordingly.! !ExternalOS2Process class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:47'! isResponsibleForThisPlatform "Answer true if, for the current platform, this class is responsible for representing an OS process other than that in which the Squeak VM is currently running." ^ self isOS2 ! ! !ExternalOSProcess class methodsFor: 'concrete subclasses' stamp: 'dtl 3/5/2005 12:02'! concreteClass "ExternalOSProcess concreteClass" ^ self subclasses detect: [:c | c isResponsibleForThisPlatform] ifNone: [self notify: self printString, ': No concrete class implementation available for system type ', self platformName printString. nil] ! ! !ExternalOSProcess class methodsFor: 'instance creation' stamp: 'dtl 1/16/2001 05:36'! exec: programName "Run a program in an external OS process, and answer an instance of myself which represents the external process." "ExternalOSProcess exec: '/bin/ls'" ^ self concreteClass exec: programName ! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 11/8/2000 21:41'! accessor "Answer an OSProcessAccessor which may be used to obtain information about the external OS process which I represent." ^ OSProcess thisOSProcess processAccessor ! ! !ExternalOSProcess methodsFor: 'initialize - release' stamp: 'dtl 3/1/2002 06:41'! closeInitialStdErr initialStdErr ifNotNil: [initialStdErr close] ! ! !ExternalOSProcess methodsFor: 'initialize - release' stamp: 'dtl 3/1/2002 06:42'! closeInitialStdIn initialStdIn ifNotNil: [initialStdIn close] ! ! !ExternalOSProcess methodsFor: 'initialize - release' stamp: 'dtl 3/1/2002 06:42'! closeInitialStdOut initialStdOut ifNotNil: [initialStdOut close] ! ! !ExternalOSProcess methodsFor: 'initialize - release' stamp: 'dtl 11/21/2006 14:04'! closeStreams self closeInitialStdIn; closeInitialStdOut; closeInitialStdErr! ! !ExternalOSProcess methodsFor: 'setting run state' stamp: 'dtl 3/4/2001 18:55'! complete "Process has exited and has been reaped. It no longer exists in the external operating system." self runState: #complete ! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/1/2002 06:38'! initialStdErr "The stderr stream at the time the child process is invoked. If the same as stderr for the current Squeak process, it may change as a result of Squeak using its stderr stream. The child process may also modify its actual stderr; therefore this is not an accurate representation of the child process stderr during the life of the child process." ^ initialStdErr! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/1/2002 06:38'! initialStdErr: anExternalStream initialStdErr := anExternalStream! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/1/2002 06:39'! initialStdIn "The stdin stream at the time the child process is invoked. If the same as stdin for the current Squeak process, it may change as a result of Squeak using its stdin stream. The child process may also modify its actual stdin; therefore this is not an accurate representation of the child process stdin during the life of the child process." ^ initialStdIn! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/1/2002 06:39'! initialStdIn: anExternalStream initialStdIn := anExternalStream! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/1/2002 06:39'! initialStdOut "The stdout stream at the time the child process is invoked. If the same as stdout for the current Squeak process, it may change as a result of Squeak using its stdout stream. The child process may also modify its actual stdout; therefore this is not an accurate representation of the child process stdout during the life of the child process." ^ initialStdOut! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/1/2002 06:40'! initialStdOut: anExternalStream initialStdOut := anExternalStream! ! !ExternalOSProcess methodsFor: 'initialize - release' stamp: 'dtl 10/6/2000 21:01'! initialize self notYetRunning! ! !ExternalOSProcess methodsFor: 'testing' stamp: 'dtl 10/7/2000 14:45'! isAccessible ^ self accessor canAccessChildProcess: self! ! !ExternalOSProcess methodsFor: 'testing' stamp: 'dtl 1/20/2001 11:40'! isComplete ^ self runState == #complete! ! !ExternalOSProcess methodsFor: 'testing' stamp: 'dtl 1/20/2001 11:40'! isNotYetRunning ^ self runState == #notYetRunning! ! !ExternalOSProcess methodsFor: 'testing' stamp: 'dtl 1/20/2001 11:40'! isRunning ^ self runState == #running! ! !ExternalOSProcess methodsFor: 'setting run state' stamp: 'dtl 3/26/2000 15:23'! notYetRunning "Process has not yet entered running state." self runState: #notYetRunning ! ! !ExternalOSProcess methodsFor: 'printing' stamp: 'dtl 3/18/2000 14:07'! printOn: aStream super printOn: aStream. self isComplete ifTrue: [ aStream nextPutAll: ' (', self runState, ' with status ', self exitStatus printString, ')' ] ifFalse: [ aStream nextPutAll: ' (', self runState asString, ')' ]! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 1/25/2004 11:01'! runState ^ runState ifNil: [self unknownRunState] ! ! !ExternalOSProcess methodsFor: 'accessing' stamp: 'dtl 3/18/2000 12:30'! runState: aSymbol runState := aSymbol. self changed: #runState ! ! !ExternalOSProcess methodsFor: 'setting run state' stamp: 'dtl 3/26/2000 15:23'! running "Process is actively running." self runState: #running ! ! !ExternalOSProcess methodsFor: 'testing' stamp: 'dtl 12/22/2001 18:32'! succeeded "Answer true if my process completed successfully. Be optimistic here, and let my subclasses implement the details." ^ self isComplete! ! !ExternalOSProcess methodsFor: 'setting run state' stamp: 'dtl 10/6/2000 20:59'! unknownRunState "Unable to determine the current run state of the process, possibly because this is a stale reference to a process which no longer exists." self runState: #unknownRunState ! ! !ExternalOSProcess methodsFor: 'updating' stamp: 'dtl 2/27/2002 09:45'! update: aParameter "Notify any dependents if my run state changes. My subclasses will do additional updating when the run state changes." aParameter == #runState ifTrue: [self changed: #runState] ! ! ExternalOSProcess subclass: #ExternalRiscOSProcess instanceVariableNames: 'ppid exitStatus' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-RiscOS'! !ExternalRiscOSProcess commentStamp: '' prior: 0! I represent an external RiscOS task other than the process in which this Squeak is executing. I maintain information about the state of the external task during and after the lifetime of the task. In particular, I hold the exit status of the task after it completes execution. When the external task changes state (e.g. it exits), the VM signals a Squeak semaphore. A singleton RiscOSProcessAccessor maintains a process which waits on the semaphore, and sends a changed: #childProcessStatus message to itself, thereby notifying its dependent RiscOSProcess (a singleton) to check the status of all its ExternalRiscOSProcess children, and #update: them accordingly. ! !ExternalRiscOSProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:48'! isResponsibleForThisPlatform "Answer true if, for the current platform, this class is responsible for representing an OS process other than that in which the Squeak VM is currently running." ^ self isRiscOS ! ! ExternalOSProcess subclass: #ExternalUnixOSProcess instanceVariableNames: 'ppid pwd exitStatus programName arguments initialEnvironment' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Unix'! !ExternalUnixOSProcess commentStamp: '' prior: 0! I represent an external Unix process other than the process in which this Squeak is executing. I maintain information about the state of the external process during and after the lifetime of the process. In particular, I hold the exit status of the process after it completes execution. When the external process changes state (e.g. it exits), the VM signals a Squeak semaphore. A singleton UnixProcessAccessor maintains a process which waits on the semaphore, and sends a changed: #childProcessStatus message to itself, thereby notifying its dependent UnixProcess (a singleton) to check the status of all its ExternalUnixProcess children, and #update: them accordingly.! !ExternalUnixOSProcess class methodsFor: 'shells' stamp: 'dtl 12/15/2007 09:53'! bashShellPath "A more full-featured shell from the Free Software Foundation" | path | path := '/bin/bash'. (FileDirectory default fileExists: path) ifTrue: [^ path] ifFalse: [self notify: path, ' not found']! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 7/12/2003 11:38'! command: aCommandString "ExternalUnixOSProcess command: 'ls -l /etc'" ^ self forkAndExec: self defaultShellPath arguments: (Array with: '-c' with: aCommandString) environment: nil! ! !ExternalUnixOSProcess class methodsFor: 'shells' stamp: 'dtl 12/15/2007 09:53'! defaultShellPath "Default shell to run" | path | path := '/bin/sh'. (FileDirectory default fileExists: path) ifTrue: [^ path] ifFalse: [self notify: path, ' not found']! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 1/16/2001 05:33'! exec: programName "Run a program in an external OS process, and answer an instance of myself which represents the external process." ^ self forkAndExec: programName ! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/27/2002 15:25'! forkAndExec: executableFile "ExternalUnixOSProcess forkAndExec: '/bin/ls'" ^ super new programName: executableFile; initialize; forkChild ! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/27/2002 15:25'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary "Run a program in an external OS process, and answer an instance of myself which represents the external process." "ExternalUnixOSProcess forkAndExec: '/bin/ls' arguments: (Array with: '-l') environment: (UnixProcess env)" ^ super new programName: executableFile; arguments: arrayOfStrings; initialEnvironment: stringDictionary; initialize; forkChild ! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/27/2002 15:25'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Run a program in an external OS process, and answer an instance of myself which represents the external process." "ExternalUnixOSProcess forkAndExec: '/bin/ls' arguments: (Array with: '-l') environment: (UnixProcess env) descriptors: nil" | proc | proc := super new programName: executableFile; arguments: arrayOfStrings; initialEnvironment: stringDictionary. arrayOf3Streams ifNotNil: [proc initialStdIn: (arrayOf3Streams at: 1). proc initialStdOut: (arrayOf3Streams at: 2). proc initialStdErr: (arrayOf3Streams at: 3)]. ^ proc initialize forkChild ! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/27/2002 15:25'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams workingDir: pathString "Run a program in an external OS process, and answer an instance of myself which represents the external process." "ExternalUnixOSProcess forkAndExec: '/bin/ls' arguments: nil environment: nil descriptors: nil workingDir: '/etc'" | proc | proc := super new programName: executableFile; arguments: arrayOfStrings; initialEnvironment: stringDictionary. arrayOf3Streams ifNotNil: [proc initialStdIn: (arrayOf3Streams at: 1). proc initialStdOut: (arrayOf3Streams at: 2). proc initialStdErr: (arrayOf3Streams at: 3)]. pathString ifNotNil: [proc pwd: pathString]. ^ proc initialize forkChild ! ! !ExternalUnixOSProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:48'! isResponsibleForThisPlatform "Answer true if, for the current platform, this class is responsible for representing an OS process other than that in which the Squeak VM is currently running." ^ self isUnix ! ! !ExternalUnixOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/28/2002 10:15'! programName: executableFile arguments: arrayOfStrings initialEnvironment: stringDictionary "Answer an instance not yet running." ^ super new programName: executableFile; arguments: arrayOfStrings; initialEnvironment: stringDictionary ! ! !ExternalUnixOSProcess class methodsFor: 'shells' stamp: 'dtl 12/15/2007 09:54'! remoteShellPath "A remote shell processor. This may need to be edited for different systems." | path | path := '/usr/bin/rsh'. (FileDirectory default fileExists: path) ifTrue: [^ path] ifFalse: [self notify: path, ' not found']! ! !ExternalUnixOSProcess class methodsFor: 'shells' stamp: 'dtl 12/15/2007 09:54'! tkShellPath "The wish command shell for Tk/Tcl. This tends to be installed in a wide variety of places, so you may need to edit this method for your system." | path | path := '/usr/bin/wish'. (FileDirectory default fileExists: path) ifTrue: [^ path] ifFalse: [self notify: path, ' not found']! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 1/20/2001 12:48'! arguments ^ arguments! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 1/20/2001 12:49'! arguments: arrayOfArgumentStrings arguments := arrayOfArgumentStrings! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:34'! exitStatus ^ exitStatus ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 10/22/1999 22:21'! exitStatus: anInteger exitStatus := anInteger ! ! !ExternalUnixOSProcess methodsFor: 'initialize - release' stamp: 'dtl 4/4/2006 21:16'! forkChild "Start the external OS process. All instances variables except for pid should have been set. The pid will be set following creation of the new external process. Creating a child process is the responsibility of the currently executing OS process, so request it to do so on behalf of this instance of ExternalUnixOSProcess." ^ OSProcess thisOSProcess processProxy: self forkAndExec: programName arguments: arguments environment: initialEnvironment descriptors: (Array with: initialStdIn with: initialStdOut with: initialStdErr) ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 3/11/2001 09:17'! initialEnvironment ^ initialEnvironment! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 1/21/2001 11:31'! initialEnvironment: aDictionary initialEnvironment := aDictionary! ! !ExternalUnixOSProcess methodsFor: 'initialize - release' stamp: 'dtl 2/11/2001 19:07'! initialize super initialize. ^ self setDefaults ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:51'! pid ^ pid ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 10/22/1999 22:21'! pid: aPid pid := aPid ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 7/3/1999 12:33'! ppid ^ ppid ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 10/22/1999 22:21'! ppid: aPid ppid := aPid ! ! !ExternalUnixOSProcess methodsFor: 'printing' stamp: 'dtl 4/8/2006 19:31'! printOn: aStream self programName isNil ifTrue: [^ super printOn: aStream] ifFalse: [aStream nextPutAll: 'an '; nextPutAll: self class name, ' with pid '; nextPutAll: self pid printString; nextPutAll: ' on '; nextPutAll: programName; nextPutAll: ' ('; nextPutAll: self runState asString; nextPut: $)] ! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 1/20/2001 12:51'! programName ^ programName! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 1/20/2001 12:51'! programName: fileName programName := fileName! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 3/31/2001 17:08'! pwd pwd ifNil: [pwd := self accessor primGetCurrentWorkingDirectory]. ^ pwd! ! !ExternalUnixOSProcess methodsFor: 'accessing' stamp: 'dtl 3/31/2001 17:08'! pwd: pathString pwd := pathString! ! !ExternalUnixOSProcess methodsFor: 'initialize - release' stamp: 'dtl 3/31/2001 17:10'! setDefaults | this | this := OSProcess thisOSProcess. initialEnvironment ifNil: [self initialEnvironment: this environment]. initialStdIn ifNil: [self initialStdIn: this stdIn]. initialStdOut ifNil: [self initialStdOut: this stdOut]. initialStdErr ifNil: [self initialStdErr: this stdErr]. self pwd ! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:44'! sigabrt "Send a SIGABRT signal to the external process which I represent." OSProcess thisOSProcess sigabrt: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:52'! sigalrm "Send a SIGALRM signal to the external process which I represent." OSProcess thisOSProcess sigalrm: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:52'! sigchld "Send a SIGCHLD signal to the external process which I represent." OSProcess thisOSProcess sigchld: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:52'! sigcont "Send a SIGCONT signal to the external process which I represent." OSProcess thisOSProcess sigcont: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:53'! sighup "Send a SIGHUP signal to the external process which I represent." OSProcess thisOSProcess sighup: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:53'! sigint "Send a SIGINT signal to the external process which I represent." OSProcess thisOSProcess sigint: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:54'! sigkill "Send a SIGKILL signal to the external process which I represent." OSProcess thisOSProcess sigkill: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:54'! sigpipe "Send a SIGPIPE signal to the external process which I represent." OSProcess thisOSProcess sigpipe: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:55'! sigquit "Send a SIGQUIT signal to the external process which I represent." OSProcess thisOSProcess sigquit: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:55'! sigstop "Send a SIGSTOP signal to the external process which I represent." OSProcess thisOSProcess sigstop: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:55'! sigterm "Send a SIGTERM signal to the external process which I represent." OSProcess thisOSProcess sigterm: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:56'! sigusr1 "Send a SIGUSR1 signal to the external process which I represent." OSProcess thisOSProcess sigusr1: self! ! !ExternalUnixOSProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:56'! sigusr2 "Send a SIGUSR2 signal to the external process which I represent." OSProcess thisOSProcess sigusr2: self! ! !ExternalUnixOSProcess methodsFor: 'testing' stamp: 'dtl 12/22/2001 18:30'! succeeded ^ self isComplete and: [self exitStatus == 0]! ! !ExternalUnixOSProcess methodsFor: 'terminating child' stamp: 'dtl 2/11/2001 16:08'! terminate "Kill the child process which I represent." self sigkill. self finalize ! ! !ExternalUnixOSProcess methodsFor: 'updating' stamp: 'dtl 7/6/2006 10:06'! update: aParameter | accessible | aParameter == #runState ifTrue: [| statusArray | "Has the process exited?" statusArray := self accessor primGetChildExitStatus: self pid. statusArray notNil ifTrue: [self exitStatus: (statusArray at: 2). ^ self complete]]. aParameter == #accessibility ifTrue: ["Does the process still exist, and is it reachable?" ((accessible := self isAccessible) notNil and: [accessible]) ifFalse: [^ self isRunning ifTrue: [self unknownRunState]]]. super update: aParameter ! ! !ExternalUnixOSProcess methodsFor: 'evaluating' stamp: 'dtl 11/21/2006 14:09'! value "Start the external process" self isNotYetRunning ifTrue: [self forkChild; closeStreams] ! ! ExternalOSProcess subclass: #ExternalWindowsOSProcess instanceVariableNames: 'ppid exitStatus handle threads commandLine pwd' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Win32'! !ExternalWindowsOSProcess commentStamp: '' prior: 0! I represent an external Windows process other than the process in which this Squeak is executing. I maintain information about the state of the external process during and after the lifetime of the process. In particular, I hold the exit status of the process after it completes execution. When the external process changes state (e.g. it exits), the VM signals a Squeak semaphore. A singleton WindowsOSProcessAccessor maintains a process which waits on the semaphore, and sends a changed: #childProcessStatus message to itself, thereby notifying its dependent WindowsOSProcess (a singleton) to check the status of all its ExternalWindowsOSProcess children, and #update: them accordingly.! !ExternalWindowsOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/28/2002 10:56'! command: aCommandString "ExternalWindowsOSProcess command: 'SOL'" "ExternalWindowsOSProcess command: 'NoSuchProgram'" ^ (self commandNoEvaluate: aCommandString) value ! ! !ExternalWindowsOSProcess class methodsFor: 'instance creation' stamp: 'dtl 2/28/2002 10:49'! commandNoEvaluate: aCommandString "Answer an instance not yet running." "ExternalWindowsOSProcess commandNoEvaluate: 'SOL'" ^ super new commandLine: aCommandString; ppid: OSProcess thisOSProcess pid; notYetRunning ! ! !ExternalWindowsOSProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:50'! isResponsibleForThisPlatform "Answer true if, for the current platform, this class is responsible for representing an OS process other than that in which the Squeak VM is currently running." ^ self isWindows ! ! !ExternalWindowsOSProcess class methodsFor: 'instance creation' stamp: 'dtl 3/1/2002 07:02'! programName: executableFile arguments: arrayOfStrings initialEnvironment: stringDictionary "This is for protocol compatibility with ExternalUnixOSProcess. For now, just reassemble a command line string and ignore the environment argument." | commandLine | commandLine := WriteStream on: String new. commandLine nextPutAll: executableFile. arrayOfStrings ifNotNil: [arrayOfStrings do: [:arg | commandLine nextPut: Character space; nextPutAll: arg]]. ^ self commandNoEvaluate: commandLine contents ! ! !ExternalWindowsOSProcess methodsFor: 'initialize - release' stamp: 'dtl 3/1/2002 07:44'! closeHandles "Clean up after process exits." self threads do: [:thread | thread closeHandle]. handle ifNotNil: [OSProcess accessor primCloseHandle: handle. handle := nil] ! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/26/2002 10:09'! commandLine ^ commandLine! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/26/2002 10:09'! commandLine: aCommandLineString commandLine := aCommandLineString! ! !ExternalWindowsOSProcess methodsFor: 'setting run state' stamp: 'dtl 6/24/2006 08:41'! complete "Process has exited and has been reaped. It no longer exists in the external operating system." (threads notNil and: [threads size > 0]) ifTrue: [threads do: [:t | t complete]]. self closeHandles. super complete ! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 08:32'! exitStatus ^ exitStatus! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 08:33'! exitStatus: status exitStatus := status ! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 07:24'! handle "A Windows HANDLE for this OS process, represented as a ByteArray. The handle should be closed when the process exits." ^ handle! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 07:32'! handle: aHandleObject "A Windows HANDLE for this OS process, represented as a ByteArray. The handle should be closed when the process exits." handle := aHandleObject! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 07:29'! ppid ^ ppid ! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 07:29'! ppid: aProcessID ppid := aProcessID! ! !ExternalWindowsOSProcess methodsFor: 'printing' stamp: 'dtl 2/26/2002 10:42'! printOn: aStream self commandLine isNil ifTrue: [^ super printOn: aStream] ifFalse: [aStream nextPutAll: 'a '; nextPutAll: self class name, ' with pid '; nextPutAll: self pid printString. (self isComplete and: [handle isNil]) ifTrue: [aStream nextPutAll: ' (handle closed)'] ifFalse: [aStream nextPutAll: ' handle '; nextPutAll: (handle isNil ifTrue: [handle printString] ifFalse: [handle asArray printString])]. aStream nextPutAll: ' on '''; nextPutAll: commandLine; nextPutAll: ''' ('; nextPutAll: self runState asString; nextPut: $)] ! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/28/2002 10:28'! pwd "Answer the current working directory string." ^ pwd! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/28/2002 10:28'! pwd: pathString "The current working directory string." pwd := pathString! ! !ExternalWindowsOSProcess methodsFor: 'accessing' stamp: 'dtl 2/25/2002 07:09'! threads "One or more threads of execution within the OS process" ^ threads ifNil: [threads := OrderedCollection new] ! ! !ExternalWindowsOSProcess methodsFor: 'updating' stamp: 'dtl 2/27/2002 09:45'! update: aParameter | accessible stat | aParameter == #runState ifTrue: ["Has the process exited?" stat := self accessor primGetExitStatusForHandle: self handle. stat ifNotNil: [self complete closeHandles exitStatus: stat]]. aParameter == #accessibility ifTrue: ["Does the process still exist, and is it reachable?" ((accessible := self isAccessible) notNil and: [accessible]) ifFalse: [self isRunning ifTrue: [self unknownRunState]]]. super update: aParameter ! ! !ExternalWindowsOSProcess methodsFor: 'evaluating' stamp: 'dtl 11/21/2006 14:05'! value "Start the external process" | procInfo mainThread | self isNotYetRunning ifTrue: [procInfo := OSProcess accessor primCommand: self commandLine. procInfo isNil ifTrue: [self initialStdErr nextPutAll: 'cannot execute ', self commandLine; cr. self exitStatus: #cannotExecuteCommandLine. "FIXME: Close the OSPipes now, otherwise the image will block on a read" self closeStreams. [self complete] fork "defer execution so OSPipes stay in place for now"] ifFalse: [self pid: (procInfo at: 3). self handle: (procInfo at: 1). mainThread := WindowsThread threadID: (procInfo at: 4) handle: (procInfo at: 2) running: true. self threads add: mainThread. self running. OSProcess thisOSProcess registerChildProcess: self. "FIXME: Close the initial pipe handles. For now, I have not implemented passing these to the child, and there is no support yet for nonblocking Windows OS pipes. Once those are available, this method needs to change to support." self closeStreams]]. ! ! !OSProcess class methodsFor: 'external process access' stamp: 'dtl 11/8/2000 22:04'! accessor "Answer an OSProcessAccessor for this OS process." ^ self thisOSProcess processAccessor ! ! !OSProcess class methodsFor: 'sUnit' stamp: 'dtl 10/27/2007 10:56'! allTestResults "Run all available sUnit tests and save the results in a file named 'OSProcessTestResults-.txt'. Display results on the Transcript as tests are run. Answer a string with the test results." "OSProcess allTestResults" | resultsFileName writeStream resultString results fs problems result wordSize | self listLoadedModules detect: [:e | '*OSProcessPlugin*' match: e] ifNone: [self notify: 'no OSProcessPlugin loaded']. wordSize := (Smalltalk respondsTo: #wordSize) ifTrue: [Smalltalk wordSize] ifFalse: [4]. resultsFileName := 'OSProcessTestResults-' , OSProcess platformName , '-' , (wordSize * 8) asString , 'bitImage-' , (OSProcess accessor sizeOfPointer * 8) asString , 'bitHw.txt'. [fs := FileStream newFileNamed: resultsFileName. problems := false. writeStream := WriteStream on: ''. writeStream nextPutAll: Utilities authorInitials , ' running OSProcess unit tests ' , TimeStamp now asString; cr. writeStream nextPutAll: 'OSProcess platformName => ' , OSProcess platformName; cr. writeStream nextPutAll: 'OSProcess platformSubtype => ' , OSProcess platformSubtype; cr. writeStream nextPutAll: 'OSProcess osVersion => ' , OSProcess osVersion; cr. writeStream nextPutAll: 'OSProcess vmVersion => ' , OSProcess vmVersion; cr. writeStream nextPutAll: 'size of C int: OSProcess accessor sizeOfInt ==> ' , OSProcess accessor sizeOfInt asString; cr. writeStream nextPutAll: 'size of C pointer: OSProcess accessor sizeOfPointer ==> ' , OSProcess accessor sizeOfPointer asString; cr. writeStream nextPutAll: 'OSProcess versionInformation asString => ' , OSProcess versionInformation asString; cr. Transcript show: writeStream contents. (Class allSubInstances select: [:class | #'Tests-OSProcess' == class category]) , (Class allSubInstances select: [:class | #'Tests-CommandShell' == class category]) do: [:testCase | writeStream nextPutAll: 'running tests in ' , testCase name; cr. Transcript show: 'running tests in ' , testCase name; cr. testCase allTestSelectors do: [:testSelector | OSProcess thisOSProcess stdOut nextPutAll: testCase name, '>>',testSelector, String lf; flush. resultString := (testSelector -> ([result := (testCase selector: testSelector) run. result hasPassed ifFalse: [problems := true]. result] on: Error do: [:ex | problems := true. 'caught exception ' , ex printString])) printString. writeStream nextPutAll: resultString; cr. Transcript show: resultString; cr]]. problems ifTrue: [writeStream nextPutAll: 'one or more problems found'; cr. Transcript show: 'one or more problems were found, see results file'; cr] ifFalse: [writeStream nextPutAll: 'all tests completed without problems'; cr. Transcript show: 'all tests completed without problems'; cr]. results := writeStream contents copyReplaceAll: String cr with: String lf. fs nextPutAll: results] ensure: [fs close]. Transcript show: 'tests results have been saved in a file named ''' , resultsFileName , ''''; cr. ^ results! ! !OSProcess class methodsFor: 'external system access' stamp: 'dtl 1/7/2001 12:32'! arguments "OSProcess arguments" ^ self thisOSProcess arguments ! ! !OSProcess class methodsFor: 'private' stamp: 'dtl 1/7/2001 13:13'! classForThisOSProcess "Answer the class which represents the OS process in which Squeak runs." ^ ThisOSProcess concreteClass! ! !OSProcess class methodsFor: 'external command processing' stamp: 'dtl 1/7/2001 12:09'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process." "OSProcess command: 'ls -l /etc'" ^ self thisOSProcess command: aCommandString ! ! !OSProcess class methodsFor: 'debugging' stamp: 'dtl 4/2/2005 12:32'! debugMessage: aString "Print aString on standard output. The debug message is prefixed with the identity of the process in which the method is being evaluated, and the identity of the object which received the message. Useful for debugging timing or deadlock problems." [self thisOSProcess stdOut "The process in which the traced message is being evaluated" nextPutAll: Processor activeProcess hash printString, ':'; "The identity of the object being traced" nextPutAll: thisContext sender sender sender receiver hash printString, ':'; "The debug message" nextPutAll: aString asString; nextPut: Character lf; flush] on: Error do: []! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 3/5/2005 11:32'! getSystemAttribute: attributeID "After Squeak version 3.6, #getSystemAttribute was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk getSystemAttribute: attributeID]) current getSystemAttribute: attributeID! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 21:52'! helloStdErr "Write a message on the standard error stream of the OS process, normally the terminal or window from which Squeak is being run. Most operating systems implement stdin, stdout, and stderr in some manner, so this shown as an OSProcess example even though the implemention is in my subclasses." "OSProcess helloStdErr" | this | this := self thisOSProcess. this stdErr ifNil: [self noAccessorAvailable. ^ nil]. ^ this stdErr nextPutAll: 'Hello stderr'; nextPut: (Character lf); yourself! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 21:53'! helloWorld "Write a message on the standard output stream of the OS process, normally the terminal or window from which Squeak is being run. Most operating systems implement stdin, stdout, and stderr in some manner, so this shown as an OSProcess example even though the implemention is in my subclasses." "OSProcess helloWorld" | this | this := self thisOSProcess. this stdOut ifNil: [self noAccessorAvailable. ^ nil]. ^ this stdOut nextPutAll: 'Hello world'; nextPut: Character lf; yourself! ! !OSProcess class methodsFor: 'initialize-release' stamp: 'dtl 10/19/2001 18:44'! initialize "OSProcess initialize" UseIOHandle := (Smalltalk hasClassNamed: #IOHandle) ! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 3/5/2005 11:41'! isNonUnixMac "True if the platform is Mac OS prior to OSX" "OSProcess isNonUnixMac" | numericOsVersion | numericOsVersion := self osVersion asInteger ifNil: [0]. ^ (self platformName = 'Mac OS') and: [numericOsVersion < 1000] ! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 3/5/2005 11:42'! isOS2 "True if the platform is OS2" "FIXME please - What is the correct platform name for OS2?" "OSProcess isOS2" ^ self platformName = 'OS2' ! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 8/24/2003 09:52'! isResponsibleForThisPlatform "Answer true if this class has responsibilities for the platform on which the Squeak VM is currently running." ^ self subclassResponsibility! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 3/5/2005 11:43'! isRiscOS "True if the platform is RiscOS" "OSProcess isRiscOS" ^ self platformName = 'RiscOS'! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 3/5/2005 11:43'! isUnix "True if the platform is Unix (including Linux, Mac OS X, or other unix-like OS). Note: Keep this method in sync with UnixOSProcessPlugin>>isResponsibleForThisPlatform." "OSProcess isUnix" | numericOsVersion | ^ (self platformName = 'unix') or: [numericOsVersion := self osVersion asInteger ifNil: [0]. (self platformName = 'Mac OS') and: [numericOsVersion >= 1000]] ! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 3/5/2005 11:46'! isUnixMac "True if the platform is Mac OS on OSX" "OSProcess isUnixMac" | osVersion numericOsVersion | osVersion := self osVersion. ^ ('darwin*' match: osVersion "Ian's VM") or: [numericOsVersion := osVersion asInteger ifNil: [0]. (self platformName = 'Mac OS') and: [numericOsVersion >= 1000] "John's VM"] ! ! !OSProcess class methodsFor: 'platform identification' stamp: 'dtl 3/5/2005 11:46'! isWindows "True if the platform is an MS Windows OS" "OSProcess isWindows" ^ self platformName = 'Win32'! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 10/27/2007 10:55'! listLoadedModules "After Squeak version 3.6, #listLoadedModules was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk listLoadedModules]) current listLoadedModules! ! !OSProcess class methodsFor: 'utility' stamp: 'dtl 1/24/2004 18:23'! makeVM "Rebuild the virtual machine and plugins, assuming that this Squeak is running from a home directory in the appropriate place in the source code tree. If the build is successful, save the image and restart using the new VM." "OSProcess makeVM" ^ self makeVmIn: FileDirectory default pathName, FileDirectory slash, 'build' ! ! !OSProcess class methodsFor: 'utility' stamp: 'dtl 1/24/2004 18:24'! makeVmIn: buildDirectoryPathName "Rebuild the virtual machine and plugins in the buildDirectoryPathName directory. If the build is successful, save the image and restart using the new VM. This assumes that the currently executing VM is either located in, or linked to, the buildDirectoryPathName directory." "OSProcess makeVmIn: FileDirectory default pathName, FileDirectory slash, 'build'" ^ self classForThisOSProcess makeVmIn: buildDirectoryPathName ! ! !OSProcess class methodsFor: 'private' stamp: 'dtl 6/29/2005 14:18'! noAccessorAvailable self notify: 'process accessor module not available'! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 3/5/2005 11:38'! osVersion "After Squeak version 3.6, #osVersion was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk osVersion]) current osVersion! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 3/5/2005 11:38'! platformName "After Squeak version 3.6, #platformName was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk platformName]) current platformName! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 6/13/2005 01:41'! platformSubtype "After Squeak version 3.6, #platformSubtype was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk platformSubtype]) current platformSubtype! ! !OSProcess class methodsFor: 'external system access' stamp: 'dtl 1/7/2001 12:32'! programName "OSProcess programName" ^ self thisOSProcess programName ! ! !OSProcess class methodsFor: 'utility' stamp: 'dtl 1/7/2001 12:35'! quitAndRestart "Save image, start a new instance from the saved image, and quit this instance. This is useful if the VM has been recompiled or if a new pluggable primitive has been added." "OSProcess quitAndRestart" | firstPid this | firstPid := OSProcess thisOSProcess pid. firstPid ifNil: [self noAccessorAvailable. ^ nil]. Smalltalk saveSession. "Value of firstPid gets saved in the image" this := OSProcess thisOSProcess. this pid = firstPid ifTrue: [self squeak ifNotNil: [Smalltalk quitPrimitive]]. ^ this! ! !OSProcess class methodsFor: 'examples' stamp: 'dtl 11/8/2000 23:23'! readFromStdIn "Type some text on the standard input terminal, followed by or , then call this method. Any available input text in the stdin stream will be read. This method sets standard input for the Squeak OS process for non-blocking reads in order to prevent the Smalltalk image from blocking on the read. After the read, standard input is set back to its normal blocking I/O mode. Most operating systems implement stdin, stdout, and stderr in some manner, so this is shown as an OSProcess example even though the implemention is in my subclasses." "OSProcess readFromStdIn inspect" | input ioHandle resultString | input := self thisOSProcess stdIn. input ifNil: [self noAccessorAvailable. ^ nil]. ioHandle := input ioHandle. self accessor setNonBlocking: ioHandle. resultString := self thisOSProcess stdIn next: 10000. self accessor setBlocking: ioHandle. ^ resultString ! ! !OSProcess class methodsFor: 'initialize-release' stamp: 'dtl 3/5/2005 13:40'! removeAllOSProcessAndCommandShellClassesFromSystem "Use this prior to loading a complete new release of OSProcess and CommandWindow. Warning: this clobbers CommandShell as well as OSProcess." "OSProcess removeAllOSProcessAndCommandShellClassesFromSystem" (Smalltalk allClasses select: [:e | 'UnixOSProcessPlugin*' match: e name]) do: [:class | class removeFromSystem]. Smalltalk organization removeCategoriesMatching: 'OSProcess*'. Smalltalk organization removeCategoriesMatching: 'CommandShell*'. Smalltalk organization removeCategoriesMatching: 'Tests-OSProcess*'. Smalltalk organization removeCategoriesMatching: 'Tests-CommandShell*'. Smalltalk organization removeCategoriesMatching: 'VMConstruction-Plugins-OSProcess'. Smalltalk organization removeCategoriesMatching: 'VMMaker-Plugins-OSProcess' ! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 3/5/2005 14:16'! snapshot: save andQuit: quit "After Squeak version 3.6, #snapshot:andQuit: was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk snapshot: save andQuit: quit]) current snapshot: save andQuit: quit! ! !OSProcess class methodsFor: 'external command processing' stamp: 'dtl 1/7/2001 13:06'! squeak "Start a new instance of Squeak running in a child OS process. The new instance will restart from the image file, so it is a clone of this image as it existed at the most recent image save. Note that subclasses can implement additional methods of starting Squeak images, especially for Unix systems." "OSProcess squeak" ^ self thisOSProcess squeak ! ! !OSProcess class methodsFor: 'utility' stamp: 'dtl 3/5/2005 11:34'! systemAttributes "Answer a Dictionary of all of the system attributes which can be obtained from SystemDictionary>>getSystemAttribute." "OSProcess systemAttributes" | args idx a | args := Dictionary new. idx := -1. [a := self getSystemAttribute: idx. a notNil and: [a size > 0]] whileTrue: [args at: idx put: a. idx := idx - 1]. a := self getSystemAttribute: 0. (a notNil and: [a size > 0]) ifTrue: [args at: 0 put: a. idx := idx - 1]. a := self getSystemAttribute: 1. (a notNil and: [a size > 0]) ifTrue: [args at: 1 put: a. idx := idx - 1]. a := self getSystemAttribute: 2. (a notNil and: [a size > 0]) ifTrue: [args at: 2 put: a. idx := idx - 1]. idx := 2. [a := self getSystemAttribute: idx. a notNil and: [a size > 0]] whileTrue: [args at: idx put: a. idx := idx + 1]. idx := 1001. [a := self getSystemAttribute: idx. a notNil and: [a size > 0]] whileTrue: [args at: idx put: a. idx := idx + 1]. ^ args. ! ! !OSProcess class methodsFor: 'instance creation' stamp: 'dtl 1/7/2001 12:03'! thisOSProcess "Answer the single instance of the class corresponding to the OS process in which this Smalltalk image is executing." "OSProcess thisOSProcess" ^ ThisOSProcess thisOSProcess ! ! !OSProcess class methodsFor: 'debugging' stamp: 'dtl 4/2/2005 12:32'! trace "Print the sender's context on standard output. The debug message is prefixed with the identity of the process in which the method is being evaluated, and the identity of the object which received the message. Useful for debugging timing or deadlock problems." [self thisOSProcess stdOut "The process in which the traced message is being evaluated" nextPutAll: Processor activeProcess hash printString, ':'; "The identity of the object being traced" nextPutAll: thisContext sender sender sender receiver hash printString, ':'; "The method context describing the method being evaluated" nextPutAll: thisContext sender sender sender printString; nextPut: Character lf; flush] on: Error do: []! ! !OSProcess class methodsFor: 'debugging' stamp: 'dtl 4/2/2005 12:30'! trace: debugMessageString "Print trace information followed by a debug message" [self thisOSProcess stdOut "The process in which the traced message is being evaluated" nextPutAll: Processor activeProcess hash printString, ':'; "The identity of the object being traced" nextPutAll: thisContext sender sender sender receiver hash printString, ':'; "The method context describing the method being evaluated" nextPutAll: thisContext sender sender sender printString, ':'; nextPutAll: debugMessageString; nextPut: Character lf; flush] on: Error do: []! ! !OSProcess class methodsFor: 'version testing' stamp: 'dtl 8/7/2003 07:28'! versionInformation "OSProcess versionInformation" | osppVersion | osppVersion := (Smalltalk hasClassNamed: #OSProcessPlugin) ifTrue: [(Smalltalk at: #OSProcessPlugin) versionInformation] ifFalse: ['(not installed in this image)']. ^ Array with: (self name, ' version ', self versionString) with: ((Smalltalk hasClassNamed: #CommandShell) ifTrue: [((Smalltalk at: #CommandShell) respondsTo: #versionString) ifTrue: ['CommandShell version ', (Smalltalk at: #CommandShell) versionString] ifFalse: ['CommandShell installed (old version, no versionString)']] ifFalse: ['CommandShell is not installed']) with: osppVersion ! ! !OSProcess class methodsFor: 'version testing' stamp: 'dtl 10/7/2008 08:55'! versionString "OSProcess versionString" ^'4.3.7'! ! !OSProcess class methodsFor: 'version dependent' stamp: 'dtl 6/13/2005 01:42'! vmVersion "After Squeak version 3.6, #vmVersion was moved to SmalltalkImage " ^ ((Smalltalk classNamed: 'SmalltalkImage') ifNil: [^ Smalltalk vmVersion]) current vmVersion! ! !OSProcess class methodsFor: 'external command processing' stamp: 'dtl 1/7/2001 12:11'! waitForCommand: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process." "OSProcess waitForCommand: 'echo sleeping...; sleep 3; echo I just slept for three seconds'" ^ self thisOSProcess waitForCommand: aCommandString ! ! !OSProcess methodsFor: 'initialize - release' stamp: 'dtl 5/31/1999 13:54'! initialize self subclassResponsibility! ! !OSProcess methodsFor: 'testing' stamp: 'dtl 7/14/2001 21:12'! isExternalProcess ^ true! ! !OSProcess methodsFor: 'private' stamp: 'dtl 8/30/2003 10:11'! noAccessorAvailable ^ self class noAccessorAvailable ! ! !OSProcess methodsFor: 'accessing' stamp: 'dtl 3/18/2000 13:57'! pid ^ pid ! ! !OSProcess methodsFor: 'accessing' stamp: 'dtl 3/18/2000 13:58'! pid: processIdentifier pid := processIdentifier ! ! !OSProcess methodsFor: 'printing' stamp: 'dtl 10/17/1999 21:12'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' with pid '. self pid printOn: aStream! ! OSProcess subclass: #ThisOSProcess instanceVariableNames: 'sessionID stdIn stdOut stdErr processAccessor allMyChildren' classVariableNames: 'ThisInstance' poolDictionaries: '' category: 'OSProcess-Base'! !ThisOSProcess commentStamp: '' prior: 0! I represent the operating system process in which the Squeak VM is currently running. My subclasses implement system specific features for Unix, Windows, MacOS, or other operating systems by collaborating with corresponding subclasses of OSProcessAccessor to provide primitive access to the external operating system. ! ThisOSProcess subclass: #MacProcess instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Mac'! !MacProcess commentStamp: '' prior: 0! I represent a Macintosh operating system process, such as the process in which the Squeak VM is currently running. I collaborate with an instance of MacOSProcessAccessor to provide primitive access to the external operating system. My instance variables are maintained as a convenience to allow inspection of an OSProcess. Access to these variables should always be done with my accessor methods, which update the instance variables by querying my MacOSProcessAccessor.! !MacProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:46'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ self isNonUnixMac ! ! !MacProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:18'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process. Answer an instance of ExternalMacOSProcess which is a proxy for the new MacOS process." self notYetImplemented ! ! !MacProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:18'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Use my processAccessor to call vfork() and execve() and create a new child task. Answer a proxy for the new task, an instance of ExternalMacOSProcess." self notYetImplemented ! ! !MacProcess methodsFor: 'environment' stamp: 'dtl 10/18/2001 20:09'! getCwd "Not yet implemented - answer a reasonable default." ^ FileDirectory default pathName! ! !MacProcess methodsFor: 'initialize - release' stamp: 'dtl 10/14/2001 14:03'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." ! ! !MacProcess methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:46'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self class isNonUnixMac! ! ThisOSProcess subclass: #OS2Process instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-OS2'! !OS2Process commentStamp: '' prior: 0! I represent an OS2 operating system process, such as the process in which the Squeak VM is currently running. I collaborate with an instance of OS2OSProcessAccessor to provide primitive access to the external operating system. My instance variables are maintained as a convenience to allow inspection of an OSProcess. Access to these variables should always be done with my accessor methods, which update the instance variables by querying my OS2OSProcessAccessor.! !OS2Process class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:47'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ self isOS2 ! ! !OS2Process methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:18'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process. Answer an instance of ExternalOS2OSProcess which is a proxy for the new OS2 process." self notYetImplemented ! ! !OS2Process methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:18'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Use my processAccessor to call vfork() and execve() and create a new child task. Answer a proxy for the new task, an instance of ExternalOS2OSProcess." self notYetImplemented ! ! !OS2Process methodsFor: 'environment' stamp: 'dtl 10/18/2001 20:10'! getCwd "Not yet implemented - answer a reasonable default." ^ FileDirectory default pathName! ! !OS2Process methodsFor: 'initialize - release' stamp: 'dtl 10/14/2001 14:03'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." ! ! !OS2Process methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:47'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self class isOS2 ! ! ThisOSProcess subclass: #RiscOSProcess instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-RiscOS'! !RiscOSProcess commentStamp: '' prior: 0! I represent an Acorn RiscOS operating system task, such as the task in which the Squeak VM is currently running. I collaborate with a singleton instance of RiscOSProcessAccessor to provide primitive access to the external operating system. My instance variables are maintained as a convenience to allow inspection of a RiscOSProcess. Access to these variables should always be done with my accessor methods, which update the instance variables by querying my RiscOSProcessAccessor. ! !RiscOSProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:48'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ self isRiscOS ! ! !RiscOSProcess class methodsFor: 'utility' stamp: 'dtl 3/11/2001 11:47'! makeVmIn: buildDirectoryPathName "Rebuild the virtual machine and plugins in the buildDirectoryPathName directory. If the build is successful, save the image and restart using the new VM. This assumes that the currently executing VM is either located in, or linked to, the buildDirectoryPathName directory." ! ! !RiscOSProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:18'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process. Answer an instance of ExternalRiscOSProcess which is a proxy for the new RiscOS task." self notYetImplemented ! ! !RiscOSProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:18'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Use my processAccessor to call vfork() and execve() and create a new child task. Answer a proxy for the new task, an instance of ExternalRiscOSProcess." self notYetImplemented ! ! !RiscOSProcess methodsFor: 'environment' stamp: 'dtl 10/18/2001 20:10'! getCwd "Not yet implemented - answer a reasonable default." ^ FileDirectory default pathName! ! !RiscOSProcess methodsFor: 'initialize - release' stamp: 'dtl 10/14/2001 14:04'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." ! ! !RiscOSProcess methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:48'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self class isRiscOS ! ! !ThisOSProcess class methodsFor: 'concrete subclasses' stamp: 'dtl 3/5/2005 12:08'! concreteClass "ThisOSProcess concreteClass" ^ self subclasses detect: [:c | c isResponsibleForThisPlatform] ifNone: [self notify: self printString, ': No concrete class implementation available for system type ', self platformName printString. nil] ! ! !ThisOSProcess class methodsFor: 'initialize-release' stamp: 'dtl 10/6/2008 21:42'! initialize "ThisOSProcess initialize" OSProcess initialize. "required to ensure the change sets file in smoothly" AttachableFileStream initialize. OSProcessAccessor initialize. self initializeThisOSProcess. "Some images may have a bug in startup list processing. Add this class to a known place in the middle of the list to avoid getting bitten by the bug." Smalltalk addToStartUpList: ThisOSProcess after: ImageSegment. Smalltalk addToShutDownList: ThisOSProcess ! ! !ThisOSProcess class methodsFor: 'initialize-release' stamp: 'dtl 3/18/2007 11:08'! initializeThisOSProcess "Initialize the singleton instance, creating a new instance only if the platform type has changed since shutdown (running on a different type of computer)." (ThisInstance isNil or: [ThisInstance isResponsibleForThisPlatform not]) ifTrue: [ThisInstance := self concreteClass basicNew initialize]! ! !ThisOSProcess class methodsFor: 'instance creation' stamp: 'dtl 11/5/2000 16:10'! new self notify: self name, ': Only one instance of ThisOSProcess or any of its subclasses should exist in the image. Use #thisOSProcess to obtain the singleton instance.'. self shouldNotImplement! ! !ThisOSProcess class methodsFor: 'system startup' stamp: 'dtl 10/7/2008 06:53'! shutDown: quitting "Break dependency on my OSProcessAccessor. This is done explicitly at shutDown time in order to prevent possible problems when an image is restarted on another platform type, in which case a new ThisOSProcess instance is created and the old instance could still have an unwanted dependency on an OSProcessAccessor." quitting ifTrue: [OSProcess accessor breakDependents] ! ! !ThisOSProcess class methodsFor: 'system startup' stamp: 'dtl 3/14/2007 23:24'! startUp: resuming "Initialize my singleton instance, and the singleton instance of my OSProcessAccessor. On Unix, set the signal handler in my process accessor to respond to externally generated sigchld signals. This must be done after each image restart in order to call a primitive which informs the VM of the identity of the semaphore to signal. When not running on a Unix system, the primitive fails and the method has no effect. Notify dependents of the singleton instance if the image has restarted in a different OS process (this is not the case when #startUp is called after a simple image save). The notification is done in the initialization of my OSProcessAccessor." OSProcessAccessor startUp: resuming. AioEventHandler startUp: resuming. self initializeThisOSProcess. self thisOSProcess initialize! ! !ThisOSProcess class methodsFor: 'instance creation' stamp: 'dtl 10/1/2006 08:38'! thisOSProcess "Answer a single instance of the class corresponding to the OS process in which this Smalltalk image is executing." "ThisOSProcess thisOSProcess" ^ ThisInstance! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:22'! activeChildren "Answer child processes which are currently believed to be running." "OSProcess thisOSProcess activeChildren inspect" ^ self allMyChildren select: [ :p | p isRunning ] ! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:20'! allMyChildren allMyChildren ifNil: [ allMyChildren := Dictionary new ]. ^ allMyChildren! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/5/2003 21:59'! canConnectToXDisplay: xDisplayName "Open and close a connection to displayName. It the connection was successfully opened, answer true; otherwise false. This is intended to check for the ability to open an X display prior to actually making the attempt." "self thisOSProcess canConnectToXDisplay: ':0.0' " "self thisOSProcess canConnectToXDisplay: ':1' " "self thisOSProcess canConnectToXDisplay: 'bogus:0' " "<-make sure network is running first!!" (xDisplayName isKindOf: String) ifFalse: [^ false]. ^ self processAccessor primCanConnectToXDisplay: xDisplayName ! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:25'! childPids ^ self allMyChildren keys asArray ! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/6/2003 06:35'! closeXDisplay "Become headless by closing the X session. All subsequent processing should involve no further display interaction." "self thisOSProcess closeXDisplay" | proc | proc := self processAccessor primKillDisplay. proc ifNil: [self noAccessorAvailable]. ^ proc ! ! !ThisOSProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:15'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process. Answer an instance of ExternalMacOSProcess which is a proxy for the new OS process." self subclassResponsibility! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/5/2003 22:05'! currentXDisplayName "self thisOSProcess currentXDisplayName" ^ self processAccessor primGetXDisplayName! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/6/2003 06:35'! decapitate "Become headless by closing the X session. All subsequent processing should involve no further display interaction." "self thisOSProcess decapitate" ^ self closeXDisplay ! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:24'! discardExitedChildren "Remove entries for completed child processed from dictionary." self updateAllMyChildren. ^ allMyChildren := self allMyChildren select: [ :p | p isComplete not ] ! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/6/2003 06:30'! disconnectXDisplay "Disconnect from the X server, but do not close the existing Squeak window. A new display medium must be opened before further interaction with the display." "self thisOSProcess disconnectXDisplay" | proc | proc := self processAccessor primDisconnectDisplay. proc ifNil: [self noAccessorAvailable]. ^ proc ! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/5/2003 22:12'! displayOnXServer: xDisplayName "Check if it is possible to open a display on the X server identified by xDisplayName. If so, close the current X display and reopen it on the new server. On success, answer the previous display name. On failure, answer a string with an error message. This method is expected to be called by a web server or other application which may wish to make use of the result string." "self thisOSProcess displayOnXServer: ':0.0' " "self thisOSProcess displayOnXServer: 'unix:0' " "self thisOSProcess displayOnXServer: ':1' " "self thisOSProcess displayOnXServer: 'noSuchMachine'" "self thisOSProcess displayOnXServer: 'noSuchMachine:0'" "<-make sure network is running first!!" | previousDisplayName | (xDisplayName isKindOf: String) ifFalse: [^ 'expected display name string']. previousDisplayName := self currentXDisplayName. (self canConnectToXDisplay: xDisplayName) ifTrue: [self decapitate. self setXDisplayName: xDisplayName. self recapitate. ^ previousDisplayName] ifFalse: [^ 'cannot connect to display ', xDisplayName] ! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:22'! exitedChildren "Answer child processes which have exited and are no longer running." "OSProcess thisOSProcess exitedChildren inspect" ^ self allMyChildren select: [ :p | p isComplete ] ! ! !ThisOSProcess methodsFor: 'finalization' stamp: 'dtl 11/4/2000 15:49'! finalize processAccessor ifNotNil: [processAccessor removeDependent: self. processAccessor finalize]. processAccessor := nil! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 9/1/2003 13:15'! flushXDisplay "Synchronize output to the X display." "self thisOSProcess flushXDisplay" ^ self processAccessor primFlushXDisplay ! ! !ThisOSProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:16'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Use my processAccessor to call vfork() and execve() and create a new child task. Answer a proxy for the new task, an instance of ExternalOSProcess." self subclassResponsibility! ! !ThisOSProcess methodsFor: 'environment' stamp: 'dtl 10/18/2001 20:10'! getCwd self subclassResponsibility! ! !ThisOSProcess methodsFor: 'private - IOHandle' stamp: 'dtl 9/25/2005 16:23'! handleFromAccessor: aByteArrayOrIOAccessor UseIOHandle ifTrue: [aByteArrayOrIOAccessor isNil ifTrue: [^ nil] ifFalse: [^ aByteArrayOrIOAccessor asSQFileStruct]] ifFalse: [^ aByteArrayOrIOAccessor] ! ! !ThisOSProcess methodsFor: 'private - IOHandle' stamp: 'dtl 9/25/2005 16:22'! handleFromFileStream: aFileStream UseIOHandle ifTrue: [^ aFileStream ioHandle asSQFileStruct] ifFalse: [^ aFileStream fileID] ! ! !ThisOSProcess methodsFor: 'initialize - release' stamp: 'dtl 12/23/2007 09:38'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." processAccessor ifNotNil: [processAccessor breakDependents. processAccessor := nil]. ((self processAccessor notNil and: [processAccessor canAccessSystem]) and: [pid ~= processAccessor primGetPid]) ifTrue: [self resetChildProcessDictionary] ! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/24/2003 10:12'! isConnectedToXServer "Answer true if VM is currently connected to an X server." "self thisOSProcess isConnectedToXServer" ^ self processAccessor primIsConnectedToXServer ! ! !ThisOSProcess methodsFor: 'platform identification' stamp: 'dtl 10/10/2001 21:24'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self subclassResponsibility! ! !ThisOSProcess methodsFor: 'private - IOHandle' stamp: 'dtl 9/25/2005 16:23'! isStdErr: anIOHandle "Answer true if anIOHandle represents stderr." | realHandle | anIOHandle ifNil: [^ false]. realHandle := self processAccessor getStdErrHandle. realHandle ifNil: [^ false]. UseIOHandle ifTrue: [^ anIOHandle handle = realHandle handle] ifFalse: [^ anIOHandle = realHandle] ! ! !ThisOSProcess methodsFor: 'private - IOHandle' stamp: 'dtl 9/25/2005 16:23'! isStdIn: anIOHandle "Answer true if anIOHandle represents stdin." | realHandle | anIOHandle ifNil: [^ false]. realHandle := self processAccessor getStdInHandle. realHandle ifNil: [^ false]. UseIOHandle ifTrue: [^ anIOHandle handle = realHandle handle] ifFalse: [^ anIOHandle = realHandle] ! ! !ThisOSProcess methodsFor: 'private - IOHandle' stamp: 'dtl 9/25/2005 16:23'! isStdOut: anIOHandle "Answer true if anIOHandle represents stdout." | realHandle | anIOHandle ifNil: [^ false]. realHandle := self processAccessor getStdOutHandle. realHandle ifNil: [^ false]. UseIOHandle ifTrue: [^ anIOHandle handle = realHandle handle] ifFalse: [^ anIOHandle = realHandle] ! ! !ThisOSProcess methodsFor: 'updating' stamp: 'dtl 2/26/2002 08:37'! needsRefresh "Answer true if the sessionID variable is out of date with respect to the running OS Process. Subclasses should provide implementation, answer true as default." ^ true! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/6/2003 06:36'! openXDisplay "Restore headful display opening the X session." "self thisOSProcess closeXDisplay. (Delay forSeconds: 5) wait. self thisOSProcess openXDisplay." | proc | proc := self processAccessor primOpenXDisplay. proc ifNil: [self noAccessorAvailable]. ^ proc ! ! !ThisOSProcess methodsFor: 'accessing' stamp: 'dtl 2/28/2002 13:30'! processAccessor | a | processAccessor ifNil: [a := OSProcessAccessor forThisOSProcess. a isResponsibleForThisPlatform ifTrue: [processAccessor := a. processAccessor addDependent: self]]. ^ processAccessor! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/6/2003 06:34'! recapitate "Restore headful display opening the X session." "self thisOSProcess decapitate. (Delay forSeconds: 5) wait. self thisOSProcess recapitate." ^ self openXDisplay ! ! !ThisOSProcess methodsFor: 'updating' stamp: 'dtl 2/26/2002 08:32'! refreshFromProcessAccessor "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." self subclassResponsibility! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/26/2002 09:52'! registerChildProcess: anOSProcess self allMyChildren at: anOSProcess pid put: anOSProcess. ^ anOSProcess ! ! !ThisOSProcess methodsFor: 'updating' stamp: 'dtl 2/26/2002 08:35'! resetChildProcessDictionary "Forget all the entries in the allMyChildren dictionary. This method may be called when a new session is started, since the child processes of the previous session are probably no longer of any interest." self updateAllMyChildren. "Ensure contents are up to date before releasing them." allMyChildren := nil. self allMyChildren ! ! !ThisOSProcess methodsFor: 'accessing' stamp: 'dtl 9/26/2005 20:04'! sessionID ^ sessionID! ! !ThisOSProcess methodsFor: 'private' stamp: 'dtl 9/25/2005 13:28'! setStdErr "If stdErr is nil, then set it. If not nil, check to see if it is has a valid connection to stderr. If not valid, then replace it, otherwise answer the existing valid stream. Obscure bug warning: If a valid AttachableFileStream on stderr is garbage collected, then stderr will be closed. It is advisable (but not necessary) to treat the stream on stderr as a singleton, but in any case, any extra instances attached to stderr should not be allowed to be garbage collected." | stdErrHandle | stdErr ifNotNil: [(self isStdErr: stdErr ioHandle) ifTrue: [^ stdErr]]. stdErrHandle := self processAccessor getStdErrHandle. stdErrHandle ifNotNil: [stdErr := AttachableFileStream name: 'stderr' attachTo: stdErrHandle writable: true]. ^ stdErr ! ! !ThisOSProcess methodsFor: 'private' stamp: 'dtl 9/25/2005 13:28'! setStdIn "If stdIn is nil, then set it. If not nil, check to see if it is has a valid connection to stdin. If not valid, then replace it, otherwise answer the existing valid stream. Obscure bug warning: If a valid AttachableFileStream on stdin is garbage collected, then stdin will be closed. It is advisable (but not necessary) to treat the stream on stdin as a singleton, but in any case, any extra instances attached to stdin should not be allowed to be garbage collected." | stdInHandle | stdIn ifNotNil: [(self isStdIn: stdIn ioHandle) ifTrue: [^ stdIn]]. stdInHandle := self processAccessor getStdInHandle. stdInHandle ifNotNil: [stdIn := AttachableFileStream name: 'stdin' attachTo: stdInHandle writable: false]. ^ stdIn ! ! !ThisOSProcess methodsFor: 'private' stamp: 'dtl 9/25/2005 13:29'! setStdOut "If stdOut is nil, then set it. If not nil, check to see if it is has a valid connection to stdout. If not valid, then replace it, otherwise answer the existing valid stream. Obscure bug warning: If a valid AttachableFileStream on stdout is garbage collected, then stdout will be closed. It is advisable (but not necessary) to treat the stream on stdout as a singleton, but in any case, any extra instances attached to stdout should not be allowed to be garbage collected." | stdOutHandle | stdOut ifNotNil: [(self isStdOut: stdOut ioHandle) ifTrue: [^ stdOut]]. stdOutHandle := self processAccessor getStdOutHandle. stdOutHandle ifNotNil: [stdOut := AttachableFileStream name: 'stdout' attachTo: stdOutHandle writable: true]. ^ stdOut ! ! !ThisOSProcess methodsFor: 'display management' stamp: 'dtl 8/5/2003 22:16'! setXDisplayName: xDisplayName "Set X display name for use by the next call to recapitate" "self thisOSProcess setXDisplayName: 'unix:0' " "self thisOSProcess setXDisplayName: ':1' " self processAccessor primSetXDisplayName: xDisplayName ! ! !ThisOSProcess methodsFor: 'accessing' stamp: 'dtl 9/25/2005 13:30'! stdErr ^ stdErr! ! !ThisOSProcess methodsFor: 'accessing' stamp: 'dtl 9/25/2005 13:30'! stdIn ^ stdIn! ! !ThisOSProcess methodsFor: 'accessing' stamp: 'dtl 9/25/2005 13:31'! stdOut ^ stdOut! ! !ThisOSProcess methodsFor: 'updating' stamp: 'dtl 10/15/2001 21:27'! update: aParameter aParameter == #invalidProcessAccessor ifTrue: [processAccessor := nil]. ^ super update: aParameter! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:23'! updateActiveChildren "Test each active child for its completion status and update runState and exitStatus accordingly. This method may be called when a semaphore is set indicating that some child OSProcess has died. A better approach might be to use an event queue for death of child events; however, until event queues are part of Squeak image, this polling mechanism is sufficient." self activeChildren do: [:child | child update: #runState] ! ! !ThisOSProcess methodsFor: 'child process management' stamp: 'dtl 2/25/2002 23:23'! updateAllMyChildren "Test each child to make sure that it is still accessible. If the child is believed to be running, check to see if it has exited, and update runState and exitStatus accordingly." self allMyChildren do: [:child | child update: #accessibility. child isRunning ifTrue: [child update: #runState]]! ! ThisOSProcess subclass: #UnixProcess instanceVariableNames: 'ppid pthread path programName arguments environment' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Unix'! !UnixProcess commentStamp: '' prior: 0! I represent the Unix operating system process in which this Squeak session is running. I collaborate with an instance of UnixOSProcessAccessor to provide access to the external operating system. My instance variables are updated when my process accessor changes, allowing them to be monitored with a Smalltalk inspector. ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 3/10/2001 09:51'! allMyChildren "UnixProcess allMyChildren" ^ self thisOSProcess allMyChildren ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 3/10/2001 09:52'! arguments "UnixProcess arguments" ^ self thisOSProcess arguments ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 2/23/2006 06:58'! backgroundProcessInHeadlessSqueak "Demonstrate running a ''batch job'' in a low priority background Squeak, with output written to an OSPipe. This Squeak image reads data from the pipe and displays it on the Transcript. The background Squeak will write enough data to block an OSPipe, so the foreground Squeak loops while reading available data up to end of file. Open a Transcript, then '' inspect it '' on this method. Process runs indefinitely, so terminate the process to end demo." "UnixProcess backgroundProcessInHeadlessSqueak" ^ [[| pipe backgroundJob ws | pipe := OSPipe new. backgroundJob := OSProcess thisOSProcess forkHeadlessSqueakAndDoThenQuit: [| beers | OSProcess accessor nice: 1. "lower priority of background OS process" beers := [:i | (i < 1 ifTrue: ['no more'] ifFalse: [i asString]) , ' bottle' , (i = 1 ifTrue: [''] ifFalse: ['s'])]. (99 to: 1 by: -1) do: [:count | pipe nextPutAll: (beers value: count) , ' of beer on the wall, ' , (beers value: count) , ' of beer' , String cr , 'take one down and pass it around, ' , (beers value: count - 1) , ' of beer on the wall'; cr]. pipe close]. WorldState addDeferredUIMessage: [Transcript show: backgroundJob asString , ' started'; cr]. pipe closeWriter. "don't need writer end, close it before the #upToEnd" "pipe writer blocks when pipe full, so we need to loop while reading to end " ws := WriteStream on: ''. [backgroundJob isComplete] whileFalse: [(Delay forMilliseconds: 200) wait. pipe upToEnd ifNotNilDo: [:s | ws nextPutAll: s]]. pipe close. WorldState addDeferredUIMessage: [Transcript show: backgroundJob asString , ' completed, display results in 2 seconds'; cr]. (Delay forSeconds: 2) wait. WorldState addDeferredUIMessage: [Transcript show: ws contents. Transcript cr; show: 'delay 5 seconds before forking next Squeak job'; cr]. (Delay forSeconds: 5) wait] repeat] forkAt: Processor userBackgroundPriority! ! !UnixProcess class methodsFor: 'X display - deprecated' stamp: 'dtl 8/5/2003 22:10'! canConnectToXDisplay: xDisplayName "Deprecated. See ThisOSProcess>canConnectToXDisplay:" "self canConnectToXDisplay: ':0.0' " ^ self thisOSProcess canConnectToXDisplay: xDisplayName ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:17'! catAFile "Copy contents of a file to standard output. This demonstrates reassigning stdin to an open FileStream." "UnixProcess catAFile" | in proc | in := FileStream readOnlyFileNamed: '/etc/hosts'. proc := self forkJob: '/bin/cat' arguments: nil environment: nil descriptors: (Array with: in with: nil with: nil). in close. proc ifNil: [self noAccessorAvailable]. ^ proc! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:28'! catFromFileToFiles "Copy contents of a file to another file, with any error messages going to a third file." "UnixProcess catFromFileToFiles" | in out err proc | in := FileStream readOnlyFileNamed: '/etc/hosts'. out := FileStream newFileNamed: '/tmp/deleteMe.out'. err := FileStream newFileNamed: '/tmp/deleteMe.err'. proc := UnixProcess forkJob: '/bin/cat' arguments: nil environment: nil descriptors: (Array with: in with: out with: err). in close. out close. err close. proc ifNil: [self noAccessorAvailable]. ^ proc! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 11/14/2000 00:07'! clientServerDemo "Start a new headless instance of Squeak running in a child OS process. The new instance is a nearly identical copy of its parent, resuming execution at the same point as the parent. The child process will run a TCP server process in the headless image, then exit. Test results are written to the Transcript. Answer '127 0 0 1' in response to the host address dialog." "UnixProcess clientServerDemo" | proc | proc := self forkHeadlessSqueakAndDoThenQuit: [Socket remoteTestServerTCP]. proc ifNotNil: [Socket remoteTestClientTCP]. ^ proc ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 1/7/2001 12:55'! clientServerDemo2 "Start a new instance of Squeak running in a child OS process. The new instance is a nearly identical copy of its parent, resuming execution at the same point as the parent. The child process will run a TCP server process, then exit. Test results are written to the Transcript. " "UnixProcess clientServerDemo2" | remotePort remoteHost serverBlock socket buffer n bytesToSend sendBuf receiveBuf done bytesSent bytesReceived packetsSent packetsReceived t | remotePort := 54321. remoteHost := 'localhost'. serverBlock := [Transcript clear; cr; show: 'This is the server Squeak session'; cr. Socket initializeNetworkIfFail: [^ nil]. socket := Socket newTCP. socket listenOn: remotePort. buffer := String new: 4000. socket waitForConnectionUntil: Socket standardDeadline. [socket isConnected] whileTrue: [socket dataAvailable ifTrue: [n := socket receiveDataInto: buffer. socket sendData: buffer count: n]]. socket closeAndDestroy]. (UnixProcess forkSqueakAndDoThenQuit: serverBlock) ifNil: [self noAccessorAvailable. ^ nil]. Transcript cr; show: 'This is the client Squeak session'; cr. Transcript show: 'starting client/server TCP test'; cr. Transcript show: 'initializing network ... '. Socket initializeNetworkIfFail: [^ Transcript show: 'failed']. Transcript show: 'ok'; cr. socket := Socket newTCP. socket connectTo: (NetNameResolver addressForName: remoteHost) port: remotePort. socket waitForConnectionUntil: Socket standardDeadline. Transcript show: 'client endpoint created'; cr. bytesToSend := 1000000. sendBuf := String new: 4000 withAll: $x. receiveBuf := String new: 50000. done := false. bytesSent := bytesReceived := packetsSent := packetsReceived := 0. t := Time millisecondsToRun: [[done] whileFalse: [(socket sendDone and: [bytesSent < bytesToSend]) ifTrue: [packetsSent := packetsSent + 1. bytesSent := bytesSent + (socket sendData: sendBuf)]. socket dataAvailable ifTrue: [packetsReceived := packetsReceived + 1. bytesReceived := bytesReceived + (socket receiveDataInto: receiveBuf)]. done := bytesSent >= bytesToSend]. [bytesReceived < bytesToSend] whileTrue: [socket dataAvailable ifTrue: [packetsReceived := packetsReceived + 1. bytesReceived := bytesReceived + (socket receiveDataInto: receiveBuf)]]]. socket closeAndDestroy. Transcript show: 'remoteClient TCP test done; time = ' , t printString; cr. Transcript show: packetsSent printString , ' packets, ' , bytesSent printString , ' bytes sent (' , (bytesSent * 1000 // t) printString , ' bytes/sec)'; cr. Transcript show: packetsReceived printString , ' packets, ' , bytesReceived printString , ' bytes received (' , (bytesReceived * 1000 // t) printString , ' bytes/sec)'; cr. ^ bytesReceived! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 9/9/2000 16:00'! cloneSqueak "Start a new instance of Squeak running in a child OS process. The new instance is a nearly identical copy of its parent, resuming execution at the same point as the parent, and differentiated only by the return value of this method." "UnixProcess cloneSqueak" | proc | proc := self forkSqueak. proc ifNil: [self noAccessorAvailable]. ^ proc ! ! !UnixProcess class methodsFor: 'X display - deprecated' stamp: 'dtl 8/5/2003 22:10'! currentXDisplayName "Deprecated. See ThisOSProcess>>currentXDisplayName" "self currentXDisplayName" ^ self thisOSProcess currentXDisplayName ! ! !UnixProcess class methodsFor: 'X display - deprecated' stamp: 'dtl 8/5/2003 22:09'! decapitate "Deprecated. See ThisOSProcess>>decapitate" "self decapitate" ^ OSProcess thisOSProcess decapitate! ! !UnixProcess class methodsFor: 'X display - deprecated' stamp: 'dtl 8/5/2003 22:18'! displayOnXServer: xDisplayName "Deprecated. See ThisOSProcess>>displayOnXServer" "self displayOnXServer: ':0.0' " "self displayOnXServer: 'unix:0' " "self displayOnXServer: ':1' " "self displayOnXServer: 'noSuchMachine'" "self displayOnXServer: 'noSuchMachine:0'" "<-make sure network is running first!!" ^ OSProcess thisOSProcess displayOnXServer: xDisplayName! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:31'! eightLeafSqueakTree "Clone this squeak three times, resulting in a total of (2 raisedTo: 3) nearly identical squeaks. Have a look at the pidArray inspectors and to the debug messages on stdout in order to see what is going on. The tree of processes looks like this: 111 +--------+--------+ | | | 011 101 110 +---+ | | | 100 010 001 | 000 " "UnixProcess eightLeafSqueakTree inspect" | depth this pidArray debugString | depth := 3. this := OSProcess thisOSProcess. this stdOut ifNil: [self noAccessorAvailable. ^ nil]. pidArray := Array new: depth. (1 to: depth) do: [ :e | | p pid | p := this forkSqueak. pid := (p == this) ifTrue: [0] ifFalse: [p pid]. "Use Unix fork(2) convention" pidArray at: e put: pid]. debugString := 'pid ', (this pid printString), ' ppid ', (this ppid printString), ' ', (pidArray printString), (Character lf asString). this stdOut nextPutAll: debugString. ^ pidArray! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 12/27/2000 17:18'! env "Note: The #environment selector has special meaning for classes, so use #env." "UnixProcess env" ^ self thisOSProcess environment ! ! !UnixProcess class methodsFor: 'child process creation' stamp: 'dtl 12/27/2000 16:57'! forkHeadlessSqueakAndDo: aBlock "Start a new instance of Squeak running in a child OS process, and execute aBlock in the child instance. The new instance is a clone of this image, but without a connection to the X display. The child instance executes aBlock, which hopefully does not involve interaction with the X display; and the parent continues normally. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess forkHeadlessSqueakAndDo: [UnixProcess helloWorld]" ^ self thisOSProcess forkHeadlessSqueakAndDo: aBlock ! ! !UnixProcess class methodsFor: 'child process creation' stamp: 'dtl 12/27/2000 17:00'! forkHeadlessSqueakAndDoThenQuit: aBlock "Start a new instance of Squeak running in a child OS process, and execute aBlock in the child instance. The new instance is a clone of this image, but without a connection to the X display. The child instance executes aBlock, which hopefully does not involve interaction with the X display; and the parent continues normally. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess forkHeadlessSqueakAndDoThenQuit: [UnixProcess helloWorld]" ^ self thisOSProcess forkHeadlessSqueakAndDoThenQuit: aBlock ! ! !UnixProcess class methodsFor: 'child process creation' stamp: 'dtl 12/27/2000 16:48'! forkJob: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Call Unix vfork() and execve() to create a child process, and answer the child process. Delegate this to the singleton OSProcess>>thisOSProcess." ^ self thisOSProcess forkJob: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams! ! !UnixProcess class methodsFor: 'child process creation' stamp: 'dtl 7/5/2000 07:19'! forkSqueak "Start a new instance of Squeak running in a child OS process. The new instance is a clone of this image except for the return value of this method. It does not reload the image file from disk. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess forkSqueak" ^ self thisOSProcess forkSqueak. ! ! !UnixProcess class methodsFor: 'child process creation' stamp: 'dtl 10/8/2001 20:40'! forkSqueakAndDo: aBlock "Start a new instance of Squeak running in a child OS process. The new instance is a clone of this image except for the return value of this method. It does not reload the image file from disk. The child image evaluates aBlock. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess forkSqueakAndDo: [Object inform: 'Hi, I am the child Squeak process.']" ^ self thisOSProcess forkSqueakAndDo: aBlock ! ! !UnixProcess class methodsFor: 'child process creation' stamp: 'dtl 10/8/2001 20:41'! forkSqueakAndDoThenQuit: aBlock "Start a new instance of Squeak running in a child OS process. The new instance is a clone of this image except for the return value of this method. It does not reload the image file from disk. The child image evaluates aBlock. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess forkSqueakAndDoThenQuit: [Object inform: 'Hi, I am the child Squeak process. Click OK to exit the child Squeak.']" ^ self thisOSProcess forkSqueakAndDoThenQuit: aBlock ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 05:11'! headlessChild "Start a new instance of Squeak running in a child OS process. The new instance is a nearly identical copy of its parent, resuming execution at the same point as the parent, and differentiated only by the return value of this method. The child squeak will write a message to standard output, then exit." "UnixProcess headlessChild" | this childBlock | this := OSProcess thisOSProcess. childBlock := [this stdOut nextPutAll: 'hello world from child process '. this pid printOn: OSProcess thisOSProcess stdOut. this stdOut nextPut: Character lf ]. ^ self forkHeadlessSqueakAndDoThenQuit: childBlock ! ! !UnixProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:49'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ self isUnix ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:34'! listDirectory "Execute a simple command, sending output to standard output." "UnixProcess listDirectory" | proc | proc := self forkJob: '/bin/ls' arguments: nil environment: nil descriptors: nil. proc ifNil: [self noAccessorAvailable]. ^ proc! ! !UnixProcess class methodsFor: 'utility - VM building' stamp: 'dtl 10/19/2001 13:31'! makeVmIn: buildDirectoryPathName "Rebuild the virtual machine and plugins in the buildDirectoryPathName directory. If the build is successful, save the image and restart using the new VM. This assumes that the currently executing VM is either located in, or linked to, the buildDirectoryPathName directory." "UnixProcess makeVmIn: '/usr/local/squeak/Squeak-2.8/build'" "UnixProcess makeVmIn: nil" ^ self makeVmIn: (buildDirectoryPathName ifNil: ['']) interactive: true ! ! !UnixProcess class methodsFor: 'utility - VM building' stamp: 'dtl 10/19/2001 11:41'! makeVmIn: buildDirectoryPathName interactive: aBoolean "Rebuild the virtual machine and plugins in the buildDirectoryPathName directory. If the build is successful, save the image and restart using the new VM. This assumes that the currently executing VM is either located in, or linked to, the buildDirectoryPathName directory. If aBoolean is true, display interactive dialogs, otherwise output goes only to the Transcript." "UnixProcess makeVmIn: '/usr/local/squeak/Squeak-2.8/build' interactive: true" | commandString result | commandString := 'cd ', buildDirectoryPathName, '; make'. Transcript cr; show: 'running external command "', commandString, '"'; cr. result := self waitForCommandOutputArray: commandString. ((result at: 3) == 0 and: [(result at: 2) isEmpty]) ifTrue: [Transcript show: 'make completed successfully, restarting VM'; cr. aBoolean ifTrue: [self inform: 'make completed successfully, restarting VM']. self quitAndRestart] ifFalse: [Transcript show: (result at: 2); cr. Transcript show: 'make did not succeed, VM will not be restarted'; cr. aBoolean ifTrue: [self inform: 'make did not succeed, VM will not be restarted'. self inform: (result at: 2)]]. ^ result ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 12/27/2000 17:16'! path "UnixProcess path" ^ self thisOSProcess path ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 3/10/2001 09:53'! programName "UnixProcess programName" ^ self thisOSProcess programName ! ! !UnixProcess class methodsFor: 'X display - deprecated' stamp: 'dtl 8/5/2003 22:15'! recapitate "Deprecated. See ThisOSProcess>>recapitate" "self decapitate. (Delay forSeconds: 5) wait. self recapitate." ^ OSProcess thisOSProcess recapitate! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 3/17/2002 13:38'! restartVirtualMachine "Fork a new instance and quit this one. This moves the running VM into a new OS process, and starts a new X display for the new process. It does not reload the VM program text, so this cannot be used to restart the VM after rebuild." "UnixProcess restartVirtualMachine" | proc | proc := self forkSqueak. proc isNil ifTrue: [self noAccessorAvailable. nil] ifFalse: [OSProcess thisOSProcess == proc ifFalse: ["Quit if this is the parent process" Smalltalk quitPrimitive]]. ^ proc! ! !UnixProcess class methodsFor: 'unit tests' stamp: 'dtl 3/5/2005 14:19'! runTests "Run a few tests to see if things are working correctly on Unix/Linux. Output is on stdout, stderr, and the Squeak Transcript. One of the tests requires input from stdin, so Squeak should be run from a shell command line and not as a background process. Warning: This test will crash your VM if your are using the -xshm command line option. For reasons which I do not quite understand, the X shared memory segment becomes invalid when the Squeak VM which initially opened the shared memory exits. The remaining Squeak children will crash when then then next try to update the display. Note: If you see 'select: Bad file descriptor' messages on your console standard output, these are occuring while running headless in the decapitate/recapitate tests. Important: Prior to evaluating this method, please type one line of text followed by a on the terminal standard input. This provides the input for the stdin test. Failing to provide this input prior to evaluating the tests will cause one of the test cases to fail." "UnixProcess runTests" | this s p failures result a | failures := 0. Transcript show: 'Begin OSProcess tests'; cr. Transcript show: 'Test for working ProcessAccessor ... '. this := OSProcess thisOSProcess. (this pid isKindOf: Integer) ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'Echo one line of text previously entered from stdin ... '. s := OSProcess readFromStdIn. s size > 0 ifTrue: [Transcript show: 'OK'; cr; show: s; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'Message to stdout ... '. (OSProcess helloWorld isKindOf: AttachableFileStream) ifTrue: [Transcript show: 'OK'; cr; show: s; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'Message to stderr ... '. (OSProcess helloStdErr isKindOf: AttachableFileStream) ifTrue: [Transcript show: 'OK'; cr; show: s; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess cataFile ... '. p := UnixProcess catAFile. (Delay forSeconds: 1) wait. p exitStatus == 0 ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess testEnvSet ... '. p := UnixProcess testEnvSet. (Delay forSeconds: 1) wait. p exitStatus == 0 ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess catFromFileToFiles ... '. OSProcess command: 'rm /tmp/deleteMe.out'. OSProcess command: 'rm /tmp/deleteMe.err'. p := UnixProcess catFromFileToFiles. (Delay forSeconds: 1) wait. p exitStatus == 0 ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess testRunCommand ... '. OSProcess command: 'rm /tmp/deleteMe.out'. OSProcess command: 'rm /tmp/deleteMe.err'. p := UnixProcess testRunCommand. (Delay forSeconds: 1) wait. p exitStatus == 256 ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess testPipe ... '. UnixProcess testPipe = 'this is some text to write into the pipe' ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess testPipeLine ... '. UnixProcess testPipeLine = 'This is the text to write out through one pipe, copy through an external cat command, and then read back in through another pipe.' ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess spawnTenHeadlessChildren ... '. p := UnixProcess spawnTenHeadlessChildren. (p size == 10 and: [(p select: [:e | (e runState == #running) | (e exitStatus == 0)]) size == 10]) ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess cloneSqueak ... '. p := UnixProcess cloneSqueak. (p isKindOf: UnixProcess) ifTrue: [(Delay forSeconds: 1) wait. OSProcess snapshot: false andQuit: true]. (Delay forSeconds: 5) wait. p exitStatus == 0 ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess squeakSqueak ... '. p := UnixProcess squeakSqueak. (Delay forSeconds: 5) wait. OSProcess thisOSProcess sigkill: p. (Delay forSeconds: 1) wait. p exitStatus == 9 ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess restartVirtualMachine ... '. p := UnixProcess restartVirtualMachine. p pid == OSProcess thisOSProcess pid ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess command: ''cat'' input: ''this is some test data'' ... '. p := (OSProcess thisOSProcess command: 'cat' input: 'this is some test data'). (Delay forSeconds: 1) wait. p upToEnd = 'this is some test data' ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'UnixProcess waitForCommandOutput: ''echo sleeping...; sleep 1; echo I just slept for one second'' ... '. ('*I just slept for one second*' match: (OSProcess thisOSProcess waitForCommandOutput: 'echo sleeping...; sleep 1; echo I just slept for one second')) ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]. Transcript show: 'Unix command pipeline with output and error returned in an array ... '. (Smalltalk hasClassNamed: #PipeableOSProcess) ifTrue: [a := (((Smalltalk at: #PipeableOSProcess) command: 'echo this is a test; BOGUS') | 'cut -c11-14') outputAndError. (((a isKindOf: Array) and: ['test*' match: (a at: 1)]) and: ['*BOGUS*' match: (a at: 2)]) ifTrue: [Transcript show: 'OK'; cr] ifFalse: [Transcript show: 'NFG'; cr. failures := failures + 1]] ifFalse: [Transcript show: 'skipping PipeableOSProcess test (requires CommandShell)'; cr]. Transcript show: 'UnixProcess decapitate and recapatiate five times'; cr. 5 timesRepeat: [UnixProcess decapitate. UnixProcess recapitate]. failures == 1 ifTrue: [result := 'OSProcess tests completed with ', failures printString, ' failure'] ifFalse: [result := 'OSProcess tests completed with ', failures printString, ' failures']. Transcript show: result; cr. ^ result ! ! !UnixProcess class methodsFor: 'utility - image save' stamp: 'dtl 11/8/2005 09:54'! saveImageInBackground "Same image in a background OS process." "UnixProcess saveImageInBackground" ^ self saveImageInBackground: self uniqueNameForSavedImage nice: false ! ! !UnixProcess class methodsFor: 'utility - image save' stamp: 'dtl 1/8/2008 22:39'! saveImageInBackground: savedImageName nice: niceFlag "When Squeak is used as a server it is sometimes desirable to periodically save image snapshots. This method forks a headless Squeak to perform a snapshot without impacting the server Squeak. Very little additional memory is required to do this because Unix copy-on-write memory management allows the two Squeak images to share object memory while the save is performed. The saved image is given a time stamped name, and the image name of the main server Squeak remains unchanged. If niceFlag is true, the background OS process runs at lowered scheduling priority." ^ self forkHeadlessSqueakAndDo: [| st | "Delay is required in the background process when forking a headless Squeak, probably necessary to permit X session stuff to settle down." (Delay forMilliseconds: 500) wait. (niceFlag notNil and: [niceFlag]) ifTrue: ["lower priority of background OS process" OSProcess accessor nice: 1]. st := SmalltalkImage current. (SourceFiles at: 2) ifNotNil: ["ensure that copying the changes file will always work" st closeSourceFiles. st saveChangesInFileNamed: (st fullNameForChangesNamed: savedImageName)]. st changeImageNameTo: savedImageName,'.image'; closeSourceFiles; openSourceFiles; "so SNAPSHOT appears in new changes file" saveImageSegments; snapshot: true andQuit: true] ! ! !UnixProcess class methodsFor: 'utility - image save' stamp: 'dtl 11/8/2005 09:48'! saveImageInBackgroundNicely "Same image in a background OS process with lowered scheduling priority." "UnixProcess saveImageInBackgroundNicely" ^ self saveImageInBackground: self uniqueNameForSavedImage nice: true ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 3/10/2001 09:53'! sessionID "UnixProcess sessionID" ^ self thisOSProcess sessionID ! ! !UnixProcess class methodsFor: 'X display - deprecated' stamp: 'dtl 8/5/2003 22:18'! setXDisplayName: xDisplayName "Deprecated. See ThisOSProcess>>setXDisplayName" "self setXDisplayName: 'unix:0' " "self setXDisplayName: ':1' " ^ OSProcess thisOSProcess setXDisplayName: xDisplayName ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:35'! spawnTenHeadlessChildren "Spawn ten Squeak children, each of which writes a message to standard output, then exits. Answer an array of pid values for the child processes. " "UnixProcess spawnTenHeadlessChildren" | childBlock count children this | this := OSProcess thisOSProcess. this stdOut ifNil: [self noAccessorAvailable. ^ nil]. count := 10. children := Array new: count. childBlock := [this stdOut nextPutAll: 'hello world from child process '. this pid printOn: this stdOut. this stdOut nextPut: Character lf. this stdOut flush]. (1 to: count) do: [:e | OSProcess thisOSProcess stdOut flush. children at: e put: (self forkHeadlessSqueakAndDoThenQuit: childBlock)]. ^ children! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:38'! squeakSqueak "Start a new instance of Squeak running in a child OS process. The new instance will restart from the image file, so it is a clone of this image as it existed at the most recent image save. See cloneSqueak for an example of how to clone the running image without going back to the saved image file." "UnixProcess squeakSqueak" | proc | proc := self squeak. proc ifNil: [self noAccessorAvailable]. ^ proc ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 7/13/2003 14:47'! startSwiki: aSwiki onPort: num loggingTo: aFileName "Start a swiki in a headless Squeak image." "UnixProcess startSwiki: 'myswiki' onPort: 8081 loggingTo: 'log.txt'" | proc | (Smalltalk hasClassNamed: #SwikiAction) ifTrue: [proc := self forkSqueakAndDo: [(Smalltalk at: #SwikiAction) new restore: 'myswiki'. (Smalltalk at: #PWS) serveOnPort: num loggingTo: aFileName. UnixProcess decapitate]. proc ifNil: [self noAccessorAvailable]. ^ proc] ifFalse: [self notify: 'PWS not installed in this image'] ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 12/27/2000 17:12'! stdErr "UnixProcess stdErr" ^ self thisOSProcess stdErr ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 12/27/2000 17:11'! stdIn "UnixProcess stdIn" ^ self thisOSProcess stdIn ! ! !UnixProcess class methodsFor: 'utility' stamp: 'dtl 12/27/2000 17:11'! stdOut "UnixProcess stdOut" ^ self thisOSProcess stdOut ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:41'! testEnvSet "Set up a new environment for a child process. Exec a shell to show the environment variables on the terminal standard output. Note that many shells will set other environment variables in addition to those which we set up prior to executing the shell." "UnixProcess testEnvSet" | e proc | e := Dictionary new. e at: #KEY1 put: 'value1'; at: #KEY2 put: 'value2'; at: #KEY3 put: 'value3'. proc := self forkJob: '/bin/sh' arguments: #('-c' 'env' ) environment: e descriptors: nil. proc ifNil: [self noAccessorAvailable]. ^ proc! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 2/11/2001 14:03'! testPipe "Create an OS pipe, write some text to it, and read the text back from the other end of the pipe." "UnixProcess testPipe inspect" | s p r | s := 'this is some text to write into the pipe'. p := OSPipe new. p ifNil: [self noAccessorAvailable. ^ p]. p writer nextPutAll: s. p writer close. r := p reader next: s size. p reader close. ^ r! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 2/24/2001 16:28'! testPipeLine "Create two OS pipes, and a child OS process with its input connected to one pipe and its output connected to the other pipe. Write some text to the input pipe, and read the resulting output (just echoed back by the Unix cat command) back through the output pipe. Send a SIGHUP signal to the child process to tell it to exit. This test verifies the ability of Squeak to send text to an external OS process through a pipe, and read the output text back from another pipe. See ConnectedUnixProcess for a more useful implementation." "UnixProcess testPipeLine inspect" | testString pipe1 pipe2 input output src dest desc result child | OSProcess accessor canAccessSystem ifFalse: [^ nil]. testString := 'This is the text to write out through one pipe, copy through an external cat command, and then read back in through another pipe.'. pipe1 := OSPipe blockingPipe. pipe2 := OSPipe nonBlockingPipe. input := pipe1 reader. output := pipe2 writer. src := pipe1 writer. dest := pipe2 reader. desc := Array with: input with: output with: nil. child := self forkJob: '/bin/cat' arguments: nil environment: nil descriptors: desc. input close. output close. src nextPutAll: testString. src close. (Delay forSeconds: 1) wait. result := dest next: testString size. dest close. child sigterm. "Tell the child to exit" ^ result ! ! !UnixProcess class methodsFor: 'examples' stamp: 'dtl 7/12/2000 04:46'! testRunCommand "Run the command 'ls -l /etc /etc/noSuchFile'. The output of the command will be in the file '/tmp/deleteMe.out', and the error output will be in '/tmp/deleteMe.err'. " "UnixProcess testRunCommand" | out err desc args proc | out := FileStream newFileNamed: '/tmp/deleteMe.out'. err := FileStream newFileNamed: '/tmp/deleteMe.err'. desc := Array with: nil with: out with: err. args := Array with: '-l' with: '/etc' with: '/etc/noSuchFile' with: '/etc/anotherNonexistentFile'. proc := self forkJob: '/bin/ls' arguments: args environment: nil descriptors: desc. proc ifNil: [self noAccessorAvailable]. out close. err close. ^ proc! ! !UnixProcess class methodsFor: 'utility - image save' stamp: 'dtl 11/8/2005 11:39'! uniqueNameForSavedImage "A time stamped image name that will sort in date order in a directory listing" "UnixProcess uniqueNameForSavedImage" | now month day hour minute second | now := DateAndTime now. month := now month asString. day := now dayOfMonth asString. hour := now hour24 asString. minute := now minute asString. second := now second asString. ^ 'squeak-', now year asString, (month size < 2 ifTrue: ['0', month] ifFalse: [month]), (day size < 2 ifTrue: ['0', day] ifFalse: [day]), (hour size < 2 ifTrue: ['0', hour] ifFalse: [hour]), (minute size < 2 ifTrue: ['0', minute] ifFalse: [minute]), (second size < 2 ifTrue: ['0', second] ifFalse: [second]) ! ! !UnixProcess class methodsFor: 'external command processing' stamp: 'dtl 1/18/2001 23:14'! waitForCommandOutput: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process." "UnixProcess waitForCommandOutput: 'echo sleeping...; sleep 1; echo I just slept for one second'" "UnixProcess waitForCommandOutput: 'ThisIsABogusCommand'" ^ self thisOSProcess waitForCommandOutput: aCommandString ! ! !UnixProcess class methodsFor: 'external command processing' stamp: 'dtl 1/18/2001 23:14'! waitForCommandOutputArray: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process." "UnixProcess waitForCommandOutputArray: 'echo Hello world!!; ls /NOSUCHFILE'" ^ self thisOSProcess waitForCommandOutputArray: aCommandString! ! !UnixProcess methodsFor: 'private' stamp: 'lr 9/6/2009 15:20'! argsAsFlatArrayAndOffsets: anArrayOfNullTerminatedStrings "Given anArrayOfNullTerminatedStrings, flatten the array into a string buffer, leaving space at the beginning of the buffer for a list of C pointers. Answer the string buffer and an array of address offsets. The address offsets may later be converted to C pointers and overlaid on the beginning of the buffer, resulting in a data structure which can be treated as a C array of strings suitable for use as a Unix argv vector." "OSProcess thisOSProcess argsAsFlatArrayAndOffsets: (UnixProcess arguments collect: [:e | e, (Character value: 0) asString])" | offset arraySize flatStringArray ws addresses | "Preserve offset space to hold address pointers." offset := (anArrayOfNullTerminatedStrings size + 1) * self processAccessor sizeOfPointer. "Allocate flat strings buffer" arraySize := (anArrayOfNullTerminatedStrings collect: [:e | e size]) sum + ((anArrayOfNullTerminatedStrings size + 1) * self processAccessor sizeOfPointer). "Flatten the strings out into a buffer, leaving room at the beginning of the buffer for an array of addresses." flatStringArray := String new: arraySize. ws := WriteStream on: flatStringArray. offset timesRepeat: [ws nextPut: (Character value: 0)]. anArrayOfNullTerminatedStrings do: [:e | ws nextPutAll: e]. "Find address offsets to be used in creating the addresses for the strings." ws := WriteStream on: (Array new: anArrayOfNullTerminatedStrings size). (anArrayOfNullTerminatedStrings collect: [:e | e size]) inject: offset into: [:p :e | ws nextPut: p. p + e]. addresses := ws contents. "Results" ^ Array with: flatStringArray with: addresses ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 11/7/2000 09:09'! arguments ^ arguments ! ! !UnixProcess methodsFor: 'environment' stamp: 'dtl 3/31/2001 15:56'! chDir: pathString "Change current working directory, and update $PWD if it exists in the environment. Answer nil for success, or an error message." "OSProcess thisOSProcess chDir: '/tmp'" "OSProcess thisOSProcess chDir: '/no/such/path'" "OSProcess thisOSProcess chDir: FileDirectory default pathName" | realPath result | realPath := self processAccessor realpath: pathString. realPath ifNil: [realPath := pathString]. result := self processAccessor chDir: realPath. result isNil ifTrue: [(self environmentAt: #PWD) ifNotNil: [self environmentAt: #PWD put: realPath. ^ nil]] ifFalse: [self inform: realPath, ': ', result. ^ result]! ! !UnixProcess methodsFor: 'external command processing' stamp: 'dtl 2/27/2002 15:24'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process. The command is run by a ConnectedUnixProcess in order to facilitate command pipelines within Squeak." "UnixProcess thisOSProcess command: 'ls -l /etc'" | proc | pid isNil ifTrue: [self class noAccessorAvailable. ^nil] ifFalse: [proc := self forkJob: ExternalUnixOSProcess defaultShellPath arguments: (Array with: '-c' with: aCommandString) environment: nil descriptors: nil. proc ifNil: [self class noAccessorAvailable]. ^ proc] ! ! !UnixProcess methodsFor: 'external command processing' stamp: 'dtl 7/12/2003 11:51'! command: aCommandString input: aStreamOrString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process." "OSProcess thisOSProcess command: 'cat' input: 'this is some test data'" "OSProcess thisOSProcess command: 'cat' input: (ReadStream on: 'this is some test data')" | proc | (Smalltalk hasClassNamed: #PipeableOSProcess) ifTrue: [proc := (Smalltalk at: #PipeableOSProcess) command: aCommandString. proc ifNil: [^ nil]. proc nextPutAll: aStreamOrString contents. proc pipeToInput close. ^ proc] ifFalse: [self notify: 'the #command:input: method requires CommandShell, using #command: instead'. ^ self command: aStreamOrString contents] ! ! !UnixProcess methodsFor: 'private' stamp: 'lr 9/6/2009 15:20'! envAsFlatArrayAndOffsets: anEnvironmentDictionary "Given anEnvironmentDictionary, flatten the dictionary into a string buffer, leaving space at the beginning of the buffer for a list of C pointers. Answer the string buffer and an array of address offsets. The address offsets may later be converted to C pointers and overlaid on the beginning of the buffer, resulting in a data structure which can be treated as a C array of strings suitable for use as a Unix process environment." "OSProcess thisOSProcess envAsFlatArrayAndOffsets: UnixProcess env" | offset envArray arraySize flatStringArray ws addresses | "Preserve offset space to hold address pointers." offset := (anEnvironmentDictionary size + 1) * self processAccessor sizeOfPointer. "Build collection of environment strings" envArray := OrderedCollection new. anEnvironmentDictionary keysAndValuesDo: [:k :v | envArray add: (k, '=', v)]. "Allocate flat strings buffer" arraySize := ((envArray collect: [:e | e size + 1]) sum) + offset. "Flatten the strings out into a buffer, leaving room at the beginning of the buffer for an array of addresses." flatStringArray := String new: arraySize. ws := WriteStream on: flatStringArray. offset timesRepeat: [ws nextPut: (Character value: 0)]. envArray do: [:e | ws nextPutAll: e; nextPut: (Character value: 0)]. "Find address offsets to be used in creating the addresses for the strings." ws := WriteStream on: (Array new: anEnvironmentDictionary size). (envArray collect: [:e | e size + 1]) inject: offset into: [:p :e | ws nextPut: p. p + e]. addresses := ws contents. "Results" ^ Array with: flatStringArray with: addresses ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 11/7/2000 09:09'! environment ^ environment ! ! !UnixProcess methodsFor: 'environment' stamp: 'dtl 3/6/2001 21:30'! environmentAt: aSymbol "Answer an environment variable for the external OS process, and update the dictionary in this Smalltalk object." ^ environment at: aSymbol asSymbol ifAbsent: [] ! ! !UnixProcess methodsFor: 'environment' stamp: 'dtl 3/6/2001 21:30'! environmentAt: aSymbol put: aString "Set an environment variable for the external OS process, and update the dictionary in this Smalltalk object." | s | self initialize. s := self processAccessor environmentAt: aSymbol put: aString. s ifNotNil: [ self environment at: aSymbol asSymbol put: aString ]. ^ s ! ! !UnixProcess methodsFor: 'finalization' stamp: 'dtl 1/24/2004 11:23'! finalize "Use this to release any external resources prior to reinitializing." super finalize. stdIn := stdIn ifNotNil: [[stdIn close; release] on: Error do: [:ex | ]. nil]. stdIn := stdOut ifNotNil: [[stdOut close; release] on: Error do: [:ex | ]. nil]. stdIn := stdErr ifNotNil: [[stdErr close; release] on: Error do: [:ex | ]. nil]. sessionID := nil. ppid := nil. programName := nil. arguments := nil. path := nil. environment := nil. self updateAllMyChildren. allMyChildren := nil. processAccessor ifNotNil: [processAccessor removeDependent: self. processAccessor := nil] ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 2/27/2002 15:24'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Call Unix vfork() and execve() to create a child process, and answer the child process. This method is expected to be called by class side methods." ^ ExternalUnixOSProcess forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 9/14/2005 05:34'! forkHeadlessSqueak "Just like forkSqueak, except that the child Squeak continues headless." | thisPid childPid child connected | stdOut ifNil: [^ nil]. self stdOut flush. self stdErr flush. thisPid := self pid. connected := self processAccessor canControlXDisplay and: [self flushXDisplay notNil]. childPid := self processAccessor forkSqueak. childPid == 0 ifTrue: [connected ifTrue: [self disconnectXDisplay]. OSProcess thisOSProcess processAccessor changed: #pid. ^ self] ifFalse: [child := ExternalUnixOSProcess new. child pid: childPid. child ppid: thisPid. child programName: self programName. child initialStdIn: self stdIn. child initialStdOut: self stdOut. child initialStdErr: self stdErr. child arguments: self arguments. child initialEnvironment: self environment. child notYetRunning. self registerChildProcess: child. child running. ^ child] ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 1/7/2001 12:59'! forkHeadlessSqueakAndDo: aBlock "Start a new instance of Squeak running in a child OS process, and execute aBlock in the child instance. The new instance is a clone of this image, but without a connection to the X display. The child instance executes aBlock, which hopefully does not involve interaction with the X display; and the parent continues normally. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." | childOrThisProc | childOrThisProc := self forkHeadlessSqueak. childOrThisProc ifNil: [self class noAccessorAvailable. ^ nil]. childOrThisProc == self ifTrue: ["Child process" aBlock value]. ^ childOrThisProc ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 8/7/2003 07:17'! forkHeadlessSqueakAndDoThenQuit: aBlock "Start a new instance of Squeak running in a child OS process, and execute aBlock in the child instance. The new instance is a clone of this image, but without a connection to the X display. The child instance executes aBlock, which hopefully does not involve interaction with the X display; and the parent continues normally. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "self thisOSProcess forkHeadlessSqueakAndDoThenQuit: [OSProcess thisOSProcess stdOut nextPutAll: 'hello world!!'; nextPut: Character lf]" "self thisOSProcess forkHeadlessSqueakAndDoThenQuit: [OSProcess thisOSProcess command: 'xeyes']" | childOrThisProc | childOrThisProc := self forkHeadlessSqueak. childOrThisProc ifNil: [self class noAccessorAvailable. ^ nil]. childOrThisProc == self ifTrue: ["Child process" aBlock value. Smalltalk quitPrimitive]. ^ childOrThisProc! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 12/27/2000 16:47'! forkJob: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Call Unix vfork() and execve() to create a child process, and answer the child process. Delegate this to the singleton OSProcess>>thisOSProcess." ^ self forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 9/14/2005 05:33'! forkSqueak "Fork a child and continue running this Squeak image in both the parent and the child. Parent and child are distinguished by the pid returned by primForkSqueak. If continuing as the parent process, answer the ExternalUnixOSProcess which represents the child. This can be inspected to watch the run state of the child process from the parent. If continuing as the child process, answer OSProcess thisOSProcess. This can be inspected to watch the full state of the child process from the child. The child cannot directly view the state of its parent. Parent and child should be cautious about using shared connections to external resources." "self thisOSProcess forkSqueak" | thisPid childPid child connected | stdOut ifNil: [^ nil]. self stdOut flush. self stdErr flush. thisPid := self pid. connected := self processAccessor canControlXDisplay and: [self flushXDisplay notNil]. childPid := self processAccessor forkSqueak. childPid == 0 ifTrue: [connected ifTrue: [self disconnectXDisplay; recapitate]. OSProcess thisOSProcess processAccessor changed: #pid. ^ self] ifFalse: [child := ExternalUnixOSProcess new. child pid: childPid. child ppid: thisPid. child programName: self programName. child initialStdIn: self stdIn. child initialStdOut: self stdOut. child initialStdErr: self stdErr. child arguments: self arguments. child initialEnvironment: self environment. child notYetRunning. self registerChildProcess: child. child running. ^ child] ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 10/8/2001 19:56'! forkSqueakAndDo: aBlock "Start a new instance of Squeak running in a child OS process. The new instance is a clone of this image except for the return value of this method. It does not reload the image file from disk. The child image evaluates aBlock. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess thisOSProcess forkSqueakAndDo: [Object inform: 'Hi, I am the child Squeak process.']" | childOrThisProc | childOrThisProc := self forkSqueak. (childOrThisProc == self) ifTrue: [aBlock value]. "Child process" ^ childOrThisProc! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 10/8/2001 19:56'! forkSqueakAndDoThenQuit: aBlock "Start a new instance of Squeak running in a child OS process. The new instance is a clone of this image except for the return value of this method. It does not reload the image file from disk. The child image evaluates aBlock. The child should not depend on using existing connections to external resources. For example, the child may lose its connections to stdin, stdout, and stderr after its parent exits." "UnixProcess thisOSProcess forkSqueakAndDoThenQuit: [Object inform: 'Hi, I am the child Squeak process.']" | childOrThisProc | childOrThisProc := self forkSqueak. (childOrThisProc == self) ifTrue: [ aBlock value. Smalltalk quitPrimitive]. "Child process" ^ childOrThisProc! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 3/31/2001 14:16'! getArgumentList "Answer the argument list using anOSProcessAccessor. For Unix, the first element of the list would be the program name. This element will not be treated as an argument; rather, it is stored as the programName instance variable." | index val list | list := OrderedCollection new. index := 2. [(val := processAccessor primArgumentAt: index) notNil] whileTrue: [ list add: val. index := index + 1]. ^ list asArray ! ! !UnixProcess methodsFor: 'environment' stamp: 'dtl 3/22/2000 05:55'! getCwd "Get current working directory. At image startup, this is equivalent to evaluating environmentAt: #PWD" "OSProcess thisOSProcess getCwd" ^ self processAccessor primGetCurrentWorkingDirectory ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 3/31/2001 14:14'! getEnvironmentDictionary "Answer an environment dictionary using an OSProcessAccessor." | index str key val env | env := Dictionary new. index := 1. [(str := processAccessor primEnvironmentAt: index) notNil] whileTrue: [ key := (str copyUpTo: $=) asSymbol. val := (str copyFrom: ((str indexOf: $=) + 1) to: (str size)). env at: key put: val. index := index + 1]. ^ env ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 3/31/2001 14:16'! getProgramName "Answer the name of the program which is being run by this OS process. Assume the Unix convention where the first element of (char **)argv is the program name." ^ programName := processAccessor primArgumentAt: 1 ! ! !UnixProcess methodsFor: 'initialize - release' stamp: 'dtl 2/26/2002 08:29'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." super initialize. (self processAccessor notNil and: [processAccessor canAccessSystem]) ifTrue: [self refreshFromProcessAccessor] ifFalse: [stdIn := nil. stdOut := nil. stdErr := nil] ! ! !UnixProcess methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:49'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self class isUnix ! ! !UnixProcess methodsFor: 'VM atexit' stamp: 'dtl 3/18/2007 10:45'! killCurrentChildrenAtExit "Arrange for the currently active child processes to receive a SIGTERM signal then the Squeak VM exits. Each invokation of this method overrides the effects of any previous calls." "OSProcess thisOSProcess killCurrentChildrenAtExit" self processAccessor killOnVmExit: self allMyChildren withSignal: nil ! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 11/7/2000 09:26'! needsRefresh "Answer true if the sessionID variable is out of date with respect to the running OS Process." ^ ((sessionID ~= (self processAccessor primGetSession)) | (pid ~= (self processAccessor primGetPid))) ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 11/7/2000 09:10'! path ^ path := self pathString ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 11/7/2000 09:10'! path: aPathString self environmentAt: #PATH put: aPathString. path := self pathString! ! !UnixProcess methodsFor: 'private' stamp: 'dtl 3/6/2001 21:46'! pathString "Answer the path string from the environment. Assume Unix convention in which the path name is a colon delimited string stored in the PATH environment variable." ^ self environment at: #PATH ifAbsent: [nil]! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 10/18/2001 20:01'! pid ^ pid := self processAccessor primGetPid ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 11/7/2000 09:10'! ppid "Always refresh ppid from the processAccessor, because it is possible for a child to be reparented when the parent exits. The child does not know about this, so we refresh ppid on every access." ^ ppid := processAccessor primGetPPid ! ! !UnixProcess methodsFor: 'printing' stamp: 'dtl 3/6/2001 21:45'! printOn: aStream "In English, say 'a Unix' rather than 'an Unix'. Therefore do not use super printOn, which treats $U as a vowel." self initialize. "Make sure we are attached to the current OS process (not left over from a previous session)." self ppid. "Force update of ppid, in case parent may have exited." aStream nextPutAll: 'a '; nextPutAll: self class name; nextPutAll: ' with pid '; nextPutAll: self pid printString ! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 1/25/2004 12:40'! processProxy: anExternalProcess forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Call Unix vfork() and execve() to create a child process, and answer the child process. This method is expected to be called by class side methods. Prepare the arguments before calling the primitive, including null termination of all strings. anExternalProcess is an object which represents the new child process, and which responds to the #pid: message." | nullString progName args argVecAndOffsets argVec argOffsets envVecAndOffsets envVec envOffsets in out err childPid pwd | stdOut ifNil: [^ nil]. nullString := (Character value: 0) asString. progName := executableFile, nullString. "Null terminated string" arrayOfStrings isNil "Should be a (possibly empty) array" ifTrue: [args := Array with: progName] "First argument is the program name (Unix convention)" ifFalse: [args := (OrderedCollection new: arrayOfStrings size + 2) add: progName; addAll: (arrayOfStrings collect: [:e | e, nullString ]); "Null terminate each string" yourself; asArray]. argVecAndOffsets := self argsAsFlatArrayAndOffsets: args. argVec := argVecAndOffsets at: 1. argOffsets := argVecAndOffsets at: 2. (stringDictionary notNil and: [stringDictionary ~= (self environment)]) ifTrue: [envVecAndOffsets := self envAsFlatArrayAndOffsets: stringDictionary. envVec := envVecAndOffsets at: 1. envOffsets := envVecAndOffsets at: 2] ifFalse: [envVec := nil. envOffsets := nil]. "Same as current environment, so just pass nil." arrayOf3Streams isNil ifTrue: [in := self handleFromAccessor: (self stdIn ioHandle). out := self handleFromAccessor: (self stdOut ioHandle). err := self handleFromAccessor: (self stdIn ioHandle)] ifFalse: [(arrayOf3Streams at: 1) isNil ifTrue: [in := self handleFromAccessor: (self stdIn ioHandle)] ifFalse: [in := self handleFromFileStream: (arrayOf3Streams at: 1)]. (arrayOf3Streams at: 2) isNil ifTrue: [ out := self handleFromAccessor: (self stdOut ioHandle)] ifFalse: [ out := self handleFromFileStream: (arrayOf3Streams at: 2)]. (arrayOf3Streams at: 3) isNil ifTrue: [ err := self handleFromAccessor: (self stdErr ioHandle)] ifFalse: [ err := self handleFromFileStream: (arrayOf3Streams at: 3)]]. pwd := anExternalProcess pwd. (pwd = self getCwd) ifTrue: [pwd := nil] ifFalse: [pwd := pwd, nullString]. childPid := self processAccessor forkAndExec: progName stdIn: in stdOut: out stdErr: err argBuf: argVec argOffsets: argOffsets envBuf: envVec envOffsets: envOffsets workingDir: pwd. anExternalProcess pid: childPid. anExternalProcess ppid: self pid. ((childPid == 0) or: [childPid isNil]) ifTrue: [anExternalProcess unknownRunState] ifFalse: [anExternalProcess running. self registerChildProcess: anExternalProcess]. ^ anExternalProcess ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 11/7/2000 09:10'! programName ^ programName ! ! !UnixProcess methodsFor: 'accessing' stamp: 'dtl 3/17/2007 22:54'! pthread "The identity of the pthread in which the interpreter executes. Always refresh pthread from the processAccessor, because it is possible for a child to be reparented when the parent exits. The child does not know about this, so we refresh pthread on every access." ^ pthread := processAccessor getThreadID ! ! !UnixProcess methodsFor: 'updating' stamp: 'dtl 3/17/2007 22:55'! refreshFromProcessAccessor "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." self needsRefresh ifTrue: [ sessionID := self processAccessor getSessionIdentifier. pid := processAccessor primGetPid. ppid := processAccessor primGetPPid. pthread := processAccessor getThreadID. self setStdIn. self setStdOut. self setStdErr. programName := self getProgramName. arguments := self getArgumentList. environment := self getEnvironmentDictionary. path := self pathString. self allMyChildren] ! ! !UnixProcess methodsFor: 'child process management' stamp: 'dtl 1/25/2004 21:32'! registerChildProcess: anOSProcess self processAccessor sigChldSemaphore. self processAccessor grimReaperProcess. "Start the reaper process if it is not running." ^ super registerChildProcess: anOSProcess ! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:49'! sigabrt: anExternalOSProcess "Send a SIGABRT signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigabrtTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:49'! sigalrm: anExternalOSProcess "Send a SIGALRM signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigalrmTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:48'! sigchld: anExternalOSProcess "Send a SIGCHLD signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigchldTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:48'! sigcont: anExternalOSProcess "Send a SIGCONT signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigcontTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:48'! sighup: anExternalOSProcess "Send a SIGHUP signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSighupTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:48'! sigint: anExternalOSProcess "Send a SIGINT signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigintTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:48'! sigkill: anExternalOSProcess "Send a SIGKILL signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigkillTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:48'! sigpipe: anExternalOSProcess "Send a SIGPIPE signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigpipeTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:49'! sigquit: anExternalOSProcess "Send a SIGQUIT signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigquitTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:50'! sigstop: anExternalOSProcess "Send a SIGSTOP signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigstopTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:50'! sigterm: anExternalOSProcess "Send a SIGTERM signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigtermTo: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:50'! sigusr1: anExternalOSProcess "Send a SIGUSR1 signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigusr1To: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'OS signal sending' stamp: 'dtl 7/6/2000 16:51'! sigusr2: anExternalOSProcess "Send a SIGUSR2 signal to the external process represented by anExternalOSProcess." ^ self processAccessor primSendSigusr2To: anExternalOSProcess pid! ! !UnixProcess methodsFor: 'child process creation' stamp: 'dtl 1/21/2001 11:47'! squeak "Start a new instance of Squeak running in a child OS process. The new instance will restart from the image file, so it is a clone of this image as it existed at the most recent image save." "OSProcess thisOSProcess squeak" ^ self forkJob: self programName arguments: self arguments environment: nil descriptors: nil! ! !UnixProcess methodsFor: 'updating' stamp: 'dtl 10/20/2001 09:05'! update: aParameter "Framework to update some or all of the instance variables based on external events, such as receipt of a sigchd signal when a child process exits." (aParameter == (self processAccessor)) ifTrue: [^ self refreshFromProcessAccessor; yourself]. (aParameter == #pid) ifTrue: [^ self resetChildProcessDictionary. "Forget children of prior process"]. (aParameter == #childProcessStatus) ifTrue: [^ self updateActiveChildren; changed; yourself]. (aParameter == #startUp) ifTrue: [^ self update: #pid]. aParameter == #invalidProcessAccessor ifTrue: [processAccessor := processAccessor ifNotNil: [processAccessor removeDependent: self. nil]. ^ self]. self error: 'Unexpected update parameter'! ! !UnixProcess methodsFor: 'external command processing' stamp: 'dtl 2/27/2002 15:24'! waitForCommand: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process. This just uses a simple polling loop, which is not very elegant but works well enough for most purposes." "OSProcess thisOSProcess waitForCommand: 'echo sleeping...; sleep 3; echo I just slept for three seconds'" | proc d | d := Delay forMilliseconds: 50. proc := self forkJob: ExternalUnixOSProcess defaultShellPath arguments: (Array with: '-c' with: aCommandString) environment: nil descriptors: nil. proc ifNil: [self class noAccessorAvailable]. [proc runState == #complete] whileFalse: [d wait]. ^ proc ! ! !UnixProcess methodsFor: 'external command processing' stamp: 'dtl 7/12/2003 12:06'! waitForCommandOutput: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process." "OSProcess thisOSProcess waitForCommandOutput: 'echo sleeping...; sleep 1; echo I just slept for one second'" "OSProcess thisOSProcess waitForCommandOutput: 'ThisIsABogusCommand'" "OSProcess thisOSProcess waitForCommandOutput: '/bin/ls -l /etc /bin'" "OSProcess thisOSProcess waitForCommandOutput: 'echo Hello world!!; ls /NOSUCHFILE'" (Smalltalk hasClassNamed: #PipeableOSProcess) ifTrue: [^ ((Smalltalk at: #PipeableOSProcess) command: aCommandString) output] ifFalse: [self notify: 'the #waitForCommandOutput: method requires CommandShell'. ^ ''] ! ! !UnixProcess methodsFor: 'external command processing' stamp: 'dtl 7/12/2003 12:08'! waitForCommandOutputArray: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process." "OSProcess thisOSProcess waitForCommandOutputArray: 'echo Hello world!!; ls /NOSUCHFILE'" | proc | (Smalltalk hasClassNamed: #PipeableOSProcess) ifTrue: [proc := (Smalltalk at: #PipeableOSProcess) command: aCommandString. ^ Array with: proc output with: proc errorUpToEnd with: proc processProxy exitStatus] ifFalse: [self notify: 'the #waitForCommandOutputArray: method requires CommandShell'. ^ Array with: '' with: '' with: nil] ! ! ThisOSProcess subclass: #WindowsProcess instanceVariableNames: 'processHandle environment mainThread threads' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Win32'! !WindowsProcess commentStamp: 'dtl 9/25/2005 16:31' prior: 0! I represent a Windows operating system process, such as the process in which the Squeak VM is currently running. I collaborate with an instance of WindowsOSProcessAccessor to provide primitive access to the external operating system. My instance variables are maintained as a convenience to allow inspection of an OSProcess. Access to these variables should always be done with my accessor methods, which update the instance variables by querying my WindowsOSProcessAccessor. My process ID and process handle (a Win32 HANDLE) are held by my pid and processHandle variables. The main thread for this process is held by my mainThread variable. Standard input, output, and error streams are available, and my be used when the console is open (WindowsProcess>>openConsole). They can also be reassigned to file streams (WindowsOSProcessAccessor>>setStdOut:). When external processes are created, they are added to my allMyChildren collection, and a thread is created to wait for any of them to exit. This thread is held by my childWatcherThread instance variable while the thread is active, and is also added to my threads collection. Whenever a child process exits, the childWatcherThread will signal a Semaphore (a Smalltalk Semaphore, not a Windows semaphore), then exit. A Squeak process in my processAccessor waits on this Semaphore, and sends an 'update: #childProcessStatus' message to me. In response to this, I update the status of my active child processes, one or more of which will have exited. If any of my child processes are still active, I set a new childWatcherThread to wait for them to exit. Note that some Windows applications will exit their main process after creating another application process. These applications will appear to Squeak as if they have exited immediately, even though the application is running.! !WindowsProcess class methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:50'! isResponsibleForThisPlatform "Answer true if this class is responsible for representing the OS process for the Squeak VM running on the current platform." ^ self isWindows ! ! !WindowsProcess methodsFor: 'child process management' stamp: 'dtl 2/26/2002 16:08'! activeHandles "Answer an Array of handles for all children that are believed to be running." ^ (self activeChildren collect: [:c | c handle]) asArray ! ! !WindowsProcess methodsFor: 'child process management' stamp: 'dtl 2/26/2002 10:04'! allMyChildren "On Windows, the process ID is not unique. Use an OrderedCollection instead of a Dictionary to keep track of the child processes." allMyChildren ifNil: [ allMyChildren := OrderedCollection new ]. ^ allMyChildren! ! !WindowsProcess methodsFor: 'console' stamp: 'dtl 9/7/2002 20:57'! closeConsole "Close the console. The standard input, output and error streams will no longer be available." "OSProcess thisOSProcess closeConsole" self processAccessor primFreeConsole. self refreshFromProcessAccessor ! ! !WindowsProcess methodsFor: 'child process creation' stamp: 'dtl 2/28/2002 14:48'! command: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library, except that aCommandString runs asynchronously in a child process. Answer an instance of ExternalWindowsProcess which is a proxy for the new Windows process." "OSProcess command: 'SOL'" ^ ExternalWindowsOSProcess command: aCommandString ! ! !WindowsProcess methodsFor: 'accessing' stamp: 'dtl 2/22/2002 22:02'! environment ^ environment ! ! !WindowsProcess methodsFor: 'child process creation' stamp: 'dtl 10/18/2001 20:19'! forkAndExec: executableFile arguments: arrayOfStrings environment: stringDictionary descriptors: arrayOf3Streams "Use my processAccessor to call vfork() and execve() and create a new child task. Answer a proxy for the new task, an instance of ExternalWindowsProcess." self notYetImplemented ! ! !WindowsProcess methodsFor: 'environment' stamp: 'dtl 9/25/2005 06:28'! getCwd "Get current working directory. If this cannot be obtained from the environment, answer a reasonable default." "OSProcess thisOSProcess getCwd" ^ self processAccessor primGetCurrentWorkingDirectory ifNil: [FileDirectory default pathName] ! ! !WindowsProcess methodsFor: 'private' stamp: 'dtl 2/22/2002 22:00'! getEnvironmentDictionary "Answer an environment dictionary using an OSProcessAccessor." "OSProcess thisOSProcess getEnvironmentDictionary" | strings env | strings := processAccessor primGetEnvironmentStrings. strings isNil ifTrue: [^ nil] ifFalse: [env := Dictionary new. strings do: [:s | env at: (s copyUpTo: $=) asSymbol put: (s copyAfterLast: $=)]. ^ env] ! ! !WindowsProcess methodsFor: 'initialize - release' stamp: 'dtl 2/28/2002 10:24'! initialize "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing. On Windows, we cannot rely on the pid to have changed when the VM is restarted, so use a one-shot function to determine if we are restarting the VM (as opposed to returning from an image save)." processAccessor ifNotNil: [processAccessor removeDependent: self. processAccessor := nil]. (self processAccessor canAccessSystem not or: [processAccessor primOneShot]) ifTrue: ["Restarting the VM in a new process" self resetChildProcessDictionary. self resetThreads. self threads; mainThread. processHandle := nil. self processHandle]. self refreshFromProcessAccessor ! ! !WindowsProcess methodsFor: 'platform identification' stamp: 'dtl 8/30/2003 17:50'! isResponsibleForThisPlatform "Answer true is this is an instance of the class which is responsible for representing the OS process for the Squeak VM running on the current platform. A false answer is usually the result of running the image on a different platform and VM." ^ self class isWindows ! ! !WindowsProcess methodsFor: 'accessing' stamp: 'dtl 2/28/2002 07:15'! mainThread "The main thread for this OS process. The handle for this thread is a pseudo-handle, and cannot be used to close the main thread." ^ mainThread ifNil: [mainThread := processAccessor getMainThread]! ! !WindowsProcess methodsFor: 'console' stamp: 'dtl 9/7/2002 20:57'! openConsole "Open a console. This makes the standard input, output and error streams available." "OSProcess thisOSProcess openConsole" self processAccessor primAllocConsole. self refreshFromProcessAccessor ! ! !WindowsProcess methodsFor: 'environment' stamp: 'dtl 9/25/2005 05:11'! path "Newer versions of Windows mixed case" ^ self environment at: #PATH ifAbsent: [environment at: #Path ifAbsent: ['']]! ! !WindowsProcess methodsFor: 'accessing' stamp: 'dtl 2/22/2002 16:43'! pid ^ pid := self processAccessor primGetPid ! ! !WindowsProcess methodsFor: 'accessing' stamp: 'dtl 2/28/2002 07:26'! processHandle "The handle for this OS process. This is a pseudo-handle, a constant provided by Windows to represent the process. Note that the main thread handle is also represented by a pseudo-handle." ^ processHandle ifNil: [processHandle := self processAccessor primGetPidHandle] ! ! !WindowsProcess methodsFor: 'updating' stamp: 'dtl 9/7/2002 20:47'! refreshFromProcessAccessor "Set my instance variables to reflect the state of the OS process in which this Smalltalk virtual machine is executing." sessionID := self processAccessor getSessionIdentifier. pid := processAccessor primGetPid. self setStdIn. self setStdOut. self setStdErr. environment := self getEnvironmentDictionary ! ! !WindowsProcess methodsFor: 'child process management' stamp: 'dtl 2/28/2002 08:17'! registerChildProcess: anOSProcess "Register the external process and set an exit handler thread to signal when the process exits." self allMyChildren add: anOSProcess. self threads add: self restartChildWatcherThread. ^ anOSProcess ! ! !WindowsProcess methodsFor: 'initialize - release' stamp: 'dtl 2/28/2002 07:16'! resetThreads "If any cleanup is required, do it here." threads := nil. mainThread := nil ! ! !WindowsProcess methodsFor: 'child process management' stamp: 'dtl 1/13/2007 09:49'! restartChildWatcherThread "Set an exit handler thread to signal when the process exits." ^ self processAccessor restartChildWatcherThread: self activeHandles ! ! !WindowsProcess methodsFor: 'private' stamp: 'dtl 9/7/2002 20:55'! setStdErr "Reset to nil if the console has been closed" ^ self processAccessor getStdErr isNil ifTrue: [stdErr := nil] ifFalse: [super setStdErr] ! ! !WindowsProcess methodsFor: 'private' stamp: 'dtl 9/7/2002 20:55'! setStdIn "Reset to nil if the console has been closed" ^ self processAccessor getStdIn isNil ifTrue: [stdIn := nil] ifFalse: [super setStdIn] ! ! !WindowsProcess methodsFor: 'private' stamp: 'dtl 9/7/2002 20:55'! setStdOut "Reset to nil if the console has been closed" ^ self processAccessor getStdOut isNil ifTrue: [stdOut := nil] ifFalse: [super setStdOut] ! ! !WindowsProcess methodsFor: 'accessing' stamp: 'dtl 2/28/2002 08:04'! threads "One or more threads of execution within the OS process. The main thread for the process is held by the mainThread variable and is not included in this collection. Threads are created to wait for the exit of child processes, so this collection grows as child processes are created." ^ threads ifNil: [threads := OrderedCollection new] ! ! !WindowsProcess methodsFor: 'child process management' stamp: 'dtl 6/6/2002 07:05'! unregisterChildProcess: anOSProcess ^ self allMyChildren remove: anOSProcess pid ! ! !WindowsProcess methodsFor: 'updating' stamp: 'dtl 2/25/2002 08:29'! update: aParameter "Framework to update some or all of the instance variables based on external events, such as receipt of a sigchd signal when a child process exits." (aParameter == (self processAccessor)) ifTrue: [^ self refreshFromProcessAccessor; yourself]. (aParameter == #pid) ifTrue: [^ self resetChildProcessDictionary. "Forget children of prior process"]. (aParameter == #childProcessStatus) ifTrue: [^ self updateActiveChildren; changed; yourself]. (aParameter == #startUp) ifTrue: [^ self update: #pid]. aParameter == #invalidProcessAccessor ifTrue: [processAccessor := processAccessor ifNotNil: [processAccessor removeDependent: self. nil]. ^ self]. self error: 'Unexpected update parameter'! ! !WindowsProcess methodsFor: 'child process management' stamp: 'dtl 2/28/2002 08:17'! updateActiveChildren super updateActiveChildren. self restartChildWatcherThread ! ! !WindowsProcess methodsFor: 'child process creation' stamp: 'dtl 11/24/2008 17:47'! waitForCommand: aCommandString "Run a command in a shell process. Similar to the system(3) call in the standard C library. The active Smalltalk process waits for completion of the external command process. This just uses a simple polling loop, which is not very elegant but works well enough for most purposes." | proc d | d := Delay forMilliseconds: 50. proc := self command: aCommandString. proc ifNil: [self class noAccessorAvailable]. [proc runState == #complete] whileFalse: [d wait]. ^ proc ! ! Object subclass: #WindowsThread instanceVariableNames: 'threadID handle runState' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Win32'! !WindowsThread commentStamp: '' prior: 0! I represent a thread of execution within a Windows process. May threadID is a unique identifier for the thread, and my handle is a Windows HANDLE to the thread. My handle should be closed when the thread exits.! !WindowsThread class methodsFor: 'instance creation' stamp: 'dtl 2/25/2002 07:00'! threadID: anInteger handle: aHandleObject ^ super new threadID: anInteger; handle: aHandleObject; initialize ! ! !WindowsThread class methodsFor: 'instance creation' stamp: 'dtl 2/26/2002 07:17'! threadID: anInteger handle: aHandleObject running: trueOrFalse | thread | thread := super new threadID: anInteger; handle: aHandleObject; initialize. trueOrFalse ifTrue: [thread running]. ^ thread ! ! !WindowsThread methodsFor: 'initialize - release' stamp: 'dtl 2/25/2002 07:38'! closeHandle "Clean up after thread exits." OSProcess accessor primCloseHandle: handle. handle := nil ! ! !WindowsThread methodsFor: 'setting run state' stamp: 'dtl 2/26/2002 10:45'! complete "Thread has exited." self closeHandle; runState: #complete ! ! !WindowsThread methodsFor: 'accessing' stamp: 'dtl 2/25/2002 06:39'! handle "A Windows HANDLE represented as a ByteArray." ^ handle! ! !WindowsThread methodsFor: 'accessing' stamp: 'dtl 2/25/2002 06:38'! handle: aHandleObject "A Windows HANDLE represented as a ByteArray." handle := aHandleObject! ! !WindowsThread methodsFor: 'initialize - release' stamp: 'dtl 2/25/2002 07:03'! initialize self runState! ! !WindowsThread methodsFor: 'testing' stamp: 'dtl 2/25/2002 06:37'! isComplete ^ self runState == #complete! ! !WindowsThread methodsFor: 'testing' stamp: 'dtl 2/25/2002 06:37'! isRunning ^ self runState == #running! ! !WindowsThread methodsFor: 'printing' stamp: 'dtl 2/27/2002 12:02'! printOn: aStream super printOn: aStream. aStream nextPutAll: ' (', self threadID printString, ', ', self runState, ')' ! ! !WindowsThread methodsFor: 'accessing' stamp: 'dtl 1/25/2004 11:01'! runState ^ runState ifNil: [self unknownRunState] ! ! !WindowsThread methodsFor: 'accessing' stamp: 'dtl 2/25/2002 07:02'! runState: aSymbol runState := aSymbol ! ! !WindowsThread methodsFor: 'setting run state' stamp: 'dtl 2/25/2002 06:36'! running "Thread is scheduled to run." self runState: #running ! ! !WindowsThread methodsFor: 'initialize - release' stamp: 'dtl 2/27/2002 11:35'! terminate "Force an exit. No cleanup is performed. Use with caution for a thread which is (for example) manipulating a mutex." (self isRunning and: [self handle notNil]) ifTrue: [OSProcess accessor primTerminateThread: self handle. self complete] ! ! !WindowsThread methodsFor: 'accessing' stamp: 'dtl 2/25/2002 06:40'! threadID "A unique identifier for the thread." ^ threadID ! ! !WindowsThread methodsFor: 'accessing' stamp: 'dtl 2/25/2002 06:40'! threadID: anInteger "A unique identifier for the thread." threadID := anInteger ! ! !WindowsThread methodsFor: 'setting run state' stamp: 'dtl 2/25/2002 06:36'! unknownRunState "Unable to determine the current run state of the thread, possibly because this is a stale reference to a thread which no longer exists." self runState: #unknownRunState ! ! StandardFileStream subclass: #AttachableFileStream instanceVariableNames: 'autoClose' classVariableNames: 'UseIOHandle' poolDictionaries: '' category: 'OSProcess-Base'! !AttachableFileStream commentStamp: '' prior: 0! I am a stream on an input or output channel provided by the underlying operating system. I behave like an ordinary file stream, except that I can attach myself to an input or output stream which has already been opened by the underlying operating system.! AttachableFileStream subclass: #AsyncFileReadStream instanceVariableNames: 'eventHandler' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !AsyncFileReadStream commentStamp: 'dtl 7/9/2003 21:04' prior: 0! AsyncFileReadStream implements event-driven read behavior on a file stream. Whenever data is available, a #changed event is generated. An AsyncFileReadStream expects to have a client object respond immediately to the change notification by reading the available data, otherwise a possibly endless stream of change notifications will be generated. AsyncFileReadStream requires aio support in the AioPlugin module.! !AsyncFileReadStream class methodsFor: 'examples' stamp: 'dtl 7/9/2003 20:16'! stdIn "self stdIn" ^ super stdIn initialize ! ! !AsyncFileReadStream methodsFor: 'finalization' stamp: 'dtl 6/17/2006 08:08'! actAsExecutor super actAsExecutor. eventHandler := nil! ! !AsyncFileReadStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 20:53'! asAsyncFileReadStream ^ self ! ! !AsyncFileReadStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 19:40'! asAttachableFileStream "Answer a replacement for this object, with no asynchronous event handling. Do not close the ioHandle when this object is finalized." self keepOpen. ^ AttachableFileStream name: self name attachTo: self ioHandle writable: self isReadOnly not ! ! !AsyncFileReadStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 21:01'! asBufferedAsyncFileReadStream "Answer a replacement for this object, with buffered output." ^ BufferedAsyncFileReadStream name: self name attachTo: self ioHandle writable: self isReadOnly not ! ! !AsyncFileReadStream methodsFor: 'initialize-release' stamp: 'dtl 7/8/2003 21:48'! close self disableEventHandling. ^ super close! ! !AsyncFileReadStream methodsFor: 'read event handling' stamp: 'dtl 8/20/2006 18:49'! disableEventHandling eventHandler ifNotNilDo: [:h | h removeDependent: self; close]. self eventHandler: nil! ! !AsyncFileReadStream methodsFor: 'read event handling' stamp: 'dtl 11/25/2006 10:56'! enableEventHandling self eventHandler: (AioEventHandler aioPluginPresent ifTrue: [AioEventHandler forFileStream: self exceptions: true readEvents: true writeEvents: false] ifFalse: [PseudoAioEventHandler new]). self eventHandler addDependent: self! ! !AsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/8/2003 19:26'! eventHandler "The aio event handler. Provides notification whenever external data is available." ^ eventHandler! ! !AsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/8/2003 19:26'! eventHandler: anAioEventHandler "The aio event handler. Provides notification whenever external data is available." eventHandler := anAioEventHandler! ! !AsyncFileReadStream methodsFor: 'finalization' stamp: 'dtl 7/6/2006 13:07'! finalize "Shut the the event handler before closing the file, otherwise aio functions may reference a closed file handle." eventHandler ifNotNilDo: [:e | e finalize]. super finalize ! ! !AsyncFileReadStream methodsFor: 'read event handling' stamp: 'dtl 7/8/2003 19:29'! hasValidHandler ^ self eventHandler notNil and: [eventHandler hasValidHandler] ! ! !AsyncFileReadStream methodsFor: 'initialize-release' stamp: 'dtl 3/15/2006 07:45'! initialize super initialize. self readOnly. OSProcess accessor setNonBlocking: self ioHandle. self enableEventHandling ! ! !AsyncFileReadStream methodsFor: 'initialize-release' stamp: 'dtl 7/8/2003 21:48'! open ^ super open initialize ! ! !AsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 9/2/2006 09:58'! upToEndOfFile "Answer a subcollection from the current access position through the last element of the receiver. Use #atEndOfFile to determine end of file status with feof(), required for reliable end of file test on OS pipes. Close the file when end of file is detected." | b | b := super upToEndOfFile. self isReadOnly ifTrue: [self close]. ^ b! ! !AsyncFileReadStream methodsFor: 'updating' stamp: 'dtl 7/8/2003 21:22'! update: aParameter (aParameter == self eventHandler) ifTrue: [self changed] ! ! AsyncFileReadStream subclass: #BufferedAsyncFileReadStream instanceVariableNames: 'nonBlockingMode readBuffer readSyncSemaphore dataAvailableSemaphore' classVariableNames: '' poolDictionaries: '' category: 'OSProcess-Base'! !BufferedAsyncFileReadStream commentStamp: 'dtl 3/7/2006 06:55' prior: 0! BufferedAsyncFileReadStream adds output buffering behavior to an event driven file stream, permitting blocking reads without risk of blocking the Squeak VM. This is useful for OS pipes, for which Squeak may wish to read and write the pipe without concern for VM deadlocks. A BufferedAsyncFileReadStream may be set for either blocking or nonblocking reads. When in blocking mode, a Smalltalk Process that requests a read will be blocked until data is available, but the VM will not be blocked and other Smalltalk Processes can proceed normally. Whenever data becomes available, a dataAvailableSemaphore is signalled and a #changed event is generated.! !BufferedAsyncFileReadStream class methodsFor: 'examples' stamp: 'dtl 7/9/2003 20:24'! stdIn "self stdIn" ^ super stdIn ! ! !BufferedAsyncFileReadStream methodsFor: 'finalization' stamp: 'dtl 6/17/2006 08:10'! actAsExecutor super actAsExecutor. nonBlockingMode := nil. readBuffer := nil. readSyncSemaphore := nil. dataAvailableSemaphore := nil ! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 10/1/2006 17:12'! appendAllToBuffer: chars "Append all chars to readBuffer, then signal dataAvailableSemaphore to inform any blocked reader that the read can proceed. Also generate a #changed event to inform any interested objects that new data has become available." | pos | self readSyncSemaphore critical: [(self readBuffer position > self maxReadBufferSize) ifTrue: ["Read buffer is getting too large. Replace it." self readBuffer: (ReadWriteStream on: readBuffer upToEnd)]. pos := readBuffer position. readBuffer setToEnd. readBuffer nextPutAll: chars. readBuffer position: pos]. self dataAvailableSemaphore signal. self changed! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 10/1/2006 17:12'! appendToBuffer: aCharacter "Append aCharacter to readBuffer, then signal dataAvailableSemaphore to inform any blocked reader that the read can proceed, and trigger a #dataReady event to inform any interested objects that new data has become available." | pos | self readSyncSemaphore critical: [pos := self readBuffer position. readBuffer setToEnd. readBuffer nextPut: aCharacter. readBuffer position: pos]. self dataAvailableSemaphore signal. self changed! ! !BufferedAsyncFileReadStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 20:54'! asAsyncFileReadStream "Answer a replacement for this object, with asynchronous event handling but no buffering." ^ AsyncFileReadStream name: self name attachTo: self ioHandle writable: self isReadOnly not ! ! !BufferedAsyncFileReadStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 20:55'! asBufferedAsyncFileReadStream ^ self! ! !BufferedAsyncFileReadStream methodsFor: 'testing' stamp: 'dtl 2/22/2007 08:00'! atEnd "Answer whether the receiver can access any more objects. Warning: If this instance represents the reader end of an OS pipe, it is possible for the #atEnd test to give a false negative. In particular, after closing the writer end of an empty OSPipe, the reader may not appear to be atEnd until some time has elapsed, or until an explicit read on the pipe causes the status to be updated. To illustrate the problem: (OSPipe new setBufferedReader; yourself) closeWriter; atEnd>>false (OSPipe new ) closeWriter; next; yourself; atEnd>>true (OSPipe new setBufferedReader; yourself) closeWriter; next; yourself; atEnd>>true" ^ self readSyncSemaphore critical: [self readBuffer atEnd and: [super atEnd]]! ! !BufferedAsyncFileReadStream methodsFor: 'testing' stamp: 'dtl 2/22/2007 08:01'! atEndOfFile "Answer whether the receiver is at its end based on the result of the last read operation. This uses feof() to test the underlying file stream status, and can be used as an alternative to #atEnd, which does not properly report end of file status for an OSPipe." ^ self readSyncSemaphore critical: [self readBuffer atEnd and: [fileID isNil or: [OSProcess accessor isAtEndOfFile: fileID]]]! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 2/22/2007 08:02'! basicNext "Answer the next byte from this file, or nil if at the end of the file. If the readBuffer is empty, force a basicNext in order to ensure that the end of file flag is updated (in stdio stream)." (self readSyncSemaphore critical: [self readBuffer atEnd]) ifTrue: [^ super basicNext] ifFalse: [[self isBlocking] ifTrue: [self waitForDataReady]. ^ self readSyncSemaphore critical: [readBuffer next]]! ! !BufferedAsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/6/2003 10:15'! dataAvailableSemaphore "Signalled one or more times when data becomes available. Only one Process is permitted to wait on this Semaphore." ^ dataAvailableSemaphore ifNil: [dataAvailableSemaphore := Semaphore new] ! ! !BufferedAsyncFileReadStream methodsFor: 'testing' stamp: 'dtl 7/9/2003 20:59'! isBlocking "Answer true if set to blocking mode." ^ self nonBlockingMode not! ! !BufferedAsyncFileReadStream methodsFor: 'defaults' stamp: 'dtl 7/6/2003 10:15'! maxReadBufferSize "Replace readBuffer when position exceeds this." ^ 40000 ! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 7/6/2003 21:06'! moveAvailableDataFrom: sqFile | count bufferSize buffer | bufferSize := self readAheadChunkSize. buffer := String new: bufferSize. [count := self primRead: sqFile into: buffer startingAt: 1 count: bufferSize] on: Error "Could fail if closed" do: [count := 0]. (count notNil and: [count > 0]) ifTrue: [count == bufferSize ifTrue: [self appendAllToBuffer: buffer] ifFalse: [count > 0 ifTrue: [self appendAllToBuffer: (buffer copyFrom: 1 to: count)]]] ifFalse: [(self closed or: [OSProcess accessor isAtEndOfFile: self ioHandle]) ifTrue: [self disableEventHandling]] ! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 7/6/2003 20:30'! moveAvailableDataToBuffer ^ self moveAvailableDataFrom: (OSProcess accessor handleFromAccessor: self ioHandle). ! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 2/22/2007 08:05'! next ((self readSyncSemaphore critical: [self readBuffer atEnd]) and: [self isBlocking]) ifTrue: [self waitForDataReady]. ^ self readSyncSemaphore critical: [readBuffer next]! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 7/6/2003 10:15'! next: n into: aString startingAt: startIndex "Read n bytes into the given string. Return aString or a partial copy if less than n elements have been read." | count | count := self readInto: aString startingAt: startIndex count: n. count = n ifTrue: [^ aString] ifFalse: [^ aString copyFrom: 1 to: startIndex+count-1]! ! !BufferedAsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/9/2003 20:57'! nonBlockingMode "True if nonblocking read behavior should be implemented" ^ nonBlockingMode ifNil: [nonBlockingMode := true] ! ! !BufferedAsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/9/2003 20:58'! nonBlockingMode: trueOrFalse "True if nonblocking read behavior should be implemented" nonBlockingMode := trueOrFalse ! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 2/22/2007 08:06'! peek "Answer what would be returned if the message next were sent to the receiver. If the receiver is at the end, answer nil. " ((self readSyncSemaphore critical: [self readBuffer atEnd]) and: [self isBlocking]) ifTrue: [self waitForDataReady]. ^ self readSyncSemaphore critical: [readBuffer peek]! ! !BufferedAsyncFileReadStream methodsFor: 'defaults' stamp: 'dtl 7/6/2003 10:15'! readAheadChunkSize "The async read ahead process will read at most this many characters. Notes: On my system (dtl), a chunk size of 2000 leads to ExternalCommandShell overdriving the stdout stream when doing (for example) a long directory listing. I have added error handling to accommodate this, but I do know know how reliable it is, so I would prefer to avoid generating the condition. A chunk size of 200 is small enough that performance is noticably impacted in a CommandShell window. A chunk size of 1000 seems to produce good overall behavior." ^ 1000! ! !BufferedAsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/6/2003 10:15'! readBuffer "Read ahead buffer, filled asynchronously as data becomes available on the IO channel" ^ readBuffer ifNil: [readBuffer := ReadWriteStream on: ''] ! ! !BufferedAsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/6/2003 10:15'! readBuffer: aStream readBuffer := aStream! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 3/21/2007 21:56'! readInto: byteArray startingAt: startIndex count: count "Read into the given array as specified, and return the count actually transferred. " | s size | self isBlocking ifTrue: [self waitForDataReady: count. s := self readSyncSemaphore critical: [self readBuffer next: count]. size := count] ifFalse: [size := self readBuffer size - readBuffer position min: count. s := self readSyncSemaphore critical: [self readBuffer next: size]]. byteArray replaceFrom: startIndex to: startIndex + size - 1 with: s. ^ size! ! !BufferedAsyncFileReadStream methodsFor: 'accessing' stamp: 'dtl 7/6/2003 10:15'! readSyncSemaphore "A semaphore for synchronizing access to readBuffer" ^ readSyncSemaphore ifNil: [readSyncSemaphore := Semaphore forMutualExclusion]! ! !BufferedAsyncFileReadStream methodsFor: 'initialize-release' stamp: 'dtl 7/9/2003 20:54'! setBlocking "Set for blocking reads. Default is nonblocking mode." self nonBlockingMode: false ! ! !BufferedAsyncFileReadStream methodsFor: 'initialize-release' stamp: 'dtl 7/9/2003 20:55'! setNonBlocking "Set for nonblocking reads. This is the default mode." self nonBlockingMode: true ! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 3/19/2007 18:28'! upTo: delim ^ self readSyncSemaphore critical: [self readBuffer upTo: delim] ! ! !BufferedAsyncFileReadStream methodsFor: 'read, write, position' stamp: 'dtl 12/21/2007 13:14'! upToEndOfFile "Answer a subcollection from the current access position through the last element of the receiver. Use #atEndOfFile to determine end of file status with feof(), required for reliable end of file test on OS pipes. Close the file when end of file is detected." | newStream buffer | buffer := buffer1 species new: 1000. newStream := WriteStream on: (buffer1 species new: 100). [self atEndOfFile] whileFalse: [self moveAvailableDataToBuffer. newStream nextPutAll: (self nextInto: buffer)]. self isReadOnly ifTrue: [self close]. ^ newStream contents ! ! !BufferedAsyncFileReadStream methodsFor: 'updating' stamp: 'dtl 7/8/2003 22:06'! update: aParameter "A #changed event is generated as a side effect of this method" (aParameter == self eventHandler) ifTrue: [self moveAvailableDataToBuffer] ! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 7/6/2003 10:15'! waitForBufferAvailable "Block if the readBuffer has grown too large. No-op for now, but add this later if large pipes prove to be a problem."! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 7/6/2003 10:15'! waitForDataReady "Block until at least one character is available in the readBuffer. This is not thread safe, and only one Process is permitted to send this message." self dataAvailableSemaphore wait ! ! !BufferedAsyncFileReadStream methodsFor: 'read ahead buffer' stamp: 'dtl 2/22/2007 08:09'! waitForDataReady: count "Block until at least count characters are available in the readBuffer" [self readSyncSemaphore critical: [self readBuffer size - readBuffer position < count]] whileTrue: [self waitForDataReady]! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:53'! fileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'initialize-release' stamp: 'dtl 10/19/2001 21:53'! initialize "AttachableFileStream initialize" UseIOHandle := (Smalltalk hasClassNamed: #IOHandle) ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:53'! isAFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'instance creation' stamp: 'dtl 3/15/2006 19:50'! name: aSymbolOrString attachTo: anIOHandle writable: readWriteFlag "Create a new instance attached to anIOHandle, where anIOHandle represents an open IO channel. For write streams, this represents two Smalltalk streams which write to the same OS file or output stream, presumably with interleaved output. The purpose of this method is to permit a FileStream to be attached to an existing IOHandle, such as the IOHandle for standard input, standard output, and standard error." ^ (super basicNew name: aSymbolOrString attachTo: anIOHandle writable: readWriteFlag) initialize! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:54'! newFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:55'! oldFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'file creation' stamp: 'dtl 6/12/1999 15:56'! readOnlyFileNamed: fileName self shouldNotImplement ! ! !AttachableFileStream class methodsFor: 'registry' stamp: 'dtl 8/25/2006 18:15'! register: anObject "An attachable file stream is generally either a second reference to an existing file stream, or a reference to a transient object such as a pipe endpoint. There is no need to register it for finalization." ^ anObject! ! !AttachableFileStream class methodsFor: 'examples' stamp: 'dtl 3/7/2006 06:42'! stdIn "self stdIn" ^ self name: 'stdIn' attachTo: OSProcess thisOSProcess stdIn ioHandle writable: false ! ! !AttachableFileStream class methodsFor: 'registry' stamp: 'dtl 8/25/2006 18:15'! unregister: anObject "An attachable file stream is generally either a second reference to an existing file stream, or a reference to a transient object such as a pipe endpoint. There is no need to register it for finalization." ^ anObject! ! !AttachableFileStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 21:01'! asAsyncFileReadStream "Answer a replacement for this object, with asynchronous event handling. Do not close the ioHandle when this object is finalized." self keepOpen. ^ AsyncFileReadStream name: self name attachTo: self ioHandle writable: self isReadOnly not ! ! !AttachableFileStream methodsFor: 'converting' stamp: 'dtl 9/16/2002 17:59'! asAttachableFileStream ^ self ! ! !AttachableFileStream methodsFor: 'converting' stamp: 'dtl 7/8/2003 21:01'! asBufferedAsyncFileReadStream "Answer a replacement for this object, with asynchronous event handling and buffered output. Do not close the ioHandle when this object is finalized." self keepOpen. ^ BufferedAsyncFileReadStream name: self name attachTo: self ioHandle writable: self isReadOnly not ! ! !AttachableFileStream methodsFor: 'finalization' stamp: 'dtl 9/17/2002 08:08'! autoClose "Private. Answer true if the file should be automatically closed when this object is finalized." ^ autoClose ifNil: [autoClose := true]! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 7/6/2006 11:21'! close "Close this file." self ioHandle ifNotNilDo: [:handle | UseIOHandle ifTrue: [handle close. self ioHandle: nil] ifFalse: [self primCloseNoError: handle. self unregister. fileID := nil]] ! ! !AttachableFileStream methodsFor: 'initialize-release' stamp: 'dtl 4/14/2006 09:34'! disableEventHandling "Subclasses may disable event handling"! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:00'! ensureOpen self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'finalization' stamp: 'dtl 7/6/2006 22:17'! finalize self autoClose ifTrue: [[self primCloseNoError: fileID] on: Error do: []]! ! !AttachableFileStream methodsFor: 'read, write, position' stamp: 'dtl 11/8/2000 21:55'! flush "Flush the external OS stream (the one in the C library)." OSProcess accessor flushExternalStream: self ioHandle! ! !AttachableFileStream methodsFor: 'private - IOHandle' stamp: 'dtl 1/29/2000 15:18'! ioHandle UseIOHandle ifTrue: [^ super ioHandle] ifFalse: [^ fileID]! ! !AttachableFileStream methodsFor: 'testing' stamp: 'dtl 3/26/2006 15:52'! isPipe ^ false ! ! !AttachableFileStream methodsFor: 'finalization' stamp: 'dtl 9/17/2002 08:05'! keepOpen "Do not allow the file to be closed when this object is finalized." autoClose := false ! ! !AttachableFileStream methodsFor: 'attaching' stamp: 'dtl 11/30/2002 09:22'! name: aSymbolOrString attachTo: anIOHandle writable: readWriteFlag "Attach to an existing file handle, assumed to have been previously opened by the underlying operating system." name := aSymbolOrString. UseIOHandle ifTrue: [self ioHandle: anIOHandle] ifFalse: [fileID := anIOHandle]. readWriteFlag ifTrue: [self readWrite] ifFalse: [self readOnly]. self ascii. UseIOHandle ifFalse: [self register] ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:00'! open self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:01'! open: fileName forWrite: writeMode self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:02'! openReadOnly self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'open/close' stamp: 'dtl 6/12/1999 16:02'! reopen self shouldNotImplement ! ! !AttachableFileStream methodsFor: 'nonblocking' stamp: 'dtl 2/17/2007 18:10'! setBlocking OSProcess accessor setBlocking: self ioHandle! ! !AttachableFileStream methodsFor: 'nonblocking' stamp: 'dtl 2/17/2007 18:10'! setNonBlocking OSProcess accessor setNonBlocking: self ioHandle! ! !AttachableFileStream methodsFor: 'read, write, position' stamp: 'dtl 9/2/2006 17:17'! upToEnd "Answer a subcollection from the current access position through the last element of the receiver. This is slower than the method in StandardFileStream, but it works with pipes which answer false to #atEnd when no further input is currently available, but the pipe is not yet closed." | newStream buffer nextBytes | buffer := buffer1 species new: 1000. newStream := WriteStream on: (buffer1 species new: 100). [self atEnd or: [(nextBytes := self nextInto: buffer) isEmpty]] whileFalse: [newStream nextPutAll: nextBytes]. ^ newStream contents ! ! !AttachableFileStream methodsFor: 'read, write, position' stamp: 'dtl 6/4/2006 16:02'! upToEndOfFile "Answer a subcollection from the current access position through the last element of the receiver. Use #atEndOfFile to determine end of file status with feof(), required for reliable end of file test on OS pipes." | newStream buffer | buffer := buffer1 species new: 1000. newStream := WriteStream on: (buffer1 species new: 100). [self atEndOfFile] whileFalse: [newStream nextPutAll: (self nextInto: buffer)]. ^ newStream contents! ! !StandardFileStream methodsFor: '*OSProcess' stamp: 'dtl 6/5/2006 06:59'! atEndOfFile "Answer whether the receiver is at its end based on the result of the last read operation. This uses feof() to test the underlying file stream status, and can be used as an alternative to #atEnd, which does not properly report end of file status for an OSPipe." ^ fileID isNil or: [OSProcess accessor isAtEndOfFile: fileID] ! ! !StandardFileStream methodsFor: '*OSProcess' stamp: 'dtl 1/13/2007 16:44'! fileID "The contents of fileID can and will change after calling this method. The sender should copy the result rather than depending on the result to be immutable." ^ fileID! ! !StandardFileStream methodsFor: '*OSProcess' stamp: 'dtl 6/5/2006 07:18'! isPipe ^ false ! ! OSProcessAccessor initialize! OSProcess initialize! ThisOSProcess initialize! AttachableFileStream initialize!