"
 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.
"

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

!PipeStream primitiveDefinitions!
%{

#if defined(NT) || defined(WIN32) || defined(MSDOS)
# undef UNIX_LIKE
# define MSDOS_LIKE
#endif

#if defined(__openVMS__)
# undef __new
#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);
	fprintf(stderr, "XRN Error: failed the execlp\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.

    If a writing pipeStream is written to, after the command has finished,
    UNIX will generate an error-signal (SIGPIPE), which will raise the BrokenPipeSignal. 
    Thus, to handle this condition correctly, the following code is suggested:

	|p|
	p := PipeStream writingTo:'echo hello'.
	PipeStream brokenPipeSignal handle:[:ex |
	    'broken pipe' printNewline.
	    p shutDown.
	    ex return
	] do:[
	    p nextPutLine:'oops'.
	   'after write' printNewline.
	    p close.
	   'after close' printNewline
	]

    Notice, that iff the Stream is buffered, the Signal may occur some time after
    the write - or even at close time; to avoid a recursive signal in the exception
    handler, a #shutDown is useful there; if you use close in the handler, this would
    try to send any buffered output to the pipe, leading to another brokenPipe exception.

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

    Currently, no filtering pipeStreams (i.e. both reading AND writing) are provided.
    However, if you look at how things are setup, this can be implemented using the
    low level primitives #mapePipe and #executeCommand from the OS class protocol.

    [author:]
	Claus Gittinger

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

!PipeStream class methodsFor:'initialization'!

initialize
    "setup the signal"

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

!PipeStream class methodsFor:'helpers'!

createCOMFileForVMSCommands:aCollectionOfCommandStrings
    "since DCL seems to not support multiple commands in one
     line, create a temporary COM file for them and let DCL
     execute that one. 
     A kludge around a poor CLI design."

    |tmpComFile s|

    tmpComFile := Filename newTemporary withSuffix:'COM'.
    s := tmpComFile writeStream.
    aCollectionOfCommandStrings do:[:aCommand |
	(aCommand startsWith:$$) ifFalse:[
	    s nextPutAll:'$'.
	].
	s nextPutAll:aCommand.
	s nextPut:(Character nl).
    ].
    s close.
    ^ tmpComFile.
!

createCOMFileForVMSCommand:aCommandString in:aDirectory
    "since DCL seems to not support multiple commands in one
     line, create a temporary COM file for a set def, followed
     by the actual command string.
     A kludge around a poor CLI design."

    ^ self
	createCOMFileForVMSCommands:(Array
					with:('set def ' , aDirectory asFilename pathName asFilename osNameForDirectory)
					with:aCommandString).
! !

!PipeStream class methodsFor:'instance creation'!

readingFrom:commandString
    "create and return a new pipeStream which can read from the unix command
     given by command."

    ^ (self basicNew) readingFrom:commandString

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

    "
	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 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."

    |cmd tmpComFile pipe|

    (OperatingSystem platformName == #vms) ifTrue:[
	tmpComFile := self createCOMFileForVMSCommand:commandString in:aDirectory.
	cmd := '@' , tmpComFile osName.
	pipe := self readingFrom:cmd.
	pipe notNil ifTrue:[
	    pipe exitAction:[tmpComFile delete].
	].
	^ pipe
    ].

    "/ unix - prepend a 'cd' to the command
    cmd := 'cd ' , aDirectory asFilename pathName, '; ' , commandString.
    ^ self readingFrom:cmd
!

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

    ^ (self basicNew) writingTo:commandString

    "unix:
	 PipeStream writingTo:'sort'
    "
!

writingTo:commandString 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."

    |cmd tmpComFile pipe|

    (OperatingSystem platformName == #vms) ifTrue:[
	tmpComFile := self createCOMFileForVMSCommand:commandString in:aDirectory.
	cmd := '@' , tmpComFile osName.
	pipe := self writingTo:cmd.
	pipe notNil ifTrue:[
	    pipe exitAction:[tmpComFile delete].
	].
	^ pipe
    ].

    "/ unix - prepend a 'cd' to the command
    cmd := 'cd ' , aDirectory asFilename pathName, '; ' , commandString.
    ^ self writingTo:cmd
! !

!PipeStream class methodsFor:'Signal constants'!

brokenPipeSignal
    "return the signal used to handle SIGPIPE unix-signals"

    ^ BrokenPipeSignal
! !

!PipeStream methodsFor:'accessing'!

commandString
    "return the command string"

    ^ commandString
!

exitStatus
    "return exitStatus"

    ^ exitStatus

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

pid
    "return pid"

    ^ pid

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

!PipeStream methodsFor:'instance release'!

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

    filePointer notNil ifTrue:[
	super closeFile.
	filePointer := nil.
	pid notNil ifTrue:[
	    [
		pid notNil ifTrue:[
		    exitSema wait.
		]
	    ] valueUninterruptably
	].
    ].
!

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) && !defined(MSDOS_LIKE)
    OBJ fp;
    FILE *f;

    if ((fp = __INST(filePointer)) != nil) {
	__INST(filePointer) = nil;
	f = __FILEVal(fp);
	__BEGIN_INTERRUPTABLE__
	close(fileno(f));
	__END_INTERRUPTABLE__
    }
#endif /* not transputer && not MSDOS_LIKE */
%}.
    exitAction notNil ifTrue:[
	action := exitAction.
	exitAction := nil.
	action value.
    ]
!

disposed
    "redefined to avoid blocking in close."

    self shutDown
!

shutDown
    "close the Stream, ignoring any broken-pipe errors.
     Terminate the command"

    BrokenPipeSignal catch:[
	|tpid|

	Lobby unregister:self.
	self closeFileDescriptor.
	tpid := pid.                    "copy pid to avoid race"
	tpid notNil ifTrue:[
	    "/
	    "/ Terminate both the process and group, just in case the
	    "/ operating system does not support process groups.
	    "/
	    OperatingSystem terminateProcess:tpid.
	    OperatingSystem terminateProcessGroup:tpid.
	    pid := nil.
	].

    ]

    "Modified: 23.5.1996 / 09:15:41 / stefan"
! !

!PipeStream methodsFor:'private'!

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:mode
    "open a pipe to the unix command in commandString; 
     mode may be 'r' or 'w'"

    |blocked pipeFdArray execFdArray execFd myFd 
     osType shellPath shellArgs closeFdArray mbx mbxName|

    filePointer notNil ifTrue:[
	"the pipe was already open ...
	 this should (can) not happen."
	^ self errorOpen
    ].
    lastErrorNumber := nil.
    exitStatus := nil.
    exitSema := Semaphore new name:'pipe exitSema'.

    osType := OperatingSystem platformName.
    osType == #vms ifTrue:[
	mbx := OperatingSystem createMailBox.
	mbx isNil ifTrue:[
	    lastErrorNumber := OperatingSystem currentErrorNumber.
	    ^ self openError
	].
	mbxName := OperatingSystem mailBoxNameOf:mbx.
'mailBox is ' print. mbx print. ' name is ' print. mbxName printCR.
	shellPath := ''.
	shellArgs := aCommandString.

	mode = 'r' ifTrue:[
	    execFdArray := Array with:0 with:mbx with:2.
	] ifFalse:[
	    execFdArray := Array with:mbx with:1 with:2.
	].
	closeFdArray := nil.
    ] ifFalse:[
	pipeFdArray := OperatingSystem makePipe.
	pipeFdArray isNil ifTrue:[
	    lastErrorNumber := OperatingSystem currentErrorNumber.
	    ^ self openError
	].

	osType == #unix ifTrue:[
	    shellPath := '/bin/sh'.
	    shellArgs := Array with:'sh' with:'-c' with:aCommandString.
	] ifFalse:[
	    osType == #win32 ifTrue:[
		shellPath := 'C:\WINNT\System32\cmd /c'.
		shellArgs := aCommandString.
	    ] ifFalse:[
		OperatingSystem closeFd:execFd; closeFd:myFd.
		"/
		"/ dont know how to do it ...
		"/
		^ self openError
	    ]
	].
	mode = 'r' ifTrue:[
	    execFd := pipeFdArray at:2.
	    execFdArray := Array with:0 with:execFd with:2.
	    myFd := pipeFdArray at:1.
	] ifFalse:[
	    execFd := pipeFdArray at:1.
	    execFdArray := Array with:execFd with:1 with:2.
	    myFd := pipeFdArray at:2.
	].
	closeFdArray := Array with:myFd.
    ].


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

    blocked := OperatingSystem blockInterrupts.

    pid := Processor 
	       monitor:[
		  OperatingSystem 
		      exec:shellPath
		      withArguments:shellArgs
		      fileDescriptors:execFdArray
		      closeDescriptors:closeFdArray
		      fork:true
		      newPgrp:true.
	       ]
	       action:[:status |
		  status stillAlive ifFalse:[
		      exitStatus := status.
		      pid := nil.
		      exitSema signal.
		  ].
	       ].

    (osType ~~ #vms) ifTrue:[
	OperatingSystem closeFd:execFd.
    ].

    pid notNil ifTrue:[
	(osType == #win32) ifTrue:[
	    self setFileHandle:myFd mode:mode
	] ifFalse:[
	    (osType == #vms) ifTrue:[
		"/
		"/ reopen the mailbox as a file ...
		"/
		mbxName := OperatingSystem mailBoxNameOf:mbx.
		mbxName notNil ifTrue:[
		    super open:mbxName withMode:mode
		].
	    ] ifFalse:[
		self setFileDescriptor:myFd mode:mode.
	    ]
	]
    ] ifFalse:[
	lastErrorNumber := OperatingSystem currentErrorNumber.
	osType ~~ #vms ifTrue:[
	    OperatingSystem closeFd:myFd.
	] ifFalse:[
	    OperatingSystem destroyMailBox:mbx
	].
    ].

    blocked ifFalse:[
	OperatingSystem unblockInterrupts
    ].

    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)
	"
	^ self openError
    ].

    commandString := aCommandString.
%{
    /* LINUX stdio is corrupt here ... */
#ifdef BUGGY_STDIO_LIB
    __INST(buffered) = false;
#else
    __INST(buffered) = true;
#endif
%}.
    position := 1.
    hitEOF := false.
    binary := false.
    Lobby register:self.

    "Modified: 23.4.1996 / 17:05:59 / stefan"
!

readingFrom:command
    "setup the receiver to read from command"

    mode := #readonly. didWrite := false.
    ^ self openPipeFor:command withMode:'r'
!

writingTo:command
    "setup the receiver to write to command"

    mode := #writeonly. didWrite := true.
    ^ self openPipeFor:command withMode:'w'
! !

!PipeStream class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/PipeStream.st,v 1.61 1997-09-22 20:01:37 cg Exp $'
! !
PipeStream initialize!