"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libbasic' }"

NonPositionableExternalStream subclass:#PipeStream
	instanceVariableNames:'commandString pid exitStatus exitSema exitAction'
	classVariableNames:'BrokenPipeSignal'
	poolDictionaries:''
	category:'Streams-External'
!

!PipeStream primitiveDefinitions!
%{

#if defined(WIN32)
# undef UNIX_LIKE
# define MSDOS_LIKE
#endif

#include <stdio.h>
#define _STDIO_H_INCLUDED_

#include <errno.h>
#define _ERRNO_H_INCLUDED_

#ifndef transputer
# include <sys/types.h>
# include <sys/stat.h>
#endif

/*
 * on some systems errno is a macro ... check for it here
 */
#ifndef errno
 extern errno;
#endif

#ifdef LINUX
# define BUGGY_STDIO_LIB
#endif

%}
! !

!PipeStream primitiveFunctions!
%{

/*
 * no longer needed - popen is useless ...
 */
#undef NEED_POPEN_WITH_VFORK

/*
 * some systems (i.e. ultrix) use fork;
 * were better off with a popen based on vfork ...
 */
#ifdef NEED_POPEN_WITH_VFORK

static int popen_pid = 0;

FILE *
popen(command, type)
/* const */ char *command;
/* const */ char *type;
{
    int pipes[2];
    int itype = (strcmp(type, "w") == 0 ? 1 : 0);

    if (pipe(pipes) == -1)
	return NULL;

    switch (popen_pid = vfork()) {
    case -1:
	(void)close(pipes[0]);
	(void)close(pipes[1]);
	return NULL;

    case 0:
	if (itype) {
	    dup2(pipes[0], fileno(stdin));
	    close(pipes[1]);
	} else {
	    dup2(pipes[1], fileno(stdout));
	    close(pipes[0]);
	}
	execl("/bin/sh", "/bin/sh", "-c", command, 0);
	console_fprintf(stderr, "PipeStream [warning]: execlp failed in popen\n");
	_exit(-1);
	/* NOTREACHED */

    default:
	    if (itype) {
		close(pipes[0]);
		return fdopen(pipes[1], "w");
	    } else {
		close(pipes[1]);
		return fdopen(pipes[0], "r");
	    }
    }
}

int
pclose(str)
FILE *str;
{
    int pd = 0;
    int status;
    int err;

    err = fclose(str);

    do {
	if ((pd = wait(&status)) == -1)
	{
		err = EOF;
		break;
	}
    } while (pd !=  popen_pid);

    if (err == EOF)
	return  -1;

    if (status)
	status >>= 8;   /* exit status in high byte */

    return status;
}

#endif /* NEED_POPEN_WITH_VFORK */

%}
! !

!PipeStream class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    Pipestreams allow reading or writing from/to a unix command.
    For example, to get a stream reading the output of an 'ls -l'
    command, a PipeStream can be created with:

	PipeStream readingFrom:'ls -l'

    the characters of the commands output can be read using the
    standard stream messages as next, nextLine etc.

    Example for writing to a command:

	PipeStream writingTo:'cat >/tmp/x'

    Bidirectional pipestreams (supporting both reading an writing) may be used for filters:

	PipeStream bidirectionalFor:'sed -e ''s/Hello/Greetings/'''

    Buffered pipes do not work with Linux - the stdio library seems to be
    buggy (trying to restart the read ...)

    [author:]
	Claus Gittinger

    [see also:]
	ExternalStream FileStream Socket
	OperatingSystem
"
! !

!PipeStream class methodsFor:'initialization'!

initialize
    "setup the signal"

    BrokenPipeSignal isNil ifTrue:[
	BrokenPipeSignal := WriteError newSignalMayProceed:true.
	BrokenPipeSignal nameClass:self message:#brokenPipeSignal.
	BrokenPipeSignal notifierString:'write on a pipe with no one to read'.
    ]
! !

!PipeStream class methodsFor:'instance creation'!

bidirectionalFor:commandString
    "create and return a new bidirectonal pipeStream which can both be written to
     and read from the unix command given by commandString.
     The commands error output is send to my own error output."

    ^ self
	bidirectionalFor:commandString
	errorDisposition:#stderr
	inDirectory:nil

    "
	|p|

	p := PipeStream bidirectionalFor:'cat -u'.
	p nextPutAll:'Wer ist der Bürgermeister von Wesel'; cr.
	Transcript showCR:p nextLine.
	p close
    "

    "
	|p|

	p := PipeStream bidirectionalFor:'sed -e ''s/Hello/Greetings/'''.
	p nextPutAll:'Hello world'; cr.
	p shutDownOutput.
	Transcript showCR:p nextLine.
	p close
    "

    "
	|p|

	p := PipeStream bidirectionalFor:'wc'.
	p nextPutAll:'Hello world'; cr.
	p shutDownOutput.
	Transcript showCR:p nextLine.
	p close
    "
!

bidirectionalFor:commandString errorDisposition:errorDisposition inDirectory:aDirectory
    "create and return a new bidirectonal pipeStream which can both be written to
     and read from the unix command given by commandString.
     The directory will be changed to aDirectory while
     executing the command. Use this if a command is to be
     executed in another directory, to avoid any OS dependencies
     in your code.

     errorDisposition may be one of #discard, #inline or #stderr (default).
     #discard causes stderr to be discarded (/dev/null),
     #inline causes it to be written to smalltalks own stdout and
     #stderr causes it to be written to smalltalks own stderr.
     Nil is treated like #stderr"

    ^ self basicNew
	openPipeFor:commandString
	withMode:#'r+'
	errorDisposition:errorDisposition
	inDirectory:aDirectory
!

readingFrom:commandString
    "create and return a new pipeStream which can read from the unix command
     given by commandString.
     The commands error output is send to my own error output."

    ^ self
	readingFrom:commandString
	errorDisposition:#stderr
	inDirectory:nil

    "unix:
	PipeStream readingFrom:'ls -l'.
    "

    "
	|p|

	p := PipeStream readingFrom:'ls -l'.
	Transcript showCR:p nextLine.
	p close
    "

    "
	|s|
	s := PipeStream readingFrom:'sh -c sleep\ 600'.
	(Delay forSeconds:2) wait.
	s shutDown
    "

    "vms:
	PipeStream readingFrom:'dir'.
    "

    "
	|p|
	p := PipeStream readingFrom:'dir'.
	Transcript showCR:p nextLine.
	p close
    "

    "msdos:
	PipeStream readingFrom:'dir'.
    "
    "
	|p|
	p := PipeStream readingFrom:'dir'.
	Transcript showCR:p nextLine.
	p close
    "

    "Modified: 24.4.1996 / 09:09:25 / stefan"
!

readingFrom:commandString errorDisposition:errorDisposition inDirectory:aDirectory
    "similar to #readingFrom, but changes the directory while
     executing the command. Use this if a command is to be
     executed in another directory, to avoid any OS dependencies
     in your code.
     errorDisposition may be one of #discard, #inline or #stderr (default).
     #discard causes stderr to be discarded (/dev/null),
     #inline causes it to be merged into the PipeStream and
     #stderr causes it to be written to smalltalks own stderr.
     Nil is treated like #stderr"

    ^ self basicNew
	openPipeFor:commandString
	withMode:#r
	errorDisposition:errorDisposition
	inDirectory:aDirectory
!

readingFrom:commandString inDirectory:aDirectory
    "similar to #readingFrom, but changes the directory while
     executing the command. Use this if a command is to be
     executed in another directory, to avoid any OS dependencies
     in your code.
     The commands error output is send to my own error output."

     ^ self
	readingFrom:commandString
	errorDisposition:#stderr
	inDirectory:aDirectory

    " UNIX:
	|p|

	p := PipeStream readingFrom:'ls -l' inDirectory:'/etc'.
	Transcript showCR:p upToEnd.
	p close
    "
    "WINDOOF:
	|p|

	p := PipeStream readingFrom:'dir'.
	Transcript showCR:p upToEnd.
	p close
   "
!

writingTo:commandString
    "create and return a new pipeStream which can write to the unix command
     given by command."

    ^ self
	writingTo:commandString errorDisposition:#stderr inDirectory:nil

    "unix:
	 PipeStream writingTo:'sort'
    "
!

writingTo:commandString errorDisposition:errorDisposition inDirectory:aDirectory
    "similar to #writingTo, but changes the directory while
     executing the command. Use this if a command is to be
     executed in another directory, to avoid any OS dependencies
     in your code.
     errorDisposition may be one of #discard, #inline or #stderr (default).
     #discard causes stderr to be discarded (/dev/null),
     #inline causes it to be written to smalltalks own stdout and
     #stderr causes it to be written to smalltalks own stderr.
     Nil is treated like #stderr"

    ^ self basicNew
	openPipeFor:commandString
	withMode:#w
	errorDisposition:errorDisposition
	inDirectory:aDirectory
!

writingTo:commandString inDirectory:aDirectory
    "create and return a new pipeStream which can write to the unix command
     given by commandString. The command is executed in the given directory."

    ^ self
	writingTo:commandString errorDisposition:#stderr inDirectory:aDirectory

    "unix:
	 PipeStream writingTo:'sort'
    "
! !

!PipeStream class methodsFor:'Signal constants'!

brokenPipeSignal
    "return the signal used to handle SIGPIPE unix-signals.
     Since SIGPIPE is asynchronous, we can't decide which smalltalk process
     should handle BrokenPipeSignal. So the system doesn't raise
     BrokenPipeSignal for SIGPIPE any longer."

    ^ BrokenPipeSignal

    "Modified: 24.9.1997 / 09:43:23 / stefan"
! !

!PipeStream methodsFor:'accessing'!

commandString
    "return the command string"

    ^ commandString
!

exitStatus
    "return the exitStatus"

    ^ exitStatus

    "Created: 28.12.1995 / 14:54:41 / stefan"
!

pid
    "return pid"

    ^ pid

    "Created: 28.12.1995 / 14:54:30 / stefan"
! !

!PipeStream methodsFor:'closing'!

shutDown
    "close the Stream and terminate the command"

    Lobby unregister:self.

    "terminate first under windows"
    OperatingSystem isMSDOSlike ifTrue:[
	self terminatePipeCommand.
	self closeFileDescriptor.
	^ self.
    ].

    "terminate last under unix"
    self closeFileDescriptor.
    self terminatePipeCommand.
!

shutDownOutput
    "signal to the pipestream's command, that no more data will be sent"

    |fd|

    self isOpen ifTrue:[
	fd := self fileDescriptor.
	fd notNil ifTrue:[
	    OperatingSystem shutdownBidirectionalPipeOutput:fd.
	].
    ].
! !

!PipeStream methodsFor:'finalization'!

finalize
    "redefined to avoid blocking in close."

    self shutDown
! !

!PipeStream protectedMethodsFor:'private'!

closeFile
    "low level close
     This waits for the command to finish.
     Use shutDown for a fast (nonBlocking) close."

    handle notNil ifTrue:[
	super closeFile.
	OperatingSystem isMSDOSlike ifTrue:[
	    self terminatePipeCommand.
	].

	handle := nil.
	pid notNil ifTrue:[
	    "/ wait for the pipe-command to terminate.
	    self waitForPipeCommandWithTimeout:nil.
	].
    ].

    "Modified: / 12.9.1998 / 16:51:04 / cg"
! !

!PipeStream methodsFor:'private'!

closeFileDescriptor
    "alternative very low level close
     This closes the underlying OS-fileDescriptor
     - and will NOT write any buffered data to the stream.
     You have been warned."

    |action|

%{
#if !defined(transputer)
    OBJ fp;
    FILE *f;
    extern close();
    int retVal;

    if ((fp = __INST(handle)) != nil) {
        __INST(handle) = nil;
        f = __FILEVal(fp);
        if (@global(FileOpenTrace) == true) {
            console_fprintf(stderr, "close [PipeStream] %x fd=%d\n", f, fileno(f));
        }
#ifdef WIN32
        do {
            __threadErrno = 0;
            retVal = __STX_C_NOINT_CALL1( "close", (void*)close, (void*)fileno(f) );
        } while ((retVal < 0) && (__threadErrno == EINTR));
#else
        __BEGIN_INTERRUPTABLE__
        close(fileno(f));
        __END_INTERRUPTABLE__
#endif
    }
#endif /* not transputer  */
%}.
    exitAction notNil ifTrue:[
        action := exitAction.
        exitAction := nil.
        action value.
    ]
!

exitAction:aBlock
    "define a block to be evaluated when the pipe is closed.
     This is only used with VMS, to remove any temporary COM file.
     (see readingFrom:inDirectory:)"

    exitAction := aBlock
!

openPipeFor:aCommandString withMode:rwMode errorDisposition:errorDisposition inDirectory:aDirectory
    "open a pipe to the OS command in commandString;
     rwMode may be 'r' or 'w' or 'r+'.
     errorDisposition controls where the stdErr output should go,
     and may be one of #discard, #inline or #stderr (default).
     #discard causes stderr to be discarded (/dev/null),
     #inline causes it to be written to smalltalks own stdout and
     #stderr causes it to be written to smalltalks own stderr.
     Nil is treated like #stderr"

    |blocked pipeFdArray execFdArray execFd myFd shellAndArgs
     shellPath shellArgs mbx mbxName
     realCmd execDirectory tmpComFile nullOutput resultPid errorNumber|

    handle notNil ifTrue:[
        "the pipe was already open ...
         this should (can) not happen."
        ^ self errorAlreadyOpen
    ].

    rwMode = #r ifTrue:[
        mode := #readonly. didWrite := false.
    ] ifFalse:[rwMode = #'r+' ifTrue:[
        mode := #readwrite. didWrite := true.
    ] ifFalse:[
        mode := #writeonly. didWrite := true.
    ]].

    lastErrorNumber := nil.
    exitStatus := nil.
    exitSema := Semaphore new name:'pipe exitSema'.

    realCmd := aCommandString.
    execDirectory := aDirectory.
    execFdArray := #(0 1 2) copy.

    OperatingSystem isVMSlike ifTrue:[
        "/
        "/ the generated COM-file includes a 'set default'
        "/
        tmpComFile := OperatingSystem createCOMFileForVMSCommand:aCommandString in:aDirectory.
        realCmd := '@' , tmpComFile osName.
        execDirectory := nil.

        mbx := OperatingSystem createMailBox.
        mbx isNil ifTrue:[
            lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
            tmpComFile delete.
            ^ self openError:errorNumber.
        ].
        mbxName := OperatingSystem mailBoxNameOf:mbx.

        "/ 'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
        shellPath := ''.
        shellArgs := realCmd.

        rwMode = #r ifTrue:[
            "redirect stdout of subprocess to write to mailbox"
            execFdArray at:2 put:mbx.
        ] ifFalse:[
            "redirect stdin of subprocess to read from mailbox"
            execFdArray at:1 put:mbx.
        ].
    ] ifFalse:[
        shellAndArgs := OperatingSystem commandAndArgsForOSCommand:realCmd.
        shellPath := shellAndArgs at:1.
        shellArgs := shellAndArgs at:2.

        mode == #readwrite ifTrue:[
            pipeFdArray := OperatingSystem makeBidirectionalPipe.
            pipeFdArray isNil ifTrue:[
                lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
                ^ self openError:errorNumber.
            ].
            myFd := pipeFdArray at:1.
            execFd := pipeFdArray at:2.
            execFdArray at:1 put:execFd.
            execFdArray at:2 put:execFd.
        ] ifFalse:[
            pipeFdArray := OperatingSystem makePipe.
            pipeFdArray isNil ifTrue:[
                lastErrorNumber := errorNumber := OperatingSystem currentErrorNumber.
                ^ self openError:errorNumber.
            ].

            mode == #readonly ifTrue:[
                "redirect stdout of subprocess to write to pipe"
                myFd := pipeFdArray at:1.
                execFd := pipeFdArray at:2.
                execFdArray at:2 put:execFd.
            ] ifFalse:[
                "redirect stdin of subprocess to read from pipe"
                myFd := pipeFdArray at:2.
                execFd := pipeFdArray at:1.
                execFdArray at:1 put:execFd.
            ].
        ].
    ].

    errorDisposition == #discard ifTrue:[
        nullOutput := Filename nullDevice writeStream.
        execFdArray at:3 put:nullOutput fileDescriptor
    ] ifFalse:[
        (errorDisposition == #inline or:[errorDisposition == #stdout]) ifTrue:[
            execFdArray at:3 put:1
        ] ifFalse:[
"/            errorDisposition isStream ifTrue:[
"/self halt.
"/            ].
        ].
    ].

    "/ must block here, to avoid races due to early finishing
    "/ subprocesses ...

    blocked := OperatingSystem blockInterrupts.

    "beware: pid may change if subprocess is fast"
    pid := resultPid :=  Processor
               monitor:[
                  OperatingSystem
                      exec:shellPath
                      withArguments:shellArgs
                      environment:nil
                      fileDescriptors:execFdArray
                      fork:true
                      newPgrp:true
                      inDirectory:execDirectory.
               ]
               action:[:status |
                  status stillAlive ifFalse:[
                      exitStatus := status.

                      "writing doesn't make sense - there is no reader any longer"
                      mode == #readwrite ifTrue:[
                          "... but allow to read the rest of the command's output"
                          self shutDownOutput.
                      ] ifFalse:[mode == #writeonly ifTrue:[
                          self closeFileDescriptor.
                      ]].

                      OperatingSystem closePid:pid.
                      pid := nil.
                      exitSema signal.
                  ].
               ].

    "subprocess has been created.
     close unused filedescriptors"

    execFd notNil ifTrue:[
        OperatingSystem closeFd:execFd.
    ].

    nullOutput notNil ifTrue:[
        nullOutput close
    ].

    resultPid notNil ifTrue:[
        "successfull creation of subprocesss"
        OperatingSystem isVMSlike ifTrue:[
            "/
            "/ reopen the mailbox as a file ...
            "/
            mbxName := OperatingSystem mailBoxNameOf:mbx.
            mbxName notNil ifTrue:[
                super open:mbxName withMode:rwMode.
                exitAction := [tmpComFile delete].
            ].
        ] ifFalse:[
            self setFileDescriptor:myFd mode:rwMode.
            handleType := #pipeFilePointer.
        ]
    ] ifFalse:[
        "creation of subprocesss failed"
        lastErrorNumber := OperatingSystem currentErrorNumber.
        OperatingSystem isVMSlike ifTrue:[
            OperatingSystem destroyMailBox:mbx.
            tmpComFile delete.
        ] ifFalse:[
            OperatingSystem closeFd:myFd.
        ].
    ].

    blocked ifFalse:[
        OperatingSystem unblockInterrupts
    ].

    (resultPid isNil or:[lastErrorNumber notNil]) ifTrue:[
        "
         the pipe open failed for some reason ...
         ... this may be either due to an invalid command string,
         or due to the system running out of memory (when forking
         the unix process)
        "
        exitAction value.
        ^ self openError:lastErrorNumber.
    ].

    commandString := realCmd.

    "stdio lib does not work with blocking pipes and interrupts
     for WIN, Linux, Solaris and probably any other UNIX"
    buffered := false.
    position := 0.
    hitEOF := false.
    binary := false.
    Lobby register:self.

    "Modified: / 23.4.1996 / 17:05:59 / stefan"
    "Modified: / 28.1.1998 / 14:47:34 / md"
    "Created: / 19.5.1999 / 12:28:54 / cg"
!

terminatePipeCommand
    |tpid|

    (tpid := pid) notNil ifTrue:[
	OperatingSystem terminateProcessGroup:tpid.
	OperatingSystem terminateProcess:tpid.
	OperatingSystem closePid:tpid.
	pid := nil.
    ].
!

waitForPipeCommandWithTimeout:seconds
    "wait for the pipe command to terminate itself.
     Return true, if a timeout occurred."

    pid notNil ifTrue:[
	[
	    pid notNil ifTrue:[
		exitSema waitWithTimeout:seconds.
	    ]
	] valueUninterruptably
    ].
    ^ pid notNil
! !

!PipeStream class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.113 2013-06-03 18:40:56 cg Exp $'
!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.113 2013-06-03 18:40:56 cg Exp $'
! !


PipeStream initialize!