PipeStr.st
changeset 4616 64dd3a9bebf5
parent 4526 a42dc8e09586
equal deleted inserted replaced
4615:e480d1e6090f 4616:64dd3a9bebf5
    18 !
    18 !
    19 
    19 
    20 !PipeStream primitiveDefinitions!
    20 !PipeStream primitiveDefinitions!
    21 %{
    21 %{
    22 
    22 
    23 #if defined(NT) || defined(WIN32) || defined(MSDOS)
    23 #if defined(WIN32)
    24 # undef UNIX_LIKE
    24 # undef UNIX_LIKE
    25 # define MSDOS_LIKE
    25 # define MSDOS_LIKE
    26 #endif
    26 #endif
    27 
    27 
    28 #include <stdio.h>
    28 #include <stdio.h>
   424 
   424 
   425 %{  
   425 %{  
   426 #if !defined(transputer)
   426 #if !defined(transputer)
   427     OBJ fp;
   427     OBJ fp;
   428     FILE *f;
   428     FILE *f;
       
   429     extern close();
   429 
   430 
   430     if ((fp = __INST(filePointer)) != nil) {
   431     if ((fp = __INST(filePointer)) != nil) {
   431 	__INST(filePointer) = nil;
   432 	__INST(filePointer) = nil;
   432 	f = __FILEVal(fp);
   433 	f = __FILEVal(fp);
   433 #ifdef WIN32
   434 #ifdef WIN32
   434 	close(fileno(f));
   435 	__STX_C_CALL1((void*)close, (void*)fileno(f));
   435 #else
   436 #else
   436 	__BEGIN_INTERRUPTABLE__
   437 	__BEGIN_INTERRUPTABLE__
   437 	close(fileno(f));
   438 	close(fileno(f));
   438 	__END_INTERRUPTABLE__
   439 	__END_INTERRUPTABLE__
   439 #endif
   440 #endif
   507     |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
   508     |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
   508      shellPath shellArgs closeFdArray mbx mbxName 
   509      shellPath shellArgs closeFdArray mbx mbxName 
   509      realCmd execDirectory tmpComFile nullOutput|
   510      realCmd execDirectory tmpComFile nullOutput|
   510 
   511 
   511     filePointer notNil ifTrue:[
   512     filePointer notNil ifTrue:[
   512         "the pipe was already open ...
   513 	"the pipe was already open ...
   513          this should (can) not happen."
   514 	 this should (can) not happen."
   514         ^ self errorAlreadyOpen
   515 	^ self errorAlreadyOpen
   515     ].
   516     ].
   516 
   517 
   517     rwMode = 'r' ifTrue:[
   518     rwMode = 'r' ifTrue:[
   518         mode := #readonly. didWrite := false.
   519 	mode := #readonly. didWrite := false.
   519     ] ifFalse:[
   520     ] ifFalse:[
   520         mode := #writeonly. didWrite := true.
   521 	mode := #writeonly. didWrite := true.
   521     ].
   522     ].
   522 
   523 
   523     lastErrorNumber := nil.
   524     lastErrorNumber := nil.
   524     exitStatus := nil.
   525     exitStatus := nil.
   525     exitSema := Semaphore new name:'pipe exitSema'.
   526     exitSema := Semaphore new name:'pipe exitSema'.
   526 
   527 
   527     realCmd := aCommandString.
   528     realCmd := aCommandString.
   528     execDirectory := aDirectory.
   529     execDirectory := aDirectory.
   529 
   530 
   530     OperatingSystem isVMSlike ifTrue:[
   531     OperatingSystem isVMSlike ifTrue:[
   531         "/ the generated COM-file includes a 'set default'
   532 	"/
   532         tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
   533 	"/ the generated COM-file includes a 'set default'
   533         realCmd := '@' , tmpComFile osName.
   534 	"/
   534         execDirectory := nil.
   535 	tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
   535 
   536 	realCmd := '@' , tmpComFile osName.
   536         mbx := OperatingSystem createMailBox.
   537 	execDirectory := nil.
   537         mbx isNil ifTrue:[
   538 
   538             lastErrorNumber := OperatingSystem currentErrorNumber.
   539 	mbx := OperatingSystem createMailBox.
   539             tmpComFile delete.
   540 	mbx isNil ifTrue:[
   540             ^ self openError
   541 	    lastErrorNumber := OperatingSystem currentErrorNumber.
   541         ].
   542 	    tmpComFile delete.
   542         mbxName := OperatingSystem mailBoxNameOf:mbx.
   543 	    ^ self openError
   543         "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
   544 	].
   544         shellPath := ''.
   545 	mbxName := OperatingSystem mailBoxNameOf:mbx.
   545         shellArgs := realCmd.
   546 
   546 
   547 	"/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
   547         rwMode = 'r' ifTrue:[
   548 	shellPath := ''.
   548             execFdArray := Array with:0 with:mbx with:2.
   549 	shellArgs := realCmd.
   549             (err == #inline or:[err == #stdout]) ifTrue:[
   550 
   550                 execFdArray at:3 put:mbx
   551 	rwMode = 'r' ifTrue:[
   551             ]
   552 	    execFdArray := Array with:0 with:mbx with:2.
   552         ] ifFalse:[
   553 	    (err == #inline or:[err == #stdout]) ifTrue:[
   553             execFdArray := Array with:mbx with:1 with:2.
   554 		execFdArray at:3 put:mbx
   554             (err == #inline or:[err == #stdout]) ifTrue:[
   555 	    ]
   555                 execFdArray at:3 put:1
   556 	] ifFalse:[
   556             ]
   557 	    execFdArray := Array with:mbx with:1 with:2.
   557         ].
   558 	    (err == #inline or:[err == #stdout]) ifTrue:[
   558         closeFdArray := nil.
   559 		execFdArray at:3 put:1
       
   560 	    ]
       
   561 	].
       
   562 	closeFdArray := nil.
   559     ] ifFalse:[
   563     ] ifFalse:[
   560         OperatingSystem isUNIXlike ifTrue:[
   564 	OperatingSystem isUNIXlike ifTrue:[
   561             aDirectory notNil ifTrue:[
   565 	    aDirectory notNil ifTrue:[
   562                 "/ unix - prepend a 'cd' to the command
   566 		"/ unix - prepend a 'cd' to the command
   563                 realCmd := 'cd ' , aDirectory asFilename name, '; ' , aCommandString.
   567 		realCmd := 'cd ' , aDirectory asFilename name, '; ' , aCommandString.
   564             ] ifFalse:[
   568 	    ] ifFalse:[
   565                 realCmd := aCommandString
   569 		realCmd := aCommandString
   566             ].
   570 	    ].
   567             execDirectory := nil.
   571 	    execDirectory := nil.
   568         ].
   572 	].
   569 
   573 
   570         pipeFdArray := OperatingSystem makePipe.
   574 	pipeFdArray := OperatingSystem makePipe.
   571         pipeFdArray isNil ifTrue:[
   575 	pipeFdArray isNil ifTrue:[
   572             lastErrorNumber := OperatingSystem currentErrorNumber.
   576 	    lastErrorNumber := OperatingSystem currentErrorNumber.
   573             ^ self openError
   577 	    ^ self openError
   574         ].
   578 	].
   575 
   579 
   576         shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
   580 	shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
   577         shellPath := shellAndArgs at:1.
   581 	shellPath := shellAndArgs at:1.
   578         shellArgs := shellAndArgs at:2.
   582 	shellArgs := shellAndArgs at:2.
   579 
   583 
   580         rwMode = 'r' ifTrue:[
   584 	rwMode = 'r' ifTrue:[
   581             myFd := pipeFdArray at:1.
   585 	    myFd := pipeFdArray at:1.
   582             execFd := pipeFdArray at:2.
   586 	    execFd := pipeFdArray at:2.
   583             execFdArray := Array with:0 with:execFd with:2.
   587 	    execFdArray := Array with:0 with:execFd with:2.
   584             (err == #inline or:[err == #stdout]) ifTrue:[
   588 	    (err == #inline or:[err == #stdout]) ifTrue:[
   585                 execFdArray at:3 put:execFd
   589 		execFdArray at:3 put:execFd
   586             ]
   590 	    ]
   587         ] ifFalse:[
   591 	] ifFalse:[
   588             myFd := pipeFdArray at:2.
   592 	    myFd := pipeFdArray at:2.
   589             execFd := pipeFdArray at:1.
   593 	    execFd := pipeFdArray at:1.
   590             execFdArray := Array with:execFd with:1 with:2.
   594 	    execFdArray := Array with:execFd with:1 with:2.
   591             (err == #inline or:[err == #stdout]) ifTrue:[
   595 	    (err == #inline or:[err == #stdout]) ifTrue:[
   592                 execFdArray at:3 put:1
   596 		execFdArray at:3 put:1
   593             ]
   597 	    ]
   594         ].
   598 	].
   595         closeFdArray := Array with:myFd.
   599 	closeFdArray := Array with:myFd.
   596     ].
   600     ].
   597 
   601 
   598     err == #discard ifTrue:[
   602     err == #discard ifTrue:[
   599         nullOutput := Filename nullDevice writeStream.
   603 	nullOutput := Filename nullDevice writeStream.
   600         execFdArray at:3 put:nullOutput fileDescriptor
   604 	execFdArray at:3 put:nullOutput fileDescriptor
   601     ].
   605     ].
   602 
   606 
   603     "/ must block here, to avoid races due to early finishing
   607     "/ must block here, to avoid races due to early finishing
   604     "/ subprocesses ...
   608     "/ subprocesses ...
   605 
   609 
   606     blocked := OperatingSystem blockInterrupts.
   610     blocked := OperatingSystem blockInterrupts.
   607 
   611 
   608     pid := Processor 
   612     pid := Processor 
   609                monitor:[
   613 	       monitor:[
   610                   OperatingSystem 
   614 		  OperatingSystem 
   611                       exec:shellPath
   615 		      exec:shellPath
   612                       withArguments:shellArgs
   616 		      withArguments:shellArgs
   613                       fileDescriptors:execFdArray
   617 		      fileDescriptors:execFdArray
   614                       closeDescriptors:closeFdArray
   618 		      closeDescriptors:closeFdArray
   615                       fork:true
   619 		      fork:true
   616                       newPgrp:true
   620 		      newPgrp:true
   617                       inDirectory:execDirectory.
   621 		      inDirectory:execDirectory.
   618                ]
   622 	       ]
   619                action:[:status |
   623 	       action:[:status |
   620                   status stillAlive ifFalse:[
   624 		  status stillAlive ifFalse:[
   621                       exitStatus := status.
   625 		      exitStatus := status.
   622                       OperatingSystem closePid:pid.
   626 		      OperatingSystem closePid:pid.
   623                       pid := nil.
   627 		      pid := nil.
   624                       exitSema signal.
   628 		      exitSema signal.
   625                   ].
   629 		  ].
   626                ].
   630 	       ].
   627 
   631 
   628     OperatingSystem isVMSlike ifFalse:[
   632     OperatingSystem isVMSlike ifFalse:[
   629         OperatingSystem closeFd:execFd.
   633 	OperatingSystem closeFd:execFd.
   630     ].
   634     ].
   631 
   635 
   632     nullOutput notNil ifTrue:[
   636     nullOutput notNil ifTrue:[
   633         nullOutput closeFile
   637 	nullOutput closeFile
   634     ].
   638     ].
   635 
   639 
   636     pid notNil ifTrue:[
   640     pid notNil ifTrue:[
   637         OperatingSystem isVMSlike ifTrue:[
   641 	OperatingSystem isVMSlike ifTrue:[
   638             "/
   642 	    "/
   639             "/ reopen the mailbox as a file ...
   643 	    "/ reopen the mailbox as a file ...
   640             "/
   644 	    "/
   641             mbxName := OperatingSystem mailBoxNameOf:mbx.
   645 	    mbxName := OperatingSystem mailBoxNameOf:mbx.
   642             mbxName notNil ifTrue:[
   646 	    mbxName notNil ifTrue:[
   643                 super open:mbxName withMode:rwMode.
   647 		super open:mbxName withMode:rwMode.
   644                 exitAction := [tmpComFile delete].
   648 		exitAction := [tmpComFile delete].
   645             ].
   649 	    ].
   646         ] ifFalse:[
   650 	] ifFalse:[
   647             self setFileDescriptor:myFd mode:rwMode.
   651 	    self setFileDescriptor:myFd mode:rwMode.
   648         ]
   652 	]
   649     ] ifFalse:[
   653     ] ifFalse:[
   650         lastErrorNumber := OperatingSystem currentErrorNumber.
   654 	lastErrorNumber := OperatingSystem currentErrorNumber.
   651         OperatingSystem isVMSlike ifTrue:[
   655 	OperatingSystem isVMSlike ifTrue:[
   652             OperatingSystem destroyMailBox:mbx.
   656 	    OperatingSystem destroyMailBox:mbx.
   653             tmpComFile delete.
   657 	    tmpComFile delete.
   654         ] ifFalse:[
   658 	] ifFalse:[
   655             OperatingSystem closeFd:myFd.
   659 	    OperatingSystem closeFd:myFd.
   656         ].
   660 	].
   657     ].
   661     ].
   658 
   662 
   659     blocked ifFalse:[
   663     blocked ifFalse:[
   660         OperatingSystem unblockInterrupts
   664 	OperatingSystem unblockInterrupts
   661     ].
   665     ].
   662 
   666 
   663     lastErrorNumber notNil ifTrue:[
   667     lastErrorNumber notNil ifTrue:[
   664         "
   668 	"
   665          the pipe open failed for some reason ...
   669 	 the pipe open failed for some reason ...
   666          ... this may be either due to an invalid command string,
   670 	 ... this may be either due to an invalid command string,
   667          or due to the system running out of memory (when forking
   671 	 or due to the system running out of memory (when forking
   668          the unix process)
   672 	 the unix process)
   669         "
   673 	"
   670         exitAction value.
   674 	exitAction value.
   671         ^ self openError
   675 	^ self openError
   672     ].
   676     ].
   673 
   677 
   674     commandString := realCmd.
   678     commandString := realCmd.
   675 %{
   679 %{
   676     /* LINUX stdio is corrupt here ... */
   680     /* LINUX stdio is corrupt here ... */
   691 ! !
   695 ! !
   692 
   696 
   693 !PipeStream class methodsFor:'documentation'!
   697 !PipeStream class methodsFor:'documentation'!
   694 
   698 
   695 version
   699 version
   696     ^ '$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.79 1999-08-04 14:13:01 cg Exp $'
   700     ^ '$Header: /cvs/stx/stx/libbasic/Attic/PipeStr.st,v 1.80 1999-08-20 09:15:28 ps Exp $'
   697 ! !
   701 ! !
   698 PipeStream initialize!
   702 PipeStream initialize!