--- a/AbstractOperatingSystem.st Thu Feb 07 09:53:25 2013 +0100
+++ b/AbstractOperatingSystem.st Tue Mar 05 18:10:13 2013 +0000
@@ -184,6 +184,28 @@
!AbstractOperatingSystem class methodsFor:'initialization'!
+getConcreteClass
+ |osType|
+
+ osType := self getSystemType.
+ osType = 'win32' ifTrue:[
+ ^ Win32OperatingSystem
+ ].
+ osType = 'osx' ifTrue:[
+ ^ OSXOperatingSystem
+ ].
+ osType = 'os2' ifTrue:[
+ ^ OS2OperatingSystem
+ ].
+ osType = 'macos' ifTrue:[
+ ^ MacOperatingSystem
+ ].
+ ((osType = 'VMS') or:[osType = 'openVMS']) ifTrue:[
+ ^ OpenVMSOperatingSystem
+ ].
+ ^ UnixOperatingSystem
+!
+
initResources
"/ allow for ResourcePack class to be missing (non-GUI smalltalks)
@@ -220,27 +242,7 @@
!
initializeConcreteClass
- |osType cls|
-
- osType := self getSystemType.
- osType = 'win32' ifTrue:[
- cls := Win32OperatingSystem
- ] ifFalse:[
- osType = 'os2' ifTrue:[
- cls := OS2OperatingSystem
- ] ifFalse:[
- osType = 'macos' ifTrue:[
- cls := MacOperatingSystem
- ] ifFalse:[
- ((osType = 'VMS') or:[osType = 'openVMS']) ifTrue:[
- cls := OpenVMSOperatingSystem
- ] ifFalse:[
- cls := UnixOperatingSystem
- ]
- ]
- ]
- ].
- OperatingSystem := ConcreteClass := cls.
+ OperatingSystem := ConcreteClass := self getConcreteClass.
! !
!AbstractOperatingSystem class methodsFor:'OS signal constants'!
@@ -1167,228 +1169,228 @@
terminateLock := Semaphore forMutualExclusion.
((externalInStream := anInStream) notNil
and:[externalInStream isExternalStream not]) ifTrue:[
- pIn := NonPositionableExternalStream makePipe.
- inStreamToClose := externalInStream := pIn at:1.
- shuffledInStream := pIn at:2.
- anInStream isBinary ifTrue:[
- shuffledInStream binary
- ].
- lineWise ifFalse:[
- shuffledInStream blocking:false.
- ].
-
- "/ start a reader process, shuffling data from the given
- "/ inStream to the pipe (which is connected to the commands input)
- inputShufflerProcess :=
- [
- [
- [anInStream atEnd] whileFalse:[
- self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
- shuffledInStream flush
- ]
- ] ensure:[
- shuffledInStream close
- ]
- ] newProcess
- name:'cmd input shuffler';
+ pIn := NonPositionableExternalStream makePipe.
+ inStreamToClose := externalInStream := pIn at:1.
+ shuffledInStream := pIn at:2.
+ anInStream isBinary ifTrue:[
+ shuffledInStream binary
+ ].
+ lineWise ifFalse:[
+ shuffledInStream blocking:false.
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ inStream to the pipe (which is connected to the commands input)
+ inputShufflerProcess :=
+ [
+ [
+ [anInStream atEnd] whileFalse:[
+ self shuffleFrom:anInStream to:shuffledInStream lineWise:lineWise.
+ shuffledInStream flush
+ ]
+ ] ensure:[
+ shuffledInStream close
+ ]
+ ] newProcess
+ name:'cmd input shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
((externalOutStream := anOutStream) notNil
and:[externalOutStream isExternalStream not]) ifTrue:[
- pOut := NonPositionableExternalStream makePipe.
- shuffledOutStream := (pOut at:1).
- anOutStream isBinary ifTrue:[
- shuffledOutStream binary
- ].
- outStreamToClose := externalOutStream := pOut at:2.
- outputShufflerProcess :=
- [
- WriteError handle:[:ex |
- "/ ignored
- ] do:[
- self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
- ].
- ] newProcess
- name:'cmd output shuffler';
+ pOut := NonPositionableExternalStream makePipe.
+ shuffledOutStream := (pOut at:1).
+ anOutStream isBinary ifTrue:[
+ shuffledOutStream binary
+ ].
+ outStreamToClose := externalOutStream := pOut at:2.
+ outputShufflerProcess :=
+ [
+ WriteError handle:[:ex |
+ "/ ignored
+ ] do:[
+ self shuffleAllFrom:shuffledOutStream to:anOutStream lineWise:lineWise lockWith:terminateLock.
+ ].
+ ] newProcess
+ name:'cmd output shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
(externalErrStream := anErrStream) notNil ifTrue:[
- anErrStream == anOutStream ifTrue:[
- externalErrStream := externalOutStream
- ] ifFalse:[
- anErrStream isExternalStream ifFalse:[
- pErr := NonPositionableExternalStream makePipe.
- shuffledErrStream := (pErr at:1).
- anErrStream isBinary ifTrue:[
- shuffledErrStream binary
- ].
- errStreamToClose := externalErrStream := pErr at:2.
- errorShufflerProcess :=
- [
- self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
- ] newProcess
- name:'cmd err-output shuffler';
+ anErrStream == anOutStream ifTrue:[
+ externalErrStream := externalOutStream
+ ] ifFalse:[
+ anErrStream isExternalStream ifFalse:[
+ pErr := NonPositionableExternalStream makePipe.
+ shuffledErrStream := (pErr at:1).
+ anErrStream isBinary ifTrue:[
+ shuffledErrStream binary
+ ].
+ errStreamToClose := externalErrStream := pErr at:2.
+ errorShufflerProcess :=
+ [
+ self shuffleAllFrom:shuffledErrStream to:anErrStream lineWise:lineWise lockWith:terminateLock.
+ ] newProcess
+ name:'cmd err-output shuffler';
"/ beSystemProcess;
- resume.
- ]
- ]
+ resume.
+ ]
+ ]
].
((externalAuxStream := anAuxStream) notNil
and:[externalAuxStream isExternalStream not]) ifTrue:[
- pAux := NonPositionableExternalStream makePipe.
- auxStreamToClose := externalAuxStream := pAux at:1.
- shuffledAuxStream := pAux at:2.
- shuffledAuxStream blocking:false.
- anAuxStream isBinary ifTrue:[
- shuffledAuxStream binary
- ].
-
- "/ start a reader process, shuffling data from the given
- "/ auxStream to the pipe (which is connected to the commands aux)
- auxShufflerProcess :=
- [
- [
- [anAuxStream atEnd] whileFalse:[
- self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
- shuffledAuxStream flush
- ]
- ] ensure:[
- shuffledAuxStream close
- ]
- ] newProcess
- name:'cmd aux shuffler';
+ pAux := NonPositionableExternalStream makePipe.
+ auxStreamToClose := externalAuxStream := pAux at:1.
+ shuffledAuxStream := pAux at:2.
+ shuffledAuxStream blocking:false.
+ anAuxStream isBinary ifTrue:[
+ shuffledAuxStream binary
+ ].
+
+ "/ start a reader process, shuffling data from the given
+ "/ auxStream to the pipe (which is connected to the commands aux)
+ auxShufflerProcess :=
+ [
+ [
+ [anAuxStream atEnd] whileFalse:[
+ self shuffleFrom:anAuxStream to:shuffledAuxStream lineWise:false.
+ shuffledAuxStream flush
+ ]
+ ] ensure:[
+ shuffledAuxStream close
+ ]
+ ] newProcess
+ name:'cmd aux shuffler';
"/ beSystemProcess;
- resume.
+ resume.
].
- stopShufflers := [
- inputShufflerProcess notNil ifTrue:[
- terminateLock critical:[inputShufflerProcess terminate].
- inputShufflerProcess waitUntilTerminated
- ].
- auxShufflerProcess notNil ifTrue:[
- terminateLock critical:[auxShufflerProcess terminate].
- auxShufflerProcess waitUntilTerminated
- ].
- outputShufflerProcess notNil ifTrue:[
- terminateLock critical:[outputShufflerProcess terminate].
- outputShufflerProcess waitUntilTerminated.
- self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise.
- shuffledOutStream close.
- ].
- errorShufflerProcess notNil ifTrue:[
- terminateLock critical:[errorShufflerProcess terminate].
- errorShufflerProcess waitUntilTerminated.
- self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise.
- shuffledErrStream close.
- ].
+ stopShufflers := [:shuffleRest |
+ inputShufflerProcess notNil ifTrue:[
+ terminateLock critical:[inputShufflerProcess terminate].
+ inputShufflerProcess waitUntilTerminated
+ ].
+ auxShufflerProcess notNil ifTrue:[
+ terminateLock critical:[auxShufflerProcess terminate].
+ auxShufflerProcess waitUntilTerminated
+ ].
+ outputShufflerProcess notNil ifTrue:[
+ terminateLock critical:[outputShufflerProcess terminate].
+ outputShufflerProcess waitUntilTerminated.
+ shuffleRest ifTrue:[ self shuffleRestFrom:shuffledOutStream to:anOutStream lineWise:lineWise ].
+ shuffledOutStream close.
+ ].
+ errorShufflerProcess notNil ifTrue:[
+ terminateLock critical:[errorShufflerProcess terminate].
+ errorShufflerProcess waitUntilTerminated.
+ shuffleRest ifTrue:[ self shuffleRestFrom:shuffledErrStream to:anErrStream lineWise:lineWise ].
+ shuffledErrStream close.
+ ].
].
closeStreams := [
- inStreamToClose notNil ifTrue:[
- inStreamToClose close
- ].
- errStreamToClose notNil ifTrue:[
- errStreamToClose close
- ].
- outStreamToClose notNil ifTrue:[
- outStreamToClose close
- ].
- auxStreamToClose notNil ifTrue:[
- auxStreamToClose close
- ].
+ inStreamToClose notNil ifTrue:[
+ inStreamToClose close
+ ].
+ errStreamToClose notNil ifTrue:[
+ errStreamToClose close
+ ].
+ outStreamToClose notNil ifTrue:[
+ outStreamToClose close
+ ].
+ auxStreamToClose notNil ifTrue:[
+ auxStreamToClose close
+ ].
].
sema := Semaphore new name:'OS command wait'.
[
- pid := Processor
- monitor:[
- self
- startProcess:aCommandString
- inputFrom:externalInStream
- outputTo:externalOutStream
- errorTo:externalErrStream
- auxFrom:externalAuxStream
- environment:environmentDictionary
- inDirectory:dirOrNil
- ]
- action:[:status |
- status stillAlive ifFalse:[
- exitStatus := status.
- sema signal.
- self closePid:pid
- ]
- ].
-
- pid isNil ifTrue:[
- exitStatus := self osProcessStatusClass processCreationFailure
- ] ifFalse:[
- sema wait.
- ].
+ pid := Processor
+ monitor:[
+ self
+ startProcess:aCommandString
+ inputFrom:externalInStream
+ outputTo:externalOutStream
+ errorTo:externalErrStream
+ auxFrom:externalAuxStream
+ environment:environmentDictionary
+ inDirectory:dirOrNil
+ ]
+ action:[:status |
+ status stillAlive ifFalse:[
+ exitStatus := status.
+ sema signal.
+ self closePid:pid
+ ]
+ ].
+
+ pid isNil ifTrue:[
+ exitStatus := self osProcessStatusClass processCreationFailure
+ ] ifFalse:[
+ sema wait.
+ ].
] ifCurtailed:[
- closeStreams value.
- pid notNil ifTrue:[
- "/ terminate the os-command (and all of its forked commands)
- self terminateProcessGroup:pid.
- self terminateProcess:pid.
- self closePid:pid.
- ].
- stopShufflers value.
+ closeStreams value.
+ pid notNil ifTrue:[
+ "/ terminate the os-command (and all of its forked commands)
+ self terminateProcessGroup:pid.
+ self terminateProcess:pid.
+ self closePid:pid.
+ ].
+ stopShufflers value:false.
].
closeStreams value.
- stopShufflers value.
+ stopShufflers value:true.
exitStatus success ifFalse:[
- ^ aBlock value:exitStatus
+ ^ aBlock value:exitStatus
].
^ true
"
- |outStream errStream|
-
- outStream := '' writeStream.
-
- OperatingSystem executeCommand:'ls -l'
- inputFrom:'abc' readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:true
- onError:[:exitStatus | ^ false].
- outStream contents
- "
-
- "
- |outStream errStream|
-
- outStream := #[] writeStream.
-
- OperatingSystem executeCommand:'cat'
- inputFrom:(ByteArray new:5000000) readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:false
- onError:[:exitStatus | ^ false].
- outStream size
- "
-
- "
- |outStream errStream|
-
- outStream := '' writeStream.
-
- OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
- inputFrom:'bla' readStream
- outputTo:outStream
- errorTo:nil
- inDirectory:nil
- lineWise:true
- onError:[:exitStatus | false].
- outStream contents
+ |outStream errStream|
+
+ outStream := '' writeStream.
+
+ OperatingSystem executeCommand:'ls -l'
+ inputFrom:'abc' readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:true
+ onError:[:exitStatus | ^ false].
+ outStream contents
+ "
+
+ "
+ |outStream errStream|
+
+ outStream := #[] writeStream.
+
+ OperatingSystem executeCommand:'cat'
+ inputFrom:(ByteArray new:5000000) readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:false
+ onError:[:exitStatus | ^ false].
+ outStream size
+ "
+
+ "
+ |outStream errStream|
+
+ outStream := '' writeStream.
+
+ OperatingSystem executeCommand:'gpg -s --batch --no-tty --passphrase-fd 0 /tmp/passwd'
+ inputFrom:'bla' readStream
+ outputTo:outStream
+ errorTo:nil
+ inDirectory:nil
+ lineWise:true
+ onError:[:exitStatus | false].
+ outStream contents
"
"Modified: / 11-02-2007 / 20:54:39 / cg"
@@ -2841,16 +2843,22 @@
!
enableAbortInterrupts
- "enable abort signalhandling, and make it a regular signalInterrupt.
+ "enable SIGABRT signal handling, and make it a regular signalInterrupt.
(the default will dump core and exit - which is not a good idea for
end-user applications ...).
+ After enabling, these exceptions will send the message
+ 'signalInterrupt' to the SignalInterruptHandler object.
This is especially useful, if linked-in C-libraries call abort() ..."
self enableSignal:(self sigABRT)
+
+ "
+ OperatingSystem enableAbortInterrupts
+ "
!
enableChildSignalInterrupts
- "enable childSignal interrupts
+ "enable child process interrupts
(SIGCHLD, if the architecture supports it).
After enabling, these signals will send the message
'childSignalInterrupt' to the ChildSignalInterruptHandler object."
@@ -2867,8 +2875,7 @@
!
enableFpExceptionInterrupts
- "enable floating point exception interrupts (if the
- architecture supports it).
+ "enable floating point exception interrupts (if the architecture supports it).
After enabling, fpu-exceptions will send the message
'fpuExceptionInterrupt' to the FPUExceptionInterruptHandler object."
@@ -2876,7 +2883,7 @@
!
enableHardSignalInterrupts
- "enable hard signal exception interrupts (trap, buserror & segm. violation).
+ "enable hard signal exception interrupts (trap, bus error & segm. violation).
After enabling, these exceptions will send the message
'signalInterrupt' to the SignalInterruptHandler object."
@@ -3837,6 +3844,12 @@
^ false
!
+isOSXlike
+ "return true, if the OS we're running on is a mac OSX like (but not A/UX or OS9)."
+
+ ^ false
+!
+
isProcessIdPresent:pid
"answer true, if a process with process id pid is present, false if not.
Raise an error, if an exception occures"
@@ -7169,11 +7182,11 @@
!AbstractOperatingSystem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.225 2013-02-05 22:12:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.230 2013-03-04 15:16:51 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.225 2013-02-05 22:12:47 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/AbstractOperatingSystem.st,v 1.230 2013-03-04 15:16:51 cg Exp $'
! !