Mercurial Mercurial > hg > stx-libbasic / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
PipeStream.st
branchjv
changeset 18786 237a87b4fe8f
parent 18640 358b275dced9
parent 18785 5b58b205c252
child 19863 513bd7237fe7
equal deleted inserted replaced
18773:4f6a5cbce3a9 18786:237a87b4fe8f 
     1 "{ Encoding: utf8 }"
 
       
     2 
       
     3 "
 
     1 "
 
     4  COPYRIGHT (c) 1989 by Claus Gittinger
 
     2  COPYRIGHT (c) 1989 by Claus Gittinger
 
     5 	      All Rights Reserved
 
     3 	      All Rights Reserved
 
     6 
     4 
     7  This software is furnished under a license and may be used
 
     5  This software is furnished under a license and may be used
 
   218 
   216 
   219     "
 
   217     "
 
   220 	|p|
 
   218 	|p|
 
   221 
   219 
   222 	p := PipeStream bidirectionalFor:'cat -u'.
 
   220 	p := PipeStream bidirectionalFor:'cat -u'.
 
   223 	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
 
   221 	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
 
   224 	Transcript showCR:p nextLine.
 
   222 	Transcript showCR:p nextLine.
 
   225 	p close
 
   223 	p close
 
   226     "
 
   224     "
 
   227 
   225 
   228     "
 
   226     "
 
   486 !PipeStream methodsFor:'closing'!
 
   484 !PipeStream methodsFor:'closing'!
 
   487 
   485 
   488 shutDown
 
   486 shutDown
 
   489     "close the Stream and terminate the command"
 
   487     "close the Stream and terminate the command"
 
   490 
   488 
   491     Lobby unregister:self.
 
   489     self unregisterForFinalization
 
       
   490        "terminate first under windows".
 
   492 
   491 
   493     "terminate first under windows"
 
   492     "terminate first under windows"
 
   494     OperatingSystem isMSDOSlike ifTrue:[
 
   493     OperatingSystem isMSDOSlike ifTrue:[
 
   495 	self terminatePipeCommand.
 
   494         self terminatePipeCommand.
 
   496 	self closeFileDescriptor.
 
   495         self closeFileDescriptor.
 
   497 	^ self.
 
   496         ^ self.
 
   498     ].
 
   497     ].
 
   499 
   498 
   500     "terminate last under unix"
 
   499     "terminate last under unix"
 
   501     self closeFileDescriptor.
 
   500     self closeFileDescriptor.
 
   502     self terminatePipeCommand.
 
   501     self terminatePipeCommand.
 
   610     |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
 
   609     |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
 
   611      shellPath shellArgs mbx mbxName
 
   610      shellPath shellArgs mbx mbxName
 
   612      realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
 
   611      realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|
 
   613 
   612 
   614     handle notNil ifTrue:[
 
   613     handle notNil ifTrue:[
 
   615 	"the pipe was already open ...
 
   614         "the pipe was already open ...
 
   616 	 this should (can) not happen."
 
   615          this should (can) not happen."
 
   617 	^ self errorAlreadyOpen
 
   616         ^ self errorAlreadyOpen
 
   618     ].
 
   617     ].
 
   619 
   618 
   620     rwMode = #r ifTrue:[
 
   619     rwMode = #r ifTrue:[
 
   621 	mode := #readonly. didWrite := false.
 
   620         mode := #readonly. didWrite := false.
 
   622     ] ifFalse:[rwMode = #'r+' ifTrue:[
 
   621     ] ifFalse:[rwMode = #'r+' ifTrue:[
 
   623 	mode := #readwrite. didWrite := true.
 
   622         mode := #readwrite. didWrite := true.
 
   624     ] ifFalse:[
 
   623     ] ifFalse:[
 
   625 	mode := #writeonly. didWrite := true.
 
   624         mode := #writeonly. didWrite := true.
 
   626     ]].
 
   625     ]].
 
   627 
   626 
   628     lastErrorNumber := nil.
 
   627     lastErrorNumber := nil.
 
   629     exitStatus := nil.
 
   628     exitStatus := nil.
 
   630     exitSema := Semaphore new name:'pipe exitSema'.
 
   629     exitSema := Semaphore new name:'pipe exitSema'.
 
   632     realCmd := aCommandString.
 
   631     realCmd := aCommandString.
 
   633     execDirectory := aDirectory.
 
   632     execDirectory := aDirectory.
 
   634     execFdArray := #(0 1 2) copy.
 
   633     execFdArray := #(0 1 2) copy.
 
   635 
   634 
   636     OperatingSystem isVMSlike ifTrue:[
 
   635     OperatingSystem isVMSlike ifTrue:[
 
   637 	"/
 
   636         "/
 
   638 	"/ the generated COM-file includes a 'set default'
 
   637         "/ the generated COM-file includes a 'set default'
 
   639 	"/
 
   638         "/
 
   640 	tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
 
   639         tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
 
   641 	realCmd := '@' , tmpComFile osName.
 
   640         realCmd := '@' , tmpComFile osName.
 
   642 	execDirectory := nil.
 
   641         execDirectory := nil.
 
   643 
   642 
   644 	mbx := OperatingSystem createMailBox.
 
   643         mbx := OperatingSystem createMailBox.
 
   645 	mbx isNil ifTrue:[
 
   644         mbx isNil ifTrue:[
 
   646 	    lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
 
   645             lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
 
   647 	    tmpComFile delete.
 
   646             tmpComFile delete.
 
   648 	    ^ self openError:errorNumber.
 
   647             ^ self openError:errorNumber.
 
   649 	].
 
   648         ].
 
   650 	mbxName := OperatingSystem mailBoxNameOf:mbx.
 
   649         mbxName := OperatingSystem mailBoxNameOf:mbx.
 
   651 
   650 
   652 	"/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
 
   651         "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
 
   653 	shellPath := ''.
 
   652         shellPath := ''.
 
   654 	shellArgs := realCmd.
 
   653         shellArgs := realCmd.
 
   655 
   654 
   656 	rwMode = #r ifTrue:[
 
   655         rwMode = #r ifTrue:[
 
   657 	    "redirect stdout of subprocess to write to mailbox"
 
   656             "redirect stdout of subprocess to write to mailbox"
 
   658 	    execFdArray at:2 put:mbx.
 
   657             execFdArray at:2 put:mbx.
 
   659 	] ifFalse:[
 
   658         ] ifFalse:[
 
   660 	    "redirect stdin of subprocess to read from mailbox"
 
   659             "redirect stdin of subprocess to read from mailbox"
 
   661 	    execFdArray at:1 put:mbx.
 
   660             execFdArray at:1 put:mbx.
 
   662 	].
 
   661         ].
 
   663     ] ifFalse:[
 
   662     ] ifFalse:[
 
   664 	shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
 
   663         shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
 
   665 	shellPath := shellAndArgs at:1.
 
   664         shellPath := shellAndArgs at:1.
 
   666 	shellArgs := shellAndArgs at:2.
 
   665         shellArgs := shellAndArgs at:2.
 
   667 
   666 
   668 	mode == #readwrite ifTrue:[
 
   667         mode == #readwrite ifTrue:[
 
   669 	    pipeFdArray := OperatingSystem makeBidirectionalPipe.
 
   668             pipeFdArray := OperatingSystem makeBidirectionalPipe.
 
   670 	    pipeFdArray isNil ifTrue:[
 
   669             pipeFdArray isNil ifTrue:[
 
   671 		lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
 
   670                 lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
 
   672 		^ self openError:errorNumber.
 
   671                 ^ self openError:errorNumber.
 
   673 	    ].
 
   672             ].
 
   674 	    myFd := pipeFdArray at:1.
 
   673             myFd := pipeFdArray at:1.
 
   675 	    execFd := pipeFdArray at:2.
 
   674             execFd := pipeFdArray at:2.
 
   676 	    execFdArray at:1 put:execFd.
 
   675             execFdArray at:1 put:execFd.
 
   677 	    execFdArray at:2 put:execFd.
 
   676             execFdArray at:2 put:execFd.
 
   678 	] ifFalse:[
 
   677         ] ifFalse:[
 
   679 	    pipeFdArray := OperatingSystem makePipe.
 
   678             pipeFdArray := OperatingSystem makePipe.
 
   680 	    pipeFdArray isNil ifTrue:[
 
   679             pipeFdArray isNil ifTrue:[
 
   681 		lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
 
   680                 lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
 
   682 		^ self openError:errorNumber.
 
   681                 ^ self openError:errorNumber.
 
   683 	    ].
 
   682             ].
 
   684 
   683 
   685 	    mode == #readonly ifTrue:[
 
   684             mode == #readonly ifTrue:[
 
   686 		"redirect stdout of subprocess to write to pipe"
 
   685                 "redirect stdout of subprocess to write to pipe"
 
   687 		myFd := pipeFdArray at:1.
 
   686                 myFd := pipeFdArray at:1.
 
   688 		execFd := pipeFdArray at:2.
 
   687                 execFd := pipeFdArray at:2.
 
   689 		execFdArray at:2 put:execFd.
 
   688                 execFdArray at:2 put:execFd.
 
   690 	    ] ifFalse:[
 
   689             ] ifFalse:[
 
   691 		"redirect stdin of subprocess to read from pipe"
 
   690                 "redirect stdin of subprocess to read from pipe"
 
   692 		myFd := pipeFdArray at:2.
 
   691                 myFd := pipeFdArray at:2.
 
   693 		execFd := pipeFdArray at:1.
 
   692                 execFd := pipeFdArray at:1.
 
   694 		execFdArray at:1 put:execFd.
 
   693                 execFdArray at:1 put:execFd.
 
   695 	    ].
 
   694             ].
 
   696 	].
 
   695         ].
 
   697     ].
 
   696     ].
 
   698 
   697 
   699     errorDisposition == #discard ifTrue:[
 
   698     errorDisposition == #discard ifTrue:[
 
   700 	nullOutput := Filename nullDevice writeStream.
 
   699         nullOutput := Filename nullDevice writeStream.
 
   701 	execFdArray at:3 put:nullOutput fileDescriptor
 
   700         execFdArray at:3 put:nullOutput fileDescriptor
 
   702     ] ifFalse:[
 
   701     ] ifFalse:[
 
   703 	(errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
 
   702         (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
 
   704 	    execFdArray at:3 put:1
 
   703             execFdArray at:3 put:1
 
   705 	] ifFalse:[
 
   704         ] ifFalse:[
 
   706 "/            errorDisposition isStream ifTrue:[
 
   705 "/            errorDisposition isStream ifTrue:[
 
   707 "/self halt.
 
   706 "/self halt.
 
   708 "/            ].
 
   707 "/            ].
 
   709 	].
 
   708         ].
 
   710     ].
 
   709     ].
 
   711 
   710 
   712     "/ must block here, to avoid races due to early finishing
 
   711     "/ must block here, to avoid races due to early finishing
 
   713     "/ subprocesses ...
 
   712     "/ subprocesses ...
 
   714 
   713 
   715     blocked := OperatingSystem blockInterrupts.
 
   714     blocked := OperatingSystem blockInterrupts.
 
   716 
   715 
   717     "beware: pid may change if subprocess is fast"
 
   716     "beware: pid may change if subprocess is fast"
 
   718     pid := resultPid :=  Processor
 
   717     pid := resultPid :=  Processor
 
   719 	       monitor:[
 
   718                monitor:[
 
   720 		  OperatingSystem
 
   719                   OperatingSystem
 
   721 		      exec:shellPath
 
   720                       exec:shellPath
 
   722 		      withArguments:shellArgs
 
   721                       withArguments:shellArgs
 
   723 		      environment:nil
 
   722                       environment:nil
 
   724 		      fileDescriptors:execFdArray
 
   723                       fileDescriptors:execFdArray
 
   725 		      fork:true
 
   724                       fork:true
 
   726 		      newPgrp:true
 
   725                       newPgrp:true
 
   727 		      inDirectory:execDirectory.
 
   726                       inDirectory:execDirectory.
 
   728 	       ]
 
   727                ]
 
   729 	       action:[:status |
 
   728                action:[:status |
 
   730 		  status stillAlive ifFalse:[
 
   729                   status stillAlive ifFalse:[
 
   731 		      exitStatus := status.
 
   730                       exitStatus := status.
 
   732 
   731 
   733 		      "writing doesn't make sense - there is no reader any longer"
 
   732                       "writing doesn't make sense - there is no reader any longer"
 
   734 		      mode == #readwrite ifTrue:[
 
   733                       mode == #readwrite ifTrue:[
 
   735 			  "... but allow to read the rest of the command's output"
 
   734                           "... but allow to read the rest of the command's output"
 
   736 			  self shutDownOutput.
 
   735                           self shutDownOutput.
 
   737 		      ] ifFalse:[mode == #writeonly ifTrue:[
 
   736                       ] ifFalse:[mode == #writeonly ifTrue:[
 
   738 			  self closeFileDescriptor.
 
   737                           self closeFileDescriptor.
 
   739 		      ]].
 
   738                       ]].
 
   740 
   739 
   741 		      OperatingSystem closePid:pid.
 
   740                       OperatingSystem closePid:pid.
 
   742 		      pid := nil.
 
   741                       pid := nil.
 
   743 		      exitSema signal.
 
   742                       exitSema signal.
 
   744 		  ].
 
   743                   ].
 
   745 	       ].
 
   744                ].
 
   746 
   745 
   747     "subprocess has been created.
 
   746     "subprocess has been created.
 
   748      close unused filedescriptors"
 
   747      close unused filedescriptors"
 
   749 
   748 
   750     execFd notNil ifTrue:[
 
   749     execFd notNil ifTrue:[
 
   751 	OperatingSystem closeFd:execFd.
 
   750         OperatingSystem closeFd:execFd.
 
   752     ].
 
   751     ].
 
   753 
   752 
   754     nullOutput notNil ifTrue:[
 
   753     nullOutput notNil ifTrue:[
 
   755 	nullOutput close
 
   754         nullOutput close
 
   756     ].
 
   755     ].
 
   757 
   756 
   758     resultPid notNil ifTrue:[
 
   757     resultPid notNil ifTrue:[
 
   759 	"successfull creation of subprocesss"
 
   758         "successfull creation of subprocesss"
 
   760 	OperatingSystem isVMSlike ifTrue:[
 
   759         OperatingSystem isVMSlike ifTrue:[
 
   761 	    "/
 
   760             "/
 
   762 	    "/ reopen the mailbox as a file ...
 
   761             "/ reopen the mailbox as a file ...
 
   763 	    "/
 
   762             "/
 
   764 	    mbxName := OperatingSystem mailBoxNameOf:mbx.
 
   763             mbxName := OperatingSystem mailBoxNameOf:mbx.
 
   765 	    mbxName notNil ifTrue:[
 
   764             mbxName notNil ifTrue:[
 
   766 		super open:mbxName withMode:rwMode.
 
   765                 super open:mbxName withMode:rwMode.
 
   767 		exitAction := [tmpComFile delete].
 
   766                 exitAction := [tmpComFile delete].
 
   768 	    ].
 
   767             ].
 
   769 	] ifFalse:[
 
   768         ] ifFalse:[
 
   770 	    self setFileDescriptor:myFd mode:rwMode.
 
   769             self setFileDescriptor:myFd mode:rwMode.
 
   771 	    handleType := #pipeFilePointer.
 
   770             handleType := #pipeFilePointer.
 
   772 	]
 
   771         ]
 
   773     ] ifFalse:[
 
   772     ] ifFalse:[
 
   774 	"creation of subprocesss failed"
 
   773         "creation of subprocesss failed"
 
   775 	lastErrorNumber := OperatingSystem currentErrorNumber.
 
   774         lastErrorNumber := OperatingSystem currentErrorNumber.
 
   776 	OperatingSystem isVMSlike ifTrue:[
 
   775         OperatingSystem isVMSlike ifTrue:[
 
   777 	    OperatingSystem destroyMailBox:mbx.
 
   776             OperatingSystem destroyMailBox:mbx.
 
   778 	    tmpComFile delete.
 
   777             tmpComFile delete.
 
   779 	] ifFalse:[
 
   778         ] ifFalse:[
 
   780 	    OperatingSystem closeFd:myFd.
 
   779             OperatingSystem closeFd:myFd.
 
   781 	].
 
   780         ].
 
   782     ].
 
   781     ].
 
   783 
   782 
   784     blocked ifFalse:[
 
   783     blocked ifFalse:[
 
   785 	OperatingSystem unblockInterrupts
 
   784         OperatingSystem unblockInterrupts
 
   786     ].
 
   785     ].
 
   787 
   786 
   788     (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
 
   787     (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
 
   789 	"
 
   788         "
 
   790 	 the pipe open failed for some reason ...
 
   789          the pipe open failed for some reason ...
 
   791 	 ... this may be either due to an invalid command string,
 
   790          ... this may be either due to an invalid command string,
 
   792 	 or due to the system running out of memory (when forking
 
   791          or due to the system running out of memory (when forking
 
   793 	 the unix process)
 
   792          the unix process)
 
   794 	"
 
   793         "
 
   795 	exitAction value.
 
   794         exitAction value.
 
   796 	^ self openError:lastErrorNumber.
 
   795         ^ self openError:lastErrorNumber.
 
   797     ].
 
   796     ].
 
   798 
   797 
   799     commandString := realCmd.
 
   798     commandString := realCmd.
 
   800 
   799 
   801     "stdio lib does not work with blocking pipes and interrupts
 
   800     "stdio lib does not work with blocking pipes and interrupts
 
   802      for WIN, Linux, Solaris and probably any other UNIX"
 
   801      for WIN, Linux, Solaris and probably any other UNIX"
 
   803     buffered := false.
 
   802     buffered := false.
 
   804     position := 0.
 
   803     position := 0.
 
   805     hitEOF := false.
 
   804     hitEOF := false.
 
   806     binary := false.
 
   805     binary := false.
 
   807     Lobby register:self.
 
   806     self registerForFinalization.
 
   808 
   807 
   809     "Modified: / 23.4.1996 / 17:05:59 / stefan"
 
   808     "Modified: / 23.4.1996 / 17:05:59 / stefan"
 
   810     "Modified: / 28.1.1998 / 14:47:34 / md"
 
   809     "Modified: / 28.1.1998 / 14:47:34 / md"
 
   811     "Created: / 19.5.1999 / 12:28:54 / cg"
 
   810     "Created: / 19.5.1999 / 12:28:54 / cg"
 
   812 !
 
   811 !
hg/stx-libbasic