#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 02/08/1996 19:11 UTC by loverso@coltsfoot
# Source directory /afs/ri/project/cf/build/tcl/src/tcl7.5b1/newsock
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#      0 -rw-r--r-- Changes
#  28055 -rw-r--r-- tclIOCmd.c
#  29326 -rw-r--r-- tclIOSock.c
#  18426 -rw-r--r-- tclMacChan.c
#  28602 -rw-r--r-- tclUnixChan.c
#   1744 -rw-r--r-- tclUnixSock.c
#   7269 -rw-r--r-- tclWin32Dll.c
#  27898 -rw-r--r-- tclWinSock.c
#   1905 -rw-r--r-- tclX.h
#
# ============= Changes ==============
if test -f 'Changes' -a X"$1" != X"-c"; then
	echo 'x - skipping Changes (File already exists)'
else
echo 'x - extracting Changes (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'Changes' &&

SHAR_EOF
chmod 0644 Changes ||
echo 'restore of Changes failed'
Wc_c="`wc -c < 'Changes'`"
test 0 -eq "$Wc_c" ||
	echo 'Changes: original size 0, current size' "$Wc_c"
fi
# ============= tclIOCmd.c ==============
if test -f 'tclIOCmd.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclIOCmd.c (File already exists)'
else
echo 'x - extracting tclIOCmd.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclIOCmd.c' &&
/* 
X * tclIOCmd.c --
X *
X *	Contains the definitions of all Tcl commands relating to IO.
X *
X * Copyright (c) 1995-1996 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X */
X
static char sccsid[] = "@(#) tclIOCmd.c 1.65 96/01/30 12:40:27";
X
#include	"tclInt.h"	/* Internal definitions for Tcl. */
#include	"tclPort.h"	/* Portability features for Tcl. */
X
/*
X * Return at most this number of bytes in one call to Tcl_ReadChannel:
X */
X
#define	TCL_READ_CHUNK_SIZE	4096
X
/*
X * Static functions for this file:
X */
X
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_PutsCmd --
X *
X *	This function implements the "puts" Tcl command.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	Produces output on a channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_PutsCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to puts on. */
X    int i;				/* Counter. */
X    int newline;			/* Add a newline at end? */
X    char *channelId;			/* Name of channel for puts. */
X    int result;				/* Result of puts operation. */
X    int mode;				/* Mode in which channel is opened. */
X
X    i = 1;
X    newline = 1;
X    if ((argc >= 2) && (strcmp(argv[1], "-nonewline") == 0)) {
X	newline = 0;
X	i++;
X    }
X    if ((i < (argc-3)) || (i >= argc)) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" ?-nonewline? ?channelId? string\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X
X    /*
X     * The code below provides backwards compatibility with an old
X     * form of the command that is no longer recommended or documented.
X     */
X
X    if (i == (argc-3)) {
X	if (strncmp(argv[i+2], "nonewline", strlen(argv[i+2])) != 0) {
X	    Tcl_AppendResult(interp, "bad argument \"", argv[i+2],
X		    "\": should be \"nonewline\"", (char *) NULL);
X	    return TCL_ERROR;
X	}
X	newline = 0;
X    }
X    if (i == (argc-1)) {
X	channelId = "stdout";
X    } else {
X	channelId = argv[i];
X	i++;
X    }
X    channelId = TclSubstChannelName(channelId);
X    chan = Tcl_GetChannel(interp, channelId, &mode);
X    if (chan == (Tcl_Channel) NULL) {
X        return TCL_ERROR;
X    }
X    if ((mode & TCL_WRITABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", channelId,
X                "\" wasn't opened for writing", (char *) NULL);
X        return TCL_ERROR;
X    }
X    
X    result = Tcl_Write(chan, argv[i], -1);
X    if (result < 0) {
X        Tcl_AppendResult(interp, "puts: ", Tcl_GetChannelName(chan), ": ",
X                Tcl_PosixError(interp), (char *) NULL);
X        return TCL_ERROR;
X    }
X    if (newline != 0) {
X        result = Tcl_Write(chan, "\n", 1);
X        if (result < 0) {
X            Tcl_AppendResult(interp, "puts: ", Tcl_GetChannelName(chan), ": ",
X                    Tcl_PosixError(interp), (char *) NULL);
X            return TCL_ERROR;
X        }
X    }
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_FlushCmd --
X *
X *	Implements the Tcl "flush" command. May flush output queued for
X *	a channel.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May cause output to appear on the specified channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_FlushCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to flush on. */
X    char *channelId;			/* Name of channel to flush. */
X    int result;				/* Result of call to channel
X                                         * level function. */
X    int mode;				/* Mode in which channel is opened. */
X
X    if (argc != 2) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" channelId\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, &mode);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    if ((mode & TCL_WRITABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", argv[1],
X                "\" wasn't opened for writing", (char *) NULL);
X        return TCL_ERROR;
X    }
X    
X    result = Tcl_Flush(chan);
X    if (result != TCL_OK) {
X        Tcl_AppendResult(interp, "flush: ", Tcl_GetChannelName(chan), ": ",
X                Tcl_PosixError(interp), (char *) NULL);
X    }
X    return result;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_GetsCmd --
X *
X *	Implements the Tcl "gets" command.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May cause output to be flushed. May consume input from channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_GetsCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to read from. */
X    char *channelId;			/* Name of channel to read from. */
X    char *varName;			/* Assign to this variable? */
X    char buf[128];			/* Buffer to store string
X                                         * representation of how long
X                                         * a line was read. */
X    int lineLen;			/* To hold line length read. */
X    Tcl_DString ds;			/* Dynamic string to hold the
X                                         * buffer for the line just read. */
X    char *linePtr;			/* Points at buffer in dstring. */
X    int mode;				/* Mode in which channel is opened. */
X
X    if ((argc != 2) && (argc != 3)) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" channelId ?varName?\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, &mode);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    if ((mode & TCL_READABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", argv[1],
X                "\" wasn't opened for reading", (char *) NULL);
X        return TCL_ERROR;
X    }
X    
X    if (argc != 3) {
X        varName = (char *) NULL;
X    } else {
X        varName = argv[2];
X    }
X    Tcl_DStringInit(&ds);
X    lineLen = Tcl_Gets(chan, &ds);
X    if (lineLen < 0) {
X        Tcl_DStringFree(&ds);
X        if (Tcl_Eof(chan) || Tcl_InputBlocked(chan)) {
X            if (varName != (char *) NULL) {
X                Tcl_AppendResult(interp, "-1", (char *) NULL);
X            }
X            return TCL_OK;
X        }
X        Tcl_AppendResult(interp, "gets: ", Tcl_GetChannelName(chan), ": ",
X                Tcl_PosixError(interp), (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    linePtr = Tcl_DStringValue(&ds);
X    if (varName == (char *) NULL) {
X        Tcl_AppendResult(interp, linePtr, (char *) NULL);
X    } else {
X        if (Tcl_SetVar(interp, varName, linePtr, TCL_LEAVE_ERR_MSG) ==
X                NULL) {
X            Tcl_DStringFree(&ds);
X            return TCL_ERROR;
X        }
X        Tcl_ResetResult(interp);
X        sprintf(buf, "%d", lineLen);
X        Tcl_AppendResult(interp, buf, (char *) NULL);
X    }
X    Tcl_DStringFree(&ds);
X
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_ReadCmd --
X *
X *	Implements the Tcl "read" command.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May cause output to be flushed. May consume input from channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_ReadCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to read from. */
X    char *channelId;			/* Name of channel to read from. */
X    int newline, i;			/* Discard newline at end? */
X    int toRead;				/* How many bytes to read? */
X    char *bufPtr;			/* Temporary buffer used to
X                                         * store chunks read. */
X    int toReadNow;			/* How many bytes to attempt to
X                                         * read in the current iteration? */
X    int charactersRead;			/* How many characters were read? */
X    int charactersReadNow;		/* How many characters were read
X                                         * in this iteration? */
X    int mode;				/* Mode in which channel is opened. */
X    int shortRead;			/* When we get a short read this is
X                                         * set to non-zero to cause the reading
X                                         * loop to stop. */
X
X    if ((argc != 2) && (argc != 3)) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" channelId ?numBytes?\" or \"", argv[0],
X		" ?-nonewline? channelId\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    i = 1;
X    newline = 0;
X    if (strcmp(argv[i], "-nonewline") == 0) {
X	newline = 1;
X	i++;
X    }
X
X    if (i == argc) {
X        Tcl_AppendResult(interp, "read: missing channel name", (char *)
X                NULL);
X        return TCL_ERROR;
X    }
X
X    channelId = TclSubstChannelName(argv[i]);
X    chan = Tcl_GetChannel(interp, channelId, &mode);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    if ((mode & TCL_READABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", argv[i],
X                "\" wasn't opened for reading", (char *) NULL);
X        return TCL_ERROR;
X    }
X    
X    i++;	/* Consumed channel name. */
X
X    /*
X     * Compute how many bytes to read, and see whether the final
X     * newline should be dropped.
X     */
X
X    if (i == argc) {
X	toRead = INT_MAX;
X    } else if ((newline == 0) && (isdigit((unsigned char) (argv[i][0])))) {
X	if (Tcl_GetInt(interp, argv[i], &toRead) != TCL_OK) {
X	    return TCL_ERROR;
X	}
X    } else {
X	toRead = INT_MAX;
X
X	/*
X	 * The code below provides backward compatibility for an
X	 * archaic earlier version of this command.
X	 */
X
X        if (strcmp(argv[i], "nonewline") == 0) {
X            newline = 1;
X        } else {
X            Tcl_AppendResult(interp, "bad argument \"", argv[i],
X                    "\": should be \"nonewline\"", (char *) NULL);
X            return TCL_ERROR;
X        }
X    }
X
X    bufPtr = ckalloc((unsigned) TCL_READ_CHUNK_SIZE + 1);
X    
X    for (charactersRead = 0, shortRead = 0;
X             (charactersRead < toRead) && (!shortRead);
X             charactersRead += charactersReadNow) {
X        toReadNow = toRead - charactersRead;
X        if (toReadNow > TCL_READ_CHUNK_SIZE) {
X            toReadNow = TCL_READ_CHUNK_SIZE;
X        }
X        charactersReadNow = Tcl_Read(chan, bufPtr, toReadNow);
X        if (charactersReadNow < 0) {
X            ckfree(bufPtr);
X
X            /*
X             * We have to reset the result before storing the error
X             * message, because we may have accummulated some input read
X             * by previous calls (above) to Tcl_Read.
X             */
X            
X            Tcl_ResetResult(interp);
X            Tcl_AppendResult(interp, "read: ", Tcl_GetChannelName(chan), ": ",
X                    Tcl_PosixError(interp), (char *) NULL);
X            return TCL_ERROR;
X        }
X
X        /*
X         * Ensure that the buffer ends with a NULL so that it can safely
X         * be given to Tcl_AppendResult.
X         */
X
X        bufPtr[charactersReadNow] = '\0';
X        Tcl_AppendResult(interp, bufPtr, (char *) NULL);
X
X        /*
X         * If we had a short read it means that we have either EOF
X         * or BLOCKED on the channel, so signal the loop to stop
X         * reading.
X         */
X
X        if (charactersReadNow < toReadNow) {
X            shortRead = 1;
X        }
X    }
X    ckfree(bufPtr);
X
X    /*
X     * If there is no input string it means that we got EOF or BLOCKED
X     * right at the first character that was read from the channel.
X     */
X    
X    if (charactersRead == 0) {
X        Tcl_ResetResult(interp);
X        return TCL_OK;
X    }
X
X    /*
X     * If requested, remove the last newline in the channel if at EOF.
X     */
X    
X    if ((newline) && (Tcl_Eof(chan)) &&
X            (interp->result[charactersRead-1] == '\n')) {
X        interp->result[charactersRead-1] = '\0';
X    }
X
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclUnsupported0Cmd --
X *
X *	Implements the "unsupported0" command.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May copy a chunk from one channel to another.
X *
X *----------------------------------------------------------------------
X */
X
int
TclUnsupported0Cmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Interpreter in which both channels
X                                         * are defined. */
X    int argc;				/* How many arguments? */
X    char **argv;			/* The argument strings. */
{
X    Tcl_Channel inChan, outChan;
X    char *inChanId, *outChanId;
X    int requested;
X    char *bufPtr;
X    int actuallyRead, actuallyWritten, totalRead, toReadNow, mode;
X    
X    /*
X     * Assume we want to copy the entire channel.
X     */
X    
X    requested = INT_MAX;
X
X    if ((argc < 3) || (argc > 4)) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"",
X                argv[0], " inChanId outChanId ?chunkSize?\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    inChanId = TclSubstChannelName(argv[1]);
X    inChan = Tcl_GetChannel(interp, inChanId, &mode);
X    if (inChan == (Tcl_Channel) NULL) {
X        return TCL_ERROR;
X    }
X    if ((mode & TCL_READABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", argv[1],
X                "\" wasn't opened for reading", (char *) NULL);
X        return TCL_ERROR;
X    }
X    
X    outChanId = TclSubstChannelName(argv[2]);
X    outChan = Tcl_GetChannel(interp, argv[2], &mode);
X    if (outChan == (Tcl_Channel) NULL) {
X        return TCL_ERROR;
X    }
X    if ((mode & TCL_WRITABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", argv[2],
X                "\" wasn't opened for writing", (char *) NULL);
X        return TCL_ERROR;
X    }
X    
X    if (argc == 4) {
X	if (Tcl_GetInt(interp, argv[3], &requested) != TCL_OK) {
X	    return TCL_ERROR;
X	}
X        if (requested < 0) {
X            requested = INT_MAX;
X        }
X    }
X
X    bufPtr = ckalloc((unsigned) TCL_READ_CHUNK_SIZE);
X    for (totalRead = 0;
X            requested > 0;
X            totalRead += actuallyRead, requested -= actuallyRead) {
X        toReadNow = requested;
X        if (toReadNow > TCL_READ_CHUNK_SIZE) {
X            toReadNow = TCL_READ_CHUNK_SIZE;
X        }
X        actuallyRead = Tcl_Read(inChan, bufPtr, toReadNow);
X        if (actuallyRead < 0) {
X            ckfree(bufPtr);
X	    Tcl_AppendResult(interp, argv[0], ": ", Tcl_GetChannelName(inChan),
X		Tcl_PosixError(interp), (char *) NULL);
X            return TCL_ERROR;
X        }
X        if (actuallyRead == 0) {
X            ckfree(bufPtr);
X            sprintf(interp->result, "%d", totalRead);
X            return TCL_OK;
X        }
X        actuallyWritten = Tcl_Write(outChan, bufPtr, actuallyRead);
X        if (actuallyWritten < 0) {
X            ckfree(bufPtr);
X	    Tcl_AppendResult(interp, argv[0], ": ", Tcl_GetChannelName(outChan),
X		Tcl_PosixError(interp), (char *) NULL);
X            return TCL_ERROR;
X        }
X    }
X    ckfree(bufPtr);
X    
X    sprintf(interp->result, "%d", totalRead);
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_SeekCmd --
X *
X *	Implements the Tcl "seek" command. Moves the current access point
X *	to a new location.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	Moves the position of the access point on the specified channel.
X *	May flush queued output.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_SeekCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to tell on. */
X    char *channelId;			/* Name of channel to tell on. */
X    int offset, mode;			/* Where to seek? */
X    int result;				/* Of calling Tcl_Seek. */
X
X    if ((argc != 3) && (argc != 4)) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" channelId offset ?origin?\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, NULL);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    if (Tcl_GetInt(interp, argv[2], &offset) != TCL_OK) {
X	return TCL_ERROR;
X    }
X    mode = SEEK_SET;
X    if (argc == 4) {
X	size_t length;
X	int c;
X
X	length = strlen(argv[3]);
X	c = argv[3][0];
X	if ((c == 's') && (strncmp(argv[3], "start", length) == 0)) {
X	    mode = SEEK_SET;
X	} else if ((c == 'c') && (strncmp(argv[3], "current", length) == 0)) {
X	    mode = SEEK_CUR;
X	} else if ((c == 'e') && (strncmp(argv[3], "end", length) == 0)) {
X	    mode = SEEK_END;
X	} else {
X	    Tcl_AppendResult(interp, "bad origin \"", argv[3],
X		    "\": should be start, current or end", (char *) NULL);
X	    return TCL_ERROR;
X	}
X    }
X
X    result = Tcl_Seek(chan, offset, mode);
X    if (result < 0) {
X        Tcl_AppendResult(interp, "seek: ", Tcl_GetChannelName(chan), ": ",
X                Tcl_PosixError(interp), (char *) NULL);
X        return TCL_ERROR;
X    }
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_TellCmd --
X *
X *	Implements the Tcl "tell" command. Returns the current access
X *	position on the specified channel as a Tcl string.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_TellCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to tell on. */
X    char *channelId;			/* The channel name to tell on. */
X
X    if (argc != 2) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" channelId\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    /*
X     * Try to find a channel with the right name and permissions in
X     * the IO channel table of this interpreter.
X     */
X    
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, NULL);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    sprintf(interp->result, "%d", Tcl_Tell(chan));
X
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_CloseCmd --
X *
X *	Implements the Tcl "close" command. Closes the channel and may
X *	start an asynchronous flush.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May discard queued input; may flush queued output.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_CloseCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to close. */
X    char *channelId;			/* Name of channel to close. */
X
X    if (argc != 2) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" channelId\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, NULL);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
X
X        /*
X         * This hack checks to see if the result was already set by
X         * Tcl_CloseChannel. If so, it does not overwrite that, otherwise
X         * it sets its own error result.
X         */
X
X        if ((interp->result != (char *) NULL) && (interp->result[0] == '\0')) {
X            Tcl_AppendResult(interp, "close: \"<deleted-channel>\": ",
X                    Tcl_PosixError(interp), (char *) NULL);
X        }
X        return TCL_ERROR;
X    }
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_FModeCmd --
X *
X *	Implements the Tcl "fconfigure" command. This sets modes on an IO
X *	channel.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May modify the behavior of an IO channel
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_FModeCmd(clientData, interp, argc, argv)
X    ClientData clientData;		/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to set a mode on. */
X    char *channelId;			/* Name of channel to set mode on. */
X    int result;				/* Of Tcl_Set/GetChannelOption. */
X    char *optionValue;			/* Value retrieved by a call to
X                                         * Tcl_GetChannelOption. */
X    int i;				/* Iterate over arg-value pairs. */
X
X    if (argc < 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " channelId ?optionName? ?value? ?optionName value?...\"",
X                (char *) NULL);
X        return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, NULL);
X    if (chan == (Tcl_Channel) NULL) {
X        return TCL_ERROR;
X    }
X    if (argc == 2) {
X        Tcl_AppendElement(interp, "-blocking");
X        Tcl_AppendElement(interp, Tcl_GetChannelOption(chan, "-blocking"));
X
X        Tcl_AppendElement(interp, "-linemode");
X        Tcl_AppendElement(interp, Tcl_GetChannelOption(chan, "-linemode"));
X
X        Tcl_AppendElement(interp, "-translation");
X        Tcl_AppendElement(interp, Tcl_GetChannelOption(chan, "-translation"));
X
X        return TCL_OK;
X    }
X    if (argc == 3) {
X        optionValue = Tcl_GetChannelOption(chan, argv[2]);
X        if (optionValue == NULL) {
X            Tcl_AppendResult(interp, "fconfigure: ", Tcl_GetChannelName(chan),
X                    ": ", Tcl_PosixError(interp), (char *) NULL);
X            return TCL_ERROR;
X        }
X        sprintf(interp->result, "%s", optionValue);
X        return TCL_OK;
X    }
X    if ((argc % 2) == 1) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " channelId ?optionName? ?value? ?optionName value?...\"",
X                (char *) NULL);
X        return TCL_ERROR;
X    }
X    for (i = 3; i < argc; i += 2) {
X        result = Tcl_SetChannelOption(interp, chan, argv[i-1], argv[i]);
X        if (result != TCL_OK) {
X            return result;
X        }
X    }
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_EofCmd --
X *
X *	Implements the Tcl "eof" command.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	Sets interp->result to "0" or "1" depending on whether the
X *	specified channel has an EOF condition.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_EofCmd(unused, interp, argc, argv)
X    ClientData unused;			/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to query for EOF. */
X    char *channelId;			/* Name of channel to query. */
X    int mode;				/* Mode in which channel is opened. */
X
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " channelId\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, &mode);
X    if (chan == (Tcl_Channel) NULL) {
X	return TCL_ERROR;
X    }
X    sprintf(interp->result, "%d", Tcl_Eof(chan) ? 1 : 0);
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_FBlockedCmd --
X *
X *	Implements the Tcl "fblocked" command.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	Sets interp->result to "0" or "1" depending on whether the
X *	a preceding input operation on the channel would have blocked.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_FBlockedCmd(unused, interp, argc, argv)
X    ClientData unused;			/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to query for blocked. */
X    char *channelId;			/* Name of channel to query. */
X    int mode;				/* Mode in which channel was opened. */
X
X    if (argc != 2) {
X        Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X                " channelId\"", (char *) NULL);
X        return TCL_ERROR;
X    }
X    channelId = TclSubstChannelName(argv[1]);
X    chan = Tcl_GetChannel(interp, channelId, &mode);
X    if (chan == (Tcl_Channel) NULL) {
X        return TCL_ERROR;
X    }
X    if ((mode & TCL_READABLE) == 0) {
X        Tcl_AppendResult(interp, "channel \"", argv[1],
X                "\" wasn't opened for reading", (char *) NULL);
X        return TCL_ERROR;
X    }
X        
X    sprintf(interp->result, "%d", Tcl_InputBlocked(chan) ? 1 : 0);
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenCmd --
X *
X *	This procedure is invoked to process the "open" Tcl command.
X *	See the user documentation for details on what it does.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	See the user documentation.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_OpenCmd(notUsed, interp, argc, argv)
X    ClientData notUsed;			/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    int pipeline, prot;
X    char *mode;
X    int cmdArgc;
X    char **cmdArgv;
X    Tcl_Channel chan;
X
X    if ((argc < 2) || (argc > 4)) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		" fileName ?access? ?permissions?\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    prot = 0666;
X    if (argc == 2) {
X	mode = "r";
X    } else {
X	mode = argv[2];
X	if (argc == 4) {
X	    if (Tcl_GetInt(interp, argv[3], &prot) != TCL_OK) {
X		return TCL_ERROR;
X	    }
X	}
X    }
X
X    pipeline = 0;
X    if (argv[1][0] == '|') {
X	pipeline = 1;
X    }
X
X    /*
X     * Open the file or create a process pipeline.
X     */
X
X    if (!pipeline) {
X        chan = Tcl_OpenFileChannel(interp, argv[1], mode, prot);
X        if (chan == (Tcl_Channel) NULL) {
X            return TCL_ERROR;
X        }
X    } else {
X        if (Tcl_SplitList(interp, argv[1]+1, &cmdArgc, &cmdArgv) != TCL_OK) {
X            return TCL_ERROR;
X        }
X        chan = Tcl_OpenCommandChannel(interp, cmdArgc, cmdArgv, mode);
X        ckfree((char *) cmdArgv);
X        if (chan == (Tcl_Channel) NULL) {
X            return TCL_ERROR;
X        }
X    }
X    Tcl_RegisterChannel(interp, chan);
X    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
X    return TCL_OK;
}
SHAR_EOF
chmod 0644 tclIOCmd.c ||
echo 'restore of tclIOCmd.c failed'
Wc_c="`wc -c < 'tclIOCmd.c'`"
test 28055 -eq "$Wc_c" ||
	echo 'tclIOCmd.c: original size 28055, current size' "$Wc_c"
fi
# ============= tclIOSock.c ==============
if test -f 'tclIOSock.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclIOSock.c (File already exists)'
else
echo 'x - extracting tclIOSock.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclIOSock.c' &&
/* 
X * tclIOSock.c --
X *
X *	Common routines used by all socket based channel types.
X *
X * Copyright (c) 1995 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X */
X
static char sccsid[] = "@(#) tclIOSock.c 1.14 96/01/19 14:35:44";
X
#include "tclInt.h"
#include "tclPort.h"
#include "tclX.h"
X
/*
X * Identifiers for the different protocols understood by Tcl_SockCmd.
X */
X
#define	TCL_SOCKPROTO_TCP	0
#define TCL_SOCKPROTO_UDP	1
#define TCL_SOCKPROTO_BCAST	2
X
/*
X * Callback structure for accept() callback in a TCP server.
X */
X
typedef struct AcceptCallback {
X    char *script;			/* Script to invoke. */
X    Tcl_Interp *interp;			/* Interpreter in which to run it. */
} AcceptCallback;
X
/*
X * This structure describes per-instance state of a tcp based channel.
X */
X
typedef struct TcpState {
X    Tcl_File sock;			/* The socket itself. */
X    Tcl_TcpAcceptProc *acceptProc;	/* Proc to call on accept. */
X    ClientData acceptProcData;		/* The data for the accept proc. */
} TcpState;
X
/*
X * Static functions for this file:
X */
X
static void	AcceptCallbackProc _ANSI_ARGS_((ClientData callbackData,
X	            Tcl_Channel chan, char *address, int port));
static void	RegisterTcpServerInterpCleanup _ANSI_ARGS_((Tcl_Interp *interp,
X	            AcceptCallback *acceptCallbackPtr));
static void	TcpAcceptCallbacksDeleteProc _ANSI_ARGS_((
X		    ClientData clientData, Tcl_Interp *interp));
static void	TcpServerCloseCallback _ANSI_ARGS_((ClientData callbackData));
static void	UnregisterTcpServerInterpCleanup _ANSI_ARGS_((
X		    Tcl_Interp *interp, AcceptCallback *acceptCallbackPtr));
X
Tcl_File	CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
X                            int port, char *host, int server,
X                            int myport, char *myip, int backlog));
X
X
/*
X * This structure describes the channel type structure for TCP socket
X * based IO:
X */
X
static Tcl_ChannelType tcpChannelType = {
X    "tcp",				/* Type name. */
X    CommonBlockMode,			/* Set blocking/nonblocking mode.*/
X    CommonBufferSize,			/* Buffer size. */
X    TcpClose,				/* Close proc. */
X    TcpInput,				/* Input proc. */
X    CommonOutput,			/* Output proc. */
X    NULL				/* Seek proc. */
};
X
X
/*
X *----------------------------------------------------------------------
X *
X * TcpAcceptCallbacksDeleteProc --
X *
X *	Assocdata cleanup routine called when an interpreter is being
X *	deleted to set the interp field of all the accept callback records
X *	registered with	the interpreter to NULL. This will prevent the
X *	interpreter from being used in the future to eval accept scripts.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Deallocates memory and sets the interp field of all the accept
X *	callback records to NULL to prevent this interpreter from being
X *	used subsequently to eval accept scripts.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
void
TcpAcceptCallbacksDeleteProc(clientData, interp)
X    ClientData clientData;	/* Data which was passed when the assocdata
X                                 * was registered. */
X    Tcl_Interp *interp;		/* Interpreter being deleted - not used. */
{
X    Tcl_HashTable *hTblPtr;
X    Tcl_HashEntry *hPtr;
X    Tcl_HashSearch hSearch;
X    AcceptCallback *acceptCallbackPtr;
X
X    hTblPtr = (Tcl_HashTable *) clientData;
X    for (hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch);
X             hPtr != (Tcl_HashEntry *) NULL;
X             hPtr = Tcl_FirstHashEntry(hTblPtr, &hSearch)) {
X        acceptCallbackPtr = (AcceptCallback *) Tcl_GetHashValue(hPtr);
X        acceptCallbackPtr->interp = (Tcl_Interp *) NULL;
X        Tcl_DeleteHashEntry(hPtr);
X    }
X    Tcl_DeleteHashTable(hTblPtr);
X    ckfree((char *) hTblPtr);
}
X
/*
X *----------------------------------------------------------------------
X *
X * RegisterTcpServerInterpCleanup --
X *
X *	Registers an accept callback record to have its interp
X *	field set to NULL when the interpreter is deleted.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	When, in the future, the interpreter is deleted, the interp
X *	field of the accept callback data structure will be set to
X *	NULL. This will prevent attempts to eval the accept script
X *	in a deleted interpreter.
X *
X *----------------------------------------------------------------------
X */
X
void
RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
X    Tcl_Interp *interp;		/* Interpreter for which we want to be
X                                 * informed of deletion. */
X    AcceptCallback *acceptCallbackPtr;
X    				/* The accept callback record whose
X                                 * interp field we want set to NULL when
X                                 * the interpreter is deleted. */
{
X    Tcl_HashTable *hTblPtr;	/* Hash table for accept callback
X                                 * records to smash when the interpreter
X                                 * will be deleted. */
X    Tcl_HashEntry *hPtr;	/* Entry for this record. */
X    int new;			/* Is the entry new? */
X
X    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
X            "tclTCPAcceptCallbacks",
X            NULL);
X    if (hTblPtr == (Tcl_HashTable *) NULL) {
X        hTblPtr = (Tcl_HashTable *) ckalloc((unsigned) sizeof(Tcl_HashTable));
X        Tcl_InitHashTable(hTblPtr, TCL_ONE_WORD_KEYS);
X        (void) Tcl_SetAssocData(interp, "tclTCPAcceptCallbacks",
X                TcpAcceptCallbacksDeleteProc, (ClientData) hTblPtr);
X    }
X    hPtr = Tcl_CreateHashEntry(hTblPtr, (char *) acceptCallbackPtr, &new);
X    if (!new) {
X        panic("RegisterTcpServerCleanup: damaged accept record table");
X    }
X    Tcl_SetHashValue(hPtr, (ClientData) acceptCallbackPtr);
}
X
/*
X *----------------------------------------------------------------------
X *
X * UnregisterTcpServerInterpCleanup --
X *
X *	Unregister a previously registered accept callback record. The
X *	interp field of this record will no longer be set to NULL in
X *	the future when the interpreter is deleted.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Prevents the interp field of the accept callback record from
X *	being set to NULL in the future when the interpreter is deleted.
X *
X *----------------------------------------------------------------------
X */
X
void
UnregisterTcpServerInterpCleanup(interp, acceptCallbackPtr)
X    Tcl_Interp *interp;		/* Interpreter in which the accept callback
X                                 * record was registered. */
X    AcceptCallback *acceptCallbackPtr;
X    				/* The record for which to delete the
X                                 * registration. */
{
X    Tcl_HashTable *hTblPtr;
X    Tcl_HashEntry *hPtr;
X
X    hTblPtr = (Tcl_HashTable *) Tcl_GetAssocData(interp,
X            "tclTCPAcceptCallbacks", NULL);
X    if (hTblPtr == (Tcl_HashTable *) NULL) {
X        return;
X    }
X    hPtr = Tcl_FindHashEntry(hTblPtr, (char *) acceptCallbackPtr);
X    if (hPtr == (Tcl_HashEntry *) NULL) {
X        return;
X    }
X    Tcl_DeleteHashEntry(hPtr);
}
X
/*
X *----------------------------------------------------------------------
X *
X * AcceptCallbackProc --
X *
X *	This callback is invoked by the TCP channel driver when it
X *	accepts a new connection from a client on a server socket.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Whatever the script does.
X *
X *----------------------------------------------------------------------
X */
X
void
AcceptCallbackProc(callbackData, chan, address, port)
X    ClientData callbackData;		/* The data stored when the callback
X                                         * was created in the call to
X                                         * Tcl_OpenTcpServer. */
X    Tcl_Channel chan;			/* Channel for the newly accepted
X                                         * connection. */
X    char *address;			/* Address of client that was
X                                         * accepted, in four-byte network
X                                         * address format. */    
X    int port;				/* Port of client. */
{
X    AcceptCallback *acceptCallbackPtr;
X    Tcl_Interp *interp;
X    char *script;
X    int result;
X    char portbuf[20];
X
X    acceptCallbackPtr = (AcceptCallback *) callbackData;
X
X    /*
X     * Check if the callback is still valid; the interpreter may have gone
X     * away, this is signalled by setting the interp field of the callback
X     * data to NULL.
X     */
X    
X    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
X
X        script = acceptCallbackPtr->script;
X        interp = acceptCallbackPtr->interp;
X        
X        Tcl_Preserve((ClientData) script);
X
X        Tcl_RegisterChannel(interp, chan);
X	sprintf(portbuf, "%d", port);
X        result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
X                " ", address, " ", portbuf, (char *) NULL);
X        if (result != TCL_OK) {
X            Tcl_BackgroundError(interp);
X        }
X
X        Tcl_Release((ClientData) script);
X    } else {
X
X        /*
X         * The interpreter is gone, so there is no useful way to utilize
X         * the client socket - just close it.
X         */
X
X        Tcl_Close(chan);
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpServerCloseCallback --
X *
X *	This callback is called when the TCP server channel for which it
X *	was registered is being closed. It informs the interpreter in
X *	which the accept script is evaluated (if that interpreter still
X *	exists) that this channel no longer needs to be informed if the
X *	interpreter is deleted.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	In the future, if the interpreter is deleted this channel will
X *	no longer be informed.
X *
X *----------------------------------------------------------------------
X */
X
void
TcpServerCloseCallback(callbackData)
X    ClientData callbackData;	/* The data passed in the call to
X                                 * Tcl_CreateCloseHandler. */
{
X    AcceptCallback *acceptCallbackPtr;
X    				/* The actual data. */
X
X    acceptCallbackPtr = (AcceptCallback *) callbackData;
X    if (acceptCallbackPtr->interp != (Tcl_Interp *) NULL) {
X        UnregisterTcpServerInterpCleanup(acceptCallbackPtr->interp,
X                acceptCallbackPtr);
X    }
X    Tcl_EventuallyFree((ClientData) acceptCallbackPtr->script, TCL_DYNAMIC);
X    ckfree((char *) acceptCallbackPtr);
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_SocketCmd --
X *
X *	This procedure is invoked to process the "socket" Tcl command.
X *	See the user documentation for details on what it does.
X *
X *	socket ?-myip ipaddr? ?-myport port? host port
X *	socket -server ?cmd? ?-myip ipaddr? ?-myport port? ?-backlog #?
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	Creates a socket based channel.
X *
X *----------------------------------------------------------------------
X */
X
int
Tcl_SocketCmd(notUsed, interp, argc, argv)
X    ClientData notUsed;			/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    int a, server, sockProtocol = TCL_SOCKPROTO_TCP;
X    int port = -1, myport = -1, backlog = 5;
X    char *arg, *copyScript, *host, *script, *myip = NULL, *proto = "tcp";
X    Tcl_Channel chan = (Tcl_Channel)NULL;
X    Tcl_File file;
X    AcceptCallback *acceptCallbackPtr;
X    
X    server = 0;
X    script = NULL;
X
X    if (TclHasSockets(interp) != TCL_OK) {
X	return TCL_ERROR;
X    }
X
X    for (a = 1; a < argc; a++) {
X        arg = argv[a];
X	if (arg[0] == '-') {
X	    if (strcmp(arg, "-server") == 0) {
X		server = 1;
X		a++;
X		if (a >= argc) {
X		    Tcl_AppendResult(interp, argv[0],
X                            ": -server requires callback command",
X                            (char *) NULL);
X		    return TCL_ERROR;
X		}
X                script = argv[a];
X            } else if (strcmp(arg, "-tcp") == 0) {
X                sockProtocol = TCL_SOCKPROTO_TCP;
X		proto = "tcp";
X            } else if (strcmp(arg, "-myip") == 0) {
X		a++;
X		myip = argv[a];
X            } else if (strcmp(arg, "-myport") == 0) {
X		a++;
X		if (TclSockGetPort(interp, argv[a], proto, &myport) != TCL_OK) {
X		    return TCL_ERROR;
X		}
X	    } else if (strcmp(arg, "--") == 0) {
X		a++;
X		break;
X	    } else {
X		Tcl_AppendResult(interp, argv[0], ": unknown option \"", arg,
X                        "\"", (char *) NULL);
X		return TCL_ERROR;
X	    }
X	} else {
X	    break;
X	}
X    }
X
X    if (!server) {
X	if (a < argc) {
X	    host = argv[a];
X	    a++;
X	} else {
X	    Tcl_AppendResult(interp, argv[0], ": must specify host name",
X		    (char *) NULL);
X	    return TCL_ERROR;
X	}
X
X	if (a < argc) {
X	    if (TclSockGetPort(interp, argv[a], proto, &port) != TCL_OK) {
X		return TCL_ERROR;
X	    }
X	    a++;
X	} else {
X	    Tcl_AppendResult(interp, argv[0], ": must specify port number",
X		    (char *) NULL);
X	    return TCL_ERROR;
X	}
X    }
X    if (a != argc) {
X	Tcl_AppendResult(interp, argv[0], ": extra arguments: ", NULL);
X	while (a < argc) {
X	    Tcl_AppendResult(interp, argv[a], " ", (char *) NULL);
X	    a++;
X	}
X	return TCL_ERROR;
X    }
X    
X    if (server) {
X        acceptCallbackPtr = (AcceptCallback *) ckalloc((unsigned)
X                sizeof(AcceptCallback));
X        copyScript = ckalloc((unsigned) strlen(script) + 1);
X        strcpy(copyScript, script);
X        acceptCallbackPtr->interp = interp;
X        acceptCallbackPtr->script = copyScript;
X
X
X	file = CreateSocket(interp, -1, NULL, 1, myport, myip, backlog);
X	if (file != (Tcl_File) NULL) {
X	    chan = Tcl_OpenTcp(file, 1, AcceptCallbackProc,
X			(ClientData) acceptCallbackPtr);
X	}
X        if (chan == (Tcl_Channel) NULL) {
X            ckfree(copyScript);
X            ckfree((char *) acceptCallbackPtr);
X            return TCL_ERROR;
X        }
X
X        /*
X         * Register with the interpreter to let us know when the
X         * interpreter is deleted (by having the callback set the
X         * acceptCallbackPtr->interp field to NULL). This is to
X         * avoid trying to eval the script in a deleted interpreter.
X         */
X
X        RegisterTcpServerInterpCleanup(interp, acceptCallbackPtr);
X        
X        /*
X         * Register a close callback. This callback will inform the
X         * interpreter (if it still exists) that this channel does not
X         * need to be informed when the interpreter is deleted.
X         */
X        
X        Tcl_CreateCloseHandler(chan, TcpServerCloseCallback,
X                (ClientData) acceptCallbackPtr);
X    } else {
X	file = CreateSocket(interp, port, host, 0, myport, myip, 0);
X	if (file != (Tcl_File) NULL) {
X	    chan = Tcl_OpenTcp(file, 0, NULL, NULL);
X	}
X        if (chan == (Tcl_Channel) NULL) {
X            return TCL_ERROR;
X        }
X    }
X    Tcl_RegisterChannel(interp, chan);            
X    Tcl_AppendResult(interp, Tcl_GetChannelName(chan), (char *) NULL);
X    
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclSockGetPort --
X *
X *	Maps from a string, which could be a service name, to a port.
X *
X * Results:
X *	A standard Tcl result.  On success, the port number is
X *	returned in portPtr.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
int
TclSockGetPort(interp, string, proto, portPtr)
X    Tcl_Interp *interp;
X    char *string;		/* Integer or service name */
X    char *proto;		/* "tcp" or "udp", typically */
X    int *portPtr;		/* Return port number */
{
X    struct servent *sp = getservbyname(string, proto);    
X    if (sp != NULL) {
X	*portPtr = ntohs((unsigned short) sp->s_port);
X	return TCL_OK;
X    }
X    if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
X	return TCL_ERROR;
X    }
X    if (*portPtr > 0xFFFF) {
X        Tcl_AppendResult(interp, "couldn't open socket: port number too high",
X                (char *) NULL);
X	return TCL_ERROR;
X    }
X    return TCL_OK;
}
/*
X *-----------------------------------------------------------------------------
X *
X * TclSockInetAtoN --
X *
X *   Convert an internet address to an "struct in_addr" representation.
X *
X * Parameters:
X *   o interp (O) - If not NULL, an error message is return in the result.
X *     If NULL, no error message is generated.
X *   o strAddress (I) - String address to convert.
X *   o inAddress (O) - Converted internet address is returned here.
X * Returns:
X *   TCL_OK or TCL_ERROR.
X *-----------------------------------------------------------------------------
X */
int
TclSockInetAtoN(interp, string, addr)
X    Tcl_Interp *interp;
X    char *string;
X    struct in_addr *addr;
{
X    int result = TCL_OK;
X
#ifdef HAVE_INET_ATON
X    if (!inet_aton (string, addr))
X        result = TCL_ERROR;
#else
X    addr->s_addr = inet_addr(string);
X    if (addr->s_addr == INADDR_NONE)
X        result = TCL_ERROR;
#endif
X    if ((result == TCL_ERROR) && (interp != NULL)) {
X        Tcl_AppendResult(interp, "malformed address: \"",
X                          string, "\"", (char *) NULL);
X    }
X    return result;
}
X
/*
X *-----------------------------------------------------------------------------
X *
X * TclGetHostError --
X *
X *   Return an error message when gethostbyname or gethostbyaddr fails.
X *
X * Parameters:
X *   o interp (O) - The error message is returned in the result.
X *   o host (I) - Host name or address that got the error.
X * Globals:
X *   o h_errno (I) - The list of file handles to parse, may be empty.
X * Returns:
X *   Always returns TCL_ERROR.
X *-----------------------------------------------------------------------------
X */
static int
TclGetHostError (interp, host)
X    Tcl_Interp *interp;
X    char *host;
{
X    char *errorMsg;
X    char *errorCode;
X
X    switch (h_errno) {
X      case HOST_NOT_FOUND:
X        errorCode = "HOST_NOT_FOUND";
X        errorMsg = "host not found";
X        break;
X      case TRY_AGAIN:
X        errorCode = "TRY_AGAIN";
X        errorMsg = "try again";
X        break;
X      case NO_RECOVERY:
X        errorCode = "NO_RECOVERY";
X        errorMsg = "unrecordable server error";
X        break;
X      case NO_DATA:
X        errorCode = "NO_DATA";
X        errorMsg = "no data";
X        break;
X    }
X    Tcl_SetErrorCode (interp, "INET", errorCode, errorMsg, (char *)NULL);
X    Tcl_AppendResult (interp, "host lookup failure: ",
X                      host, " (", errorMsg, ")",
X                      (char *) NULL);
X    return TCL_ERROR;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclSockMinimumBuffers --
X *
X *	Ensure minimum buffer sizes (non zero).
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	Sets SO_SNDBUF and SO_RCVBUF sizes.
X *
X *----------------------------------------------------------------------
X */
X
int
TclSockMinimumBuffers(sock, size)
X    int sock;			/* Socket file descriptor */
X    int size;			/* Minimum buffer size */
{
X    int current;
X    int len = sizeof(int);
X
X    getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *) &current, &len);
X    if (current < size) {
X	len = sizeof(int);
X	setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *) &size, len);
X    }
X    len = sizeof(int);
X    getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *) &current, &len);
X    if (current < size) {
X	len = sizeof(int);
X	setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *) &size, len);
X    }
X    return TCL_OK;
}
X
X
/*
X *----------------------------------------------------------------------
X *
X * TcpInput --
X *
X *	Reads input from the TCP IO channel into the buffer given. Returns
X *	count of how many bytes were actually read, and an error indication.
X *
X * Results:
X *	A count of how many bytes were read is returned and an error
X *	indication is returned in an output argument.
X *
X * Side effects:
X *	Reads input from the actual channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
TcpInput(instanceData, inFile, buf, bufSize, errorCode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File inFile;			/* Input device for channel. */
X    char *buf;				/* Where to store data read. */
X    int bufSize;			/* How much space is available
X                                         * in the buffer? */
X    int *errorCode;			/* Where to store error code. */
{
X    int sock;				/* The OS handle. */
X    int bytesRead;			/* How many bytes were read? */
X
X    *errorCode = 0;
X    errno = 0;
X    sock = (int) Tcl_GetFileInfo(inFile, NULL);
X
X    if (bufSize == 0) {
X        return 0;
X    }
X    bytesRead = recv(sock, buf, bufSize, 0);
X    if (bytesRead > -1) {
X        return bytesRead;
X    }
X    if (errno == ECONNRESET) {
X
X        /*
X         * Turn ECONNRESET into a soft EOF condition.
X         */
X        
X        return 0;
X    }
X    *errorCode = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpClose --
X *
X *	Close the socket.
X *
X * Results:
X *	0 if successful, the value of errno if failed.
X *
X * Side effects:
X *	Closes the socket.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
TcpClose(instanceData, inFile, outFile)
X    ClientData instanceData;    /* The socket to close. */
X    Tcl_File inFile, outFile;   /* Unused. */
{
X    TcpState *statePtr = (TcpState *) instanceData;
X    Tcl_File sock = statePtr->sock;
X    int errorCode = 0;
X
X    /*
X     * We assume that inFile==outFile==sock and so only clean up one of them.
X     */
X    
X    if (SocketClose(Tcl_GetFileInfo(sock, NULL)) < 0) {
X	GetError;
X        errorCode = errno;
X    }
X    
X    /*
X     * Delete a file handler that may be active for this socket.
X     * Channel handlers are already deleted in the generic IO close
X     * code which called this function.
X     */
X    
X    Tcl_DeleteFileHandler(sock);
X
X    ckfree((char *) statePtr);
X
X    Tcl_FreeFile(sock);
X    return errorCode;
}
X
/*
X *----------------------------------------------------------------------
X *
X * CreateSocket --
X *
X *	This function opens a new socket in client or server mode
X *	and initializes the TcpState structure.
X *
X * Results:
X *	Returns a new TcpState, or NULL with an error interp.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
Tcl_File
CreateSocket(interp, port, host, server, myport, myip, backlog)
X    Tcl_Interp *interp;		/* For error reporting; can be NULL. */
X    int port;			/* Port number to open. */
X    char *host;			/* Name of host on which to open port. */
X    int server;			/* 1 if socket should be a server socket,
X				 * else 0 for a client socket. */
X    int myport;			/* Port number to bind to. */
X    char *myip;			/* IP addr to bind to. */
X    int backlog;		/* Server accept queue. */
{
X    int status, sock, needbind = 0;
X    struct sockaddr_in local, remote;	/* Socket addresses */
X    struct hostent *hostent;		/* Host database entry */
X    struct linger ling;			/* For making sockets linger. */
X    char *error = NULL;
X
X    if (TclHasSockets(interp) != TCL_OK) {
X	return NULL;
X    }
X
X    (void) memset((char *) &local, '\0', sizeof(struct sockaddr_in));
X    local.sin_family = AF_INET;
X
X    if (myport != -1) {
X	local.sin_port = htons((unsigned short) (myport & 0xFFFF));
X	needbind = 1;
X    }
X    if (myip) {
X	if (TclSockInetAtoN(interp, myip, &local.sin_addr) != TCL_OK)
X	    return NULL;
X	needbind = 1;
X    }
X
X    if (!server) {
X	(void) memset((char *) &remote, '\0', sizeof(struct sockaddr_in));
X	remote.sin_port = htons((unsigned short) (port & 0xFFFF));
X	if (inet_aton(host, &remote.sin_addr)) {
X	    remote.sin_family = AF_INET;
X	    hostent = NULL;
X	} else {
X	    hostent = gethostbyname(host);
X	    if (hostent == NULL) {
X		(void) TclGetHostError(interp, host);
X		return NULL;
X	    }
X	    remote.sin_family = hostent->h_addrtype;
X	}
X    }
X
X    sock = socket(AF_INET, SOCK_STREAM, 0);
X    if (sock < 0) {
X	goto error;
X    }
X
X    /*
X     * Make socket close down gracefully.
X     */
X    
X    ling.l_onoff = 1;
X    ling.l_linger = 0;
X    (void) setsockopt(sock, SOL_SOCKET, SO_LINGER, (char *) &ling,
X            sizeof(ling));
X
X    if (server) {
X	/*
X	 * Set up to reuse server addresses automatically and bind to the
X	 * specified port.
X	 */
X    
X	status = 1;
X	(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
X		sizeof(status));
X    }
X
X    if (needbind && bind(sock, (struct sockaddr *) &local,
X		sizeof(struct sockaddr_in)) < 0) {
X	error = "bind socket";
X	goto close;
X    }
X
X    if (server) {
X	if (listen(sock, backlog) < 0) {
X	    error = "set socket listen queue";
X	    goto close;
X	} 
X    } else {
X	/*
X	 * Attempt to connect. The connect may fail at present with an
X	 * EINPROGRESS but at a later time it will complete. The caller
X	 * will set up a file handler on the socket if she is interested in
X	 * being informed when the connect completes.
X	 */
X	error = "connect socket";
X	if (hostent == NULL) {
X	    if (connect(sock, (struct sockaddr *) &remote,
X			sizeof(struct sockaddr_in)) < 0) {
X		goto close;
X	    }
X	} else {
X	    /*
X	     * Try multiple addresses, if that's what we got
X	     */
X	    int idx;
X	    for (idx = 0; hostent->h_addr_list[idx] != NULL; idx++) {
X		memcpy((char *) &remote.sin_addr,
X				(char *) hostent->h_addr_list[idx],
X				(size_t) hostent->h_length);
X		if (connect(sock, (struct sockaddr *) &remote,
X			    sizeof(struct sockaddr_in)) >= 0) {
X		    break;
X		}
X	    }
X	    if (hostent->h_addr_list[idx] == NULL) {
X	       goto close;
X	    }
X	    error = NULL;
X	}
X    }
X
X    /*
X     * Allocate a Tcl_File for this socket.
X     */
X
X    return Tcl_GetFile((ClientData) sock, TCL_UNIX_FD);
X
X  close:
X    close(sock);
X
X  error:
X    if (interp != NULL) {
X	Tcl_AppendResult(interp, "couldn't ", error ? error : "open socket",
X		": ", Tcl_PosixError(interp), (char *) NULL);
X    }
X    return NULL;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenTcp --
X *
X *	Wraps an open a TCP socket in a channel.
X *
X * Results:
X *	The channel or NULL if failed.
X *
X * Side effects:
X *	Opens a server socket and creates a new channel.
X *	Destroys the file and open socket if it fails.
X *
X *----------------------------------------------------------------------
X */
X
Tcl_Channel
Tcl_OpenTcp(sock, server, acceptProc, acceptProcData)
X    Tcl_File sock;			/* open file for socket */
X    int server;				/* 1 if socker is a server */
X    Tcl_TcpAcceptProc *acceptProc;	/* Callback for accepting connections
X                                         * from new clients. */
X    ClientData acceptProcData;		/* Data for the callback. */
{
X    Tcl_Channel chan;
X    TcpState *statePtr;
X    char channelName[20];
X
X    /*
X     * wrap socket in a channel.
X     */
X
X    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
X    statePtr->sock = sock;
X    statePtr->acceptProc = acceptProc;
X    statePtr->acceptProcData = acceptProcData;
X
X    if (server) {
X	/*
X	 * Set up the callback mechanism for accepting connections
X	 * from new clients. The caller will use Tcl_TcpRegisterCallback
X	 * to register a callback to call when a new connection is
X	 * accepted.
X	 */
X
X	Tcl_CreateFileHandler(statePtr->sock, TCL_READABLE, TcpAccept,
X		(ClientData) statePtr);
X    }
X    
X    sprintf(channelName, "sock%d",
X	    (int) Tcl_GetFileInfo(statePtr->sock, NULL));
X
X    /*
X     * You can do no I/O on a server socket
X     */
X    chan = Tcl_CreateChannel(&tcpChannelType, channelName,
X	    server ? NULL : statePtr->sock,
X	    server ? NULL : statePtr->sock,
X            (ClientData) statePtr);
X
X    if (chan == (Tcl_Channel) NULL) {
X	ckfree((char *) statePtr);
X	close((int) Tcl_GetFileInfo(statePtr->sock, NULL));
X	Tcl_FreeFile(sock);
X    }
X
X    /*
X     * Sockets start out with EOL translation set to "auto".
X     */
X    
X    return chan;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpAccept --
X *	Accept a TCP socket connection.  This is called by the event loop,
X *	and it in turns calls any registered callbacks for this channel.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Evals the Tcl script associated with the server socket.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
void
TcpAccept(data, mask)
X    ClientData data;			/* Callback token. */
X    int mask;				/* Not used. */
{
X    TcpState *sockState;		/* Client data of server socket. */
X    int newsock;			/* The new client socket */
X    Tcl_File newFile;			/* Its file. */
X    TcpState *newSockState;		/* State for new socket. */
X    struct sockaddr_in addr;		/* The remote address */
X    int len;				/* For accept interface */
X    Tcl_Channel chan;			/* Channel instance created. */
X    char channelName[20];
X
X    sockState = (TcpState *) data;
X
X    len = sizeof(struct sockaddr_in);
X    newsock = accept((int) Tcl_GetFileInfo(sockState->sock, NULL),
X	    (struct sockaddr *)&addr, &len);
X    if (newsock < 0) {
X        return;
X    }
X    
X    newFile = Tcl_GetFile((ClientData) newsock, TCL_UNIX_FD);
X    if (newFile) {
X	chan = Tcl_OpenTcp(newFile, 0, NULL, NULL);
X
X        if (chan != (Tcl_Channel) NULL) {
X            /*
X             * Sockets start out in EOL translation mode "auto".
X             */            
X
X            if (sockState->acceptProc != (Tcl_TcpAcceptProc *) NULL) {
X                (sockState->acceptProc) (sockState->acceptProcData, chan,
X                        inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
X            }
X	}
X    }
}
SHAR_EOF
chmod 0644 tclIOSock.c ||
echo 'restore of tclIOSock.c failed'
Wc_c="`wc -c < 'tclIOSock.c'`"
test 29326 -eq "$Wc_c" ||
	echo 'tclIOSock.c: original size 29326, current size' "$Wc_c"
fi
# ============= tclMacChan.c ==============
if test -f 'tclMacChan.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclMacChan.c (File already exists)'
else
echo 'x - extracting tclMacChan.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclMacChan.c' &&
/* 
X * tclMacChan.c
X *
X *	Channel drivers for Macintosh channels based on
X *	TCP sockets, and the console fds.
X *
X * Copyright (c) 1996 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X */
X
static char sccsid[] = "@(#) tclMacChan.c 1.12 96/01/30 15:57:52";
X
#include "tclInt.h"
#include "tclPort.h"
#include <Aliases.h>
#include <Errors.h>
#include <Files.h>
#include <Gestalt.h>
#include <Processes.h>
#include <Strings.h>
X
/*
X * Static routines for this file:
X */
X
static int		UnixBlockMode _ANSI_ARGS_((ClientData instanceData,
X				Tcl_File inFile, Tcl_File outFile, int mode));
static int		UnixInput _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, char *buf, int toRead,
X			    int *errorCode));
static int		UnixOutput _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File outFile, char *buf, int toWrite,
X			    int *errorCode));
static int		StdIOSeek _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile, long offset,
X			    int mode, int *errorCode));
static Tcl_Channel	CreateStdFileChannel _ANSI_ARGS_((char *name,
X			    Tcl_File inFile, Tcl_File outFile));
static int		StdIOClose _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile));
X
/*
X * This structure describes the channel type structure for file based IO:
X */
X
static Tcl_ChannelType consoleChannelType = {
X    "file",			/* Type name. */
X    UnixBlockMode,		/* Set blocking or
X                                 * non-blocking mode.*/
X    CommonBufferSize,		/* Buffer size. */
X    StdIOClose,			/* Close proc. */
X    UnixInput,			/* Input proc. */
X    UnixOutput,			/* Output proc. */
X    StdIOSeek			/* Seek proc. */
};
X
/*
X * This structure describes the channel type structure for TCP socket
X * based IO:
X */
X
static Tcl_ChannelType tcpChannelType = {
X    "tcp",			/* Type name. */
X    UnixBlockMode,		/* Set blocking or
X                                 * non-blocking mode.*/
X    CommonBufferSize,		/* Buffer size. */
X    TcpClose,			/* Close proc. */
X    UnixInput,			/* Input proc. */
X    UnixOutput,			/* Output proc. */
X    NULL			/* Seek proc. */
};
X
/*
X * This is the size of the channel name for File based channels
X */
X
#define CHANNEL_NAME_SIZE	64
static char channelName[CHANNEL_NAME_SIZE+1];
X
/*
X * The preferred buffer size for Unix channels.
X */
X
#define CHANNEL_BUF_SIZE	4096
X
/*
X * Static variables to hold channels for stdin, stdout and stderr.
X */
X
static Tcl_Channel stdinChannel = NULL;
static Tcl_Channel stdoutChannel = NULL;
static Tcl_Channel stderrChannel = NULL;
X
/*
X * Static variables to hold files for stdin, stdout and stderr.
X */
X
static Tcl_File stdinFile = NULL;
static Tcl_File stdoutFile = NULL;
static Tcl_File stderrFile = NULL;
X
/*
X * Flag used internally by socket driver to remember that the socket
X * is not yet connected.
X */
X
#define TCL_SOCKET_NOT_CONNECTED	(1<<2)
X
/*
X * Globals for holding information about OS support for sockets.
X */
static int socketsTestInited = false;
static int hasSockets = false;
X
/*
X *----------------------------------------------------------------------
X *
X * CommonBufferSize --
X *
X *	Returns the preferred buffer size for unix IO channels.
X *
X * Results:
X *	The preferred buffer size.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
CommonBufferSize(clientData)
X    ClientData clientData;		/* Unused. */
{
X    return CHANNEL_BUF_SIZE;
}
X
/*
X *----------------------------------------------------------------------
X *
X * UnixOutput--
X *
X *	Writes the given output on the IO channel. Returns count of how
X *	many characters were actually written, and an error indication.
X *
X * Results:
X *	A count of how many characters were written is returned and an
X *	error indication is returned in an output argument.
X *
X * Side effects:
X *	Writes output on the actual channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
UnixOutput(instanceData, outFile, buf, toWrite, errorCode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File outFile;			/* Output device for channel. */
X    char *buf;				/* The data buffer. */
X    int toWrite;			/* How many bytes to write? */
X    int *errorCode;			/* Where to store error code. */
{
X    int written;
X    int fd;
X
X    *errorCode = 0;
X    errno = 0;
X    fd = (int) Tcl_GetFileInfo(outFile, NULL);
X    written = write(fd, buf, (size_t) toWrite);
X    if (written > -1) {
X        return written;
X    }
X    *errorCode = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * UnixInput --
X *
X *	Reads input from the IO channel into the buffer given. Returns
X *	count of how many bytes were actually read, and an error indication.
X *
X * Results:
X *	A count of how many bytes were read is returned and an error
X *	indication is returned in an output argument.
X *
X * Side effects:
X *	Reads input from the actual channel.
X *
X *----------------------------------------------------------------------
X */
X
int
UnixInput(instanceData, inFile, buf, bufSize, errorCode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File inFile;			/* Input device for channel. */
X    char *buf;				/* Where to store data read. */
X    int bufSize;			/* How much space is available
X                                         * in the buffer? */
X    int *errorCode;			/* Where to store error code. */
{
X    struct stat statBuf;
X    int fd;
X    int bytesRead;			/* How many bytes were read? */
X
X    *errorCode = 0;
X    errno = 0;
X    fd = (int) Tcl_GetFileInfo(inFile, NULL);
X    if (fstat(fd, &statBuf) != 0) {
X        *errorCode = errno;
X        return -1;
X    }
X    if ((statBuf.st_size > 0) && (statBuf.st_size < bufSize)) {
X        bufSize = statBuf.st_size;
X    }
X    bytesRead = read(fd, buf, (size_t) bufSize);
X    if (bytesRead > -1) {
X        return bytesRead;
X    }
X    *errorCode = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * StdIOSeek --
X *
X *	Seeks on an IO channel. Returns the new position.
X *
X * Results:
X *	-1 if failed, the new position if successful. If failed, it
X *	also sets *errorCodePtr to the error code.
X *
X * Side effects:
X *	Moves the location at which the channel will be accessed in
X *	future operations.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
StdIOSeek(instanceData, inFile, outFile, offset, mode, errorCodePtr)
X    ClientData instanceData;			/* Unused. */
X    Tcl_File inFile, outFile;			/* Input and output
X                                                 * devices for channel. */
X    long offset;				/* Offset to seek to. */
X    int mode;					/* Relative to where
X                                                 * should we seek? */
X    int *errorCodePtr;				/* To store error code. */
{
X    int newLoc;
X    int fd;
X
X    *errorCodePtr = 0;
X    if (inFile != (Tcl_File) NULL) {
X        fd = (int) Tcl_GetFileInfo(inFile, NULL);
X    } else if (outFile != (Tcl_File) NULL) {
X        fd = (int) Tcl_GetFileInfo(outFile, NULL);
X    } else {
X        *errorCodePtr = EFAULT;
X        return -1;
X    }
X    newLoc = lseek(fd, offset, mode);
X    if (newLoc > -1) {
X        return newLoc;
X    }
X    *errorCodePtr = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * UnixBlockMode --
X *
X *	Set blocking or non-blocking mode on channel.
X *
X * Results:
X *	0 if successful, errno when failed.
X *
X * Side effects:
X *	Sets the device into blocking or non-blocking mode.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
UnixBlockMode(instanceData, inFile, outFile, mode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File inFile, outFile;		/* Input, output for channel. */
X    int mode;				/* The mode to set. */
{
X    int curStatus;
X    int fd;
X
X    if (stdinFile == (Tcl_File) NULL) {
X        TclGetStdHandles(&stdinFile, &stdoutFile, &stderrFile);
X    }
X
X    /*
X     * Do not allow putting stdin, stdout or stderr into nonblocking mode.
X     */
X    
X    if (mode == TCL_MODE_NONBLOCKING) {
X        if ((inFile == stdinFile) || (outFile == stdoutFile) ||
X                (outFile == stderrFile)) {
X            return EFAULT;
X        }
X    }
X    
X    if (inFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(inFile, NULL);
X        curStatus = fcntl(fd, F_GETFL);
X        if (mode == TCL_MODE_BLOCKING) {
X            curStatus &= (~(O_NONBLOCK));
X        } else {
X            curStatus |= O_NONBLOCK;
X        }
X        if (fcntl(fd, F_SETFL, curStatus) < 0) {
X            return errno;
X        }
X    }
X    if (outFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(outFile, NULL);
X        curStatus = fcntl(fd, F_GETFL);
X        if (mode == TCL_MODE_BLOCKING) {
X            curStatus &= (~(O_NONBLOCK));
X        } else {
X            curStatus |= O_NONBLOCK;
X        }
X        if (fcntl(fd, F_SETFL, curStatus) < 0) {
X            return errno;
X        }
X    }
X
X    return 0;
}
X
/*
X *----------------------------------------------------------------------
X *
X * StdIOClose --
X *
X *	Closes the IO channel.
X *
X * Results:
X *	0 if successful, the value of errno if failed.
X *
X * Side effects:
X *	Closes the physical channel
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
StdIOClose(instanceData, inFile, outFile)
X    ClientData instanceData;	/* Unused. */
X    Tcl_File inFile;		/* Input file to close. */
X    Tcl_File outFile;		/* Output file to close. */
{
X    int fd, errorCode = 0;
X
X    /*
X     * Invalidate the stdio cache if necessary.  Note that we assume that
X     * the stdio file and channel pointers will become invalid at the same
X     * time.
X     */
X
X    if (inFile == stdinFile) {
X	stdinFile = NULL;
X	stdinChannel = NULL;
X    }
X    if (outFile == stdoutFile) {
X	stdoutFile = NULL;
X	stdoutChannel = NULL;
X    } else if (outFile == stderrFile) {
X	stderrFile = NULL;
X	stderrChannel = NULL;
X    }
X
X    if (inFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(inFile, NULL);
X
X	/*
X	 * Check for read/write file so we only close it once.
X	 */
X
X	if (inFile == outFile) {
X	    outFile = NULL;
X	}
X        Tcl_FreeFile(inFile);
X
X        if (fd > 2) {
X            if (close(fd) < 0) {
X		errorCode = errno;
X	    }
X        }
X    }
X
X    if (outFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(outFile, NULL);
X        Tcl_FreeFile(outFile);        
X        if (fd > 2) {
X	    if ((close(fd) < 0) && (errorCode == 0)) {
X		errorCode = errno;
X	    }
X        } 
X    }
X    return errorCode;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclGetCommandPids --
X *
X *	Stores a list of the command PIDs for a command channel in
X *	interp->result.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Modifies interp->result.
X *
X *----------------------------------------------------------------------
X */
X
void
TclGetCommandPids(interp, chan)
X    Tcl_Interp *interp;
X    Tcl_Channel chan;
{
X    return;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclCleanupCommandChannel --
X *
X *	Perform special cleanup for command channels.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May wait for child processes.
X *
X *----------------------------------------------------------------------
X */
X
int
TclCleanupCommandChannel(interp, chan, keepNewline)
X    Tcl_Interp *interp;		/* Interpreter to report errors in. */
X    Tcl_Channel chan;		/* Channel to clean up after. */
X    int keepNewline;		/* non-zero means keep last newline
X                                 * in interp->result. */
{
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenCommandChannel --
X *
X *	Opens a communication channel to a sequence of commands.
X *	Command channels are not supported on the Macintosh.  This
X *	will alway return an NULL channel.
X *
X * Results:
X *	NULL.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
Tcl_Channel
Tcl_OpenCommandChannel(interp, argc, argv, modeString)
X    Tcl_Interp *interp;		/* Interpreter for error reporting. */
X    int argc;			/* How many arguments. */
X    char **argv;		/* Array of arguments for command pipe. */
X    char *modeString;		/* Which modes to open the channel in? */
{
X    Tcl_AppendResult(interp, "pipes not supported on Macintosh OS", NULL);
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_PidCmd --
X *
X *	This procedure is invoked to process the "pid" Tcl command.
X *	See the user documentation for details on what it does.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	See the user documentation.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_PidCmd(dummy, interp, argc, argv)
X    ClientData dummy;			/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    ProcessSerialNumber psn;
X    Tcl_Channel chan;
X
X    if (argc > 2) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"",
X		argv[0], " ?channelId?\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    
X    if (argc == 2) {
X        chan = Tcl_GetChannel(interp, argv[1], NULL);
X	if (chan == (Tcl_Channel) NULL) {
X	    return TCL_ERROR;
X	}
X	
X	/*
X	 * We can't create pipelines on the Mac so
X	 * this will always return an empty list.
X	 */
X	return TCL_OK;
X    }
X    
X    GetCurrentProcess(&psn);
X    sprintf(interp->result, "0x%08x%08x", psn.highLongOfPSN, psn.lowLongOfPSN);
X    
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclGetStdChannels --
X *
X *	Returns handles to the standard channels for stdin, stdout and
X *	stderr.
X *
X * Results:
X *	None; returns values through output parameters.
X *
X * Side effects:
X *	May cause the creation of these standard channels and the underlying
X *	files.
X *
X *----------------------------------------------------------------------
X */
X
void
TclGetStdChannels(stdinPtr, stdoutPtr, stderrPtr)
X    Tcl_Channel *stdinPtr,		/* Where to store the channels. */
X    	        *stdoutPtr,
X    		*stderrPtr;
{
X    /*
X     * If the channels were not created yet, create them now and
X     * store them in the static variables.
X     */
X
X    if (stdinPtr != NULL) {
X	if (stdinFile == NULL) {
X	    stdinFile = Tcl_GetFile((ClientData) 0, TCL_UNIX_FD);
X	    stdinChannel = CreateStdFileChannel("stdin", stdinFile, NULL);
X        }
X        *stdinPtr = (Tcl_Channel) stdinChannel;
X    }
X    if (stdoutPtr != NULL) {
X	if (stdoutFile == NULL) {
X	    stdoutFile = Tcl_GetFile((ClientData) 1, TCL_UNIX_FD);
X	    stdoutChannel = CreateStdFileChannel("stdout", NULL, stdoutFile);
X        }
X	*stdoutPtr = (Tcl_Channel) stdoutChannel;
X    }
X    if (stderrPtr != NULL) {
X        if (stderrFile == NULL) {
X	    stderrFile = Tcl_GetFile((ClientData) 2, TCL_UNIX_FD);
X	    stderrChannel = CreateStdFileChannel("stderr", NULL, stderrFile);
X        }
X        *stderrPtr = (Tcl_Channel) stderrChannel;
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * CreateStdFileChannel --
X *
X *	Create a channel suitable for use in wrapping a standard
X *	file handle.  Sets up the channel for use by the file driver.
X *
X * Results:
X *	Returns a newly allocated file channel.
X *
X * Side effects:
X *	Registers a new channel with the given name.
X *
X *----------------------------------------------------------------------
X */
X
static Tcl_Channel
CreateStdFileChannel(name, inFile, outFile)
X    char *name;			/* Name of standard channel. */
X    Tcl_File inFile;		/* File to use for input, or NULL. */
X    Tcl_File outFile;		/* File to use for output, or NULL. */
{
X    Tcl_Channel channel;
X
X    channel = Tcl_CreateChannel(&consoleChannelType, name, inFile, outFile,
X	    (ClientData) NULL);
X    /*
X     * Set up the normal channel options for stdio handles.
X     */
X
X    if (channel != NULL) {
X	Tcl_SetChannelOption(NULL, channel, "-translation", "cr");
X	Tcl_SetChannelOption(NULL, channel, "-linemode", "on");
X    }
X    return channel;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclHasSockets --
X *
X *	This function determines whether sockets are available on the
X *	current system and returns an error in interp if they are not.
X *	Note that interp may be NULL.  This call uses the Macintosh
X *	gestalt function to determine the existance of Mac Tcp.
X *
X * Results:
X *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with
X *	an error in interp.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
#define gestaltMacTCPVersion 'mtcp'
int
TclHasSockets(interp)
X    Tcl_Interp *interp;
{
X    long response;
X    
static int socketsTestInited = false;
static int hasSockets = false;
X    if (!socketsTestInited) {
X	if (Gestalt(gestaltMacTCPVersion, &response) == noErr) {
X	    hasSockets = true;
X	} else {
X	    hasSockets = false;
X	}
X	socketsTestInited = true;
X    }
X    if (hasSockets) {
X	return TCL_OK;
X    }
X    if (interp != NULL) {
X	Tcl_AppendResult(interp, "sockets are not available on this system",
X		NULL);
X    }
X    return TCL_ERROR;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_GetHostName --
X *
X *	Returns the name of the local host.
X *
X * Results:
X *	Returns a string containing the host name, or NULL on error.
X *	The returned string must be freed by the caller.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
static char hostname[255];	/* This buffer should be big enough for
X                                 * hostname plus domain name. */
static int  hostnameInited = 0;
X
char *
Tcl_GetHostName()
{
X    if (hostnameInited) {
X        return hostname;
X    }
X    
X    if (TclHasSockets(NULL) != TCL_OK) {
X	hostname[0] = '\0';
X        hostnameInited = 1;
X	return hostname;
X    }
X
X    if (gethostname(hostname, 100) == 0) {
X        hostnameInited = 1;
X        return hostname;
X    }
X    return (char *) NULL;
}
SHAR_EOF
chmod 0644 tclMacChan.c ||
echo 'restore of tclMacChan.c failed'
Wc_c="`wc -c < 'tclMacChan.c'`"
test 18426 -eq "$Wc_c" ||
	echo 'tclMacChan.c: original size 18426, current size' "$Wc_c"
fi
# ============= tclUnixChan.c ==============
if test -f 'tclUnixChan.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclUnixChan.c (File already exists)'
else
echo 'x - extracting tclUnixChan.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclUnixChan.c' &&
/* 
X * tclUnixChan.c
X *
X *	Common channel driver for Unix channels based on files, command
X *	pipes and TCP sockets.
X *
X * Copyright (c) 1995-1996 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X */
X
static char sccsid[] = "@(#) tclUnixChan.c 1.111 96/01/19 18:20:21";
X
#include	"tclInt.h"	/* Internal definitions for Tcl. */
#include	"tclPort.h"	/* Portability features for Tcl. */
#include	"tclX.h"
X
/*
X * This structure describes per-instance state of a pipe based channel.
X */
X
typedef struct PipeState {
X    Tcl_File inPipe;	/* Output from pipe. */
X    Tcl_File outPipe;	/* Input to pipe. */
X    Tcl_File errorId;	/* Error output from pipe. */
X    int numPids;	/* How many processes are attached to this pipe? */
X    int *pidPtr;	/* The process IDs themselves. */
} PipeState;
X
/*
X * Static routines for this file:
X */
X
static int		FilePipeInput _ANSI_ARGS_((ClientData instanceData,
X		            Tcl_File inFile, char *buf, int toRead,
X		            int *errorCode));
static Tcl_Channel	CreateStdFileChannel _ANSI_ARGS_((char *name,
X			    Tcl_File inFile, Tcl_File outFile));
static int		FileClose _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile));
static int		FileSeek _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile, long offset,
X			    int mode, int *errorCode));
static int		PipeClose _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile));
X
/*
X * This structure describes the channel type structure for file based IO:
X */
X
static Tcl_ChannelType fileChannelType = {
X    "file",				/* Type name. */
X    CommonBlockMode,			/* Set blocking/nonblocking mode.*/
X    CommonBufferSize,			/* Buffer size. */
X    FileClose,				/* Close proc. */
X    FilePipeInput,			/* Input proc. */
X    CommonOutput,			/* Output proc. */
X    FileSeek				/* Seek proc. */
};
X
/*
X * This structure describes the channel type structure for command pipe
X * based IO:
X */
X
static Tcl_ChannelType pipeChannelType = {
X    "pipe",				/* Type name. */
X    CommonBlockMode,			/* Set blocking/nonblocking mode.*/
X    CommonBufferSize,			/* Buffer size. */
X    PipeClose,				/* Close proc. */
X    FilePipeInput,			/* Input proc. */
X    CommonOutput,			/* Output proc. */
X    NULL				/* Seek proc. */
};
X
/*
X * The preferred buffer size for Unix channels.
X */
X
#define CHANNEL_BUF_SIZE	4096
X
/*
X * Static variables to hold channels for stdin, stdout and stderr.
X */
X
static Tcl_Channel stdinChannel = NULL;
static Tcl_Channel stdoutChannel = NULL;
static Tcl_Channel stderrChannel = NULL;
X
/*
X * Static variables to hold files for stdin, stdout and stderr.
X */
X
static Tcl_File stdinFile = NULL;
static Tcl_File stdoutFile = NULL;
static Tcl_File stderrFile = NULL;
X
/*
X *----------------------------------------------------------------------
X *
X * CommonBufferSize --
X *
X *	Returns the preferred buffer size for unix IO channels.
X *
X * Results:
X *	The preferred buffer size.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
CommonBufferSize(clientData)
X    ClientData clientData;		/* Unused. */
{
X    return CHANNEL_BUF_SIZE;
}
X
/*
X *----------------------------------------------------------------------
X *
X * FilePipeInput --
X *
X *	Reads input from the IO channel into the buffer given. Returns
X *	count of how many bytes were actually read, and an error indication.
X *	This routine is used by the file and command pipeline drivers.
X *
X * Results:
X *	A count of how many bytes were read is returned and an error
X *	indication is returned in an output argument.
X *
X * Side effects:
X *	Reads input from the actual channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
FilePipeInput(instanceData, inFile, buf, toRead, errorCode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File inFile;			/* Input device for channel. */
X    char *buf;				/* Where to store data read. */
X    int toRead;				/* How much space is available
X                                         * in the buffer? */
X    int *errorCode;			/* Where to store error code. */
{
X    int fd;				/* The OS handle for reading. */
X    int bytesRead;			/* How many bytes were actually
X                                         * read from the input device? */
X
X    *errorCode = 0;
X    errno = 0;
X    fd = (int) Tcl_GetFileInfo(inFile, NULL);
X    
X    /*
X     * Assume there is always enough input available. This will block
X     * appropriately, and read will unblock as soon as a short read is
X     * possible, if the channel is in blocking mode. If the channel is
X     * nonblocking, the read will never block.
X     */
X    
X    if (toRead == 0) {
X        return 0;
X    }
X    bytesRead = read(fd, buf, (size_t) toRead);
X    if (bytesRead > -1) {
X        return bytesRead;
X    }
X    *errorCode = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * CommonOutput--
X *
X *	Writes the given output on the IO channel. Returns count of how
X *	many characters were actually written, and an error indication.
X *
X * Results:
X *	A count of how many characters were written is returned and an
X *	error indication is returned in an output argument.
X *
X * Side effects:
X *	Writes output on the actual channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
CommonOutput(instanceData, outFile, buf, toWrite, errorCode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File outFile;			/* Output device for channel. */
X    char *buf;				/* The data buffer. */
X    int toWrite;			/* How many bytes to write? */
X    int *errorCode;			/* Where to store error code. */
{
X    int written;
X    int fd;
X
X    *errorCode = 0;
X    errno = 0;
X    fd = (int) Tcl_GetFileInfo(outFile, NULL);
X    written = write(fd, buf, (size_t) toWrite);
X    if (written > -1) {
X        return written;
X    }
X    *errorCode = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * CommonBlockMode --
X *
X *	Set blocking or non-blocking mode on channel.
X *
X * Results:
X *	0 if successful, errno when failed.
X *
X * Side effects:
X *	Sets the device into blocking or non-blocking mode.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
CommonBlockMode(instanceData, inFile, outFile, mode)
X    ClientData instanceData;		/* Unused. */
X    Tcl_File inFile, outFile;		/* Input, output for channel. */
X    int mode;				/* The mode to set. */
{
X    int curStatus;
X    int fd;
X
X    if (stdinFile == (Tcl_File) NULL) {
X        TclGetStdHandles(&stdinFile, &stdoutFile, &stderrFile);
X    }
X
X    /*
X     * Do not allow putting stdin, stdout or stderr into nonblocking mode.
X     */
X    
X    if (mode == TCL_MODE_NONBLOCKING) {
X        if ((inFile == stdinFile) || (outFile == stdoutFile) ||
X                (outFile == stderrFile)) {
X            return EFAULT;
X        }
X    }
X    
X    if (inFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(inFile, NULL);
X        curStatus = fcntl(fd, F_GETFL);
X        if (mode == TCL_MODE_BLOCKING) {
X            curStatus &= (~(O_NONBLOCK));
X        } else {
X            curStatus |= O_NONBLOCK;
X        }
X        if (fcntl(fd, F_SETFL, curStatus) < 0) {
X            return errno;
X        }
X    }
X    if (outFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(outFile, NULL);
X        curStatus = fcntl(fd, F_GETFL);
X        if (mode == TCL_MODE_BLOCKING) {
X            curStatus &= (~(O_NONBLOCK));
X        } else {
X            curStatus |= O_NONBLOCK;
X        }
X        if (fcntl(fd, F_SETFL, curStatus) < 0) {
X            return errno;
X        }
X    }
X
X    return 0;
}
X
/*
X *----------------------------------------------------------------------
X *
X * FileClose --
X *
X *	Closes the IO channel.
X *
X * Results:
X *	0 if successful, the value of errno if failed.
X *
X * Side effects:
X *	Closes the physical channel
X *
X *----------------------------------------------------------------------
X */
X
static int
FileClose(instanceData, inFile, outFile)
X    ClientData instanceData;	/* Unused. */
X    Tcl_File inFile;		/* Input file to close. */
X    Tcl_File outFile;		/* Output file to close. */
{
X    int fd, errorCode = 0;
X
X    /*
X     * Invalidate the stdio cache if necessary.  Note that we assume that
X     * the stdio file and channel pointers will become invalid at the same
X     * time.
X     */
X
X    if (inFile == stdinFile) {
X	stdinFile = NULL;
X	stdinChannel = NULL;
X    }
X    if (outFile == stdoutFile) {
X	stdoutFile = NULL;
X	stdoutChannel = NULL;
X    } else if (outFile == stderrFile) {
X	stderrFile = NULL;
X	stderrChannel = NULL;
X    }
X
X    if (inFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(inFile, NULL);
X
X	/*
X	 * Check for read/write file so we only close it once.
X	 */
X
X	if (inFile == outFile) {
X	    outFile = NULL;
X	}
X        Tcl_FreeFile(inFile);
X
X        if (fd > 2) {
X            if (close(fd) < 0) {
X		errorCode = errno;
X	    }
X        }
X    }
X
X    if (outFile != NULL) {
X        fd = (int) Tcl_GetFileInfo(outFile, NULL);
X        Tcl_FreeFile(outFile);        
X        if (fd > 2) {
X	    if ((close(fd) < 0) && (errorCode == 0)) {
X		errorCode = errno;
X	    }
X        } 
X    }
X    return errorCode;
}
X
/*
X *----------------------------------------------------------------------
X *
X * FileSeek --
X *
X *	Seeks on a file-based IO channel. Returns the new position.
X *
X * Results:
X *	-1 if failed, the new position if successful. If failed, it
X *	also sets *errorCodePtr to the error code.
X *
X * Side effects:
X *	Moves the location at which the channel will be accessed in
X *	future operations.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
FileSeek(instanceData, inFile, outFile, offset, mode, errorCodePtr)
X    ClientData instanceData;			/* Unused. */
X    Tcl_File inFile, outFile;			/* Input and output
X                                                 * devices for channel. */
X    long offset;				/* Offset to seek to. */
X    int mode;					/* Relative to where
X                                                 * should we seek? */
X    int *errorCodePtr;				/* To store error code. */
{
X    int newLoc;
X    int fd;
X
X    *errorCodePtr = 0;
X    if (inFile != (Tcl_File) NULL) {
X        fd = (int) Tcl_GetFileInfo(inFile, NULL);
X    } else if (outFile != (Tcl_File) NULL) {
X        fd = (int) Tcl_GetFileInfo(outFile, NULL);
X    } else {
X        *errorCodePtr = EFAULT;
X        return -1;
X    }
X    newLoc = lseek(fd, offset, mode);
X    if (newLoc > -1) {
X        return newLoc;
X    }
X    *errorCodePtr = errno;
X    return -1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclGetCommandPids --
X *
X *	Stores a list of the command PIDs for a command channel in
X *	interp->result.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Modifies interp->result.
X *
X *----------------------------------------------------------------------
X */
X
void
TclGetCommandPids(interp, chan)
X    Tcl_Interp *interp;
X    Tcl_Channel chan;
{
X    PipeState *pipePtr;
X    Tcl_ChannelType *chanTypePtr;
X    int i;
X    char buf[20];
X
X    /*
X     * Punt if the channel is not a command channel.
X     */
X
X    chanTypePtr = Tcl_GetChannelType(chan);
X    if (chanTypePtr != &pipeChannelType) {
X        return;
X    }
X
X    pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
X    for (i = 0; i < pipePtr->numPids; i++) {
X        sprintf(buf, "%d", pipePtr->pidPtr[i]);
X        Tcl_AppendElement(interp, buf);
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclCleanupCommandChannel --
X *
X *	Perform special cleanup for command channels.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	May wait for child processes.
X *
X *----------------------------------------------------------------------
X */
X
int
TclCleanupCommandChannel(interp, chan, keepNewline)
X    Tcl_Interp *interp;		/* Interpreter to report errors in. */
X    Tcl_Channel chan;		/* Channel to clean up after. */
X    int keepNewline;		/* non-zero means keep last newline
X                                 * in interp->result. */
{
X    int result;
X    PipeState *pipePtr;
X    Tcl_ChannelType *chanTypePtr;
X    Tcl_Channel errChan;
X    int fd;
X    
X    /*
X     * Punt if the channel is not a command channel.
X     */
X
X    chanTypePtr = Tcl_GetChannelType(chan);
X    if (chanTypePtr != &pipeChannelType) {
X        return TCL_OK;
X    }
X
X    pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
X    if (pipePtr->inPipe != NULL) {
X        fd = (int) Tcl_GetFileInfo(pipePtr->inPipe, NULL);
X        close(fd);
X        Tcl_FreeFile(pipePtr->inPipe);
X        pipePtr->inPipe = (Tcl_File) NULL;
X    }
X    if (pipePtr->outPipe != NULL) {
X        fd = (int) Tcl_GetFileInfo(pipePtr->outPipe, NULL);
X        close(fd);
X        Tcl_FreeFile(pipePtr->outPipe);
X        pipePtr->outPipe = (Tcl_File) NULL;
X    }
X    
X    /*
X     * Wrap the error file into a channel and give it to the cleanup
X     * routine.
X     */
X
X    if (pipePtr->errorId != NULL) {
X	errChan = Tcl_CreateChannel(&fileChannelType, NULL, pipePtr->errorId,
X		NULL, NULL);
X    } else {
X	errChan = NULL;
X    }
X    result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
X            errChan, keepNewline);
X    
X    pipePtr->numPids = 0;
X    pipePtr->errorId = (Tcl_File) NULL;
X    
X    return result;
}
X
/*
X *----------------------------------------------------------------------
X *
X * PipeClose --
X *
X *	Closes a pipe based IO channel.
X *
X * Results:
X *	0 on success, errno otherwise.
X *
X * Side effects:
X *	Closes the physical channel.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
PipeClose(instanceData, inFile, outFile)
X    ClientData instanceData;	/* The pipe to close. */
X    Tcl_File inFile, outFile;	/* Unused. */
{
X    PipeState *pipePtr;
X    int fd, i, errorCode = 0;
X
X    pipePtr = (PipeState *) instanceData;
X    if (pipePtr->inPipe != NULL) {
X        fd = (int) Tcl_GetFileInfo(pipePtr->inPipe, NULL);
X        Tcl_FreeFile(pipePtr->inPipe);
X	if (close(fd) < 0) {
X	    errorCode = errno;
X	}
X    }
X    if (pipePtr->outPipe != NULL) {
X        fd = (int) Tcl_GetFileInfo(pipePtr->outPipe, NULL);
X        Tcl_FreeFile(pipePtr->outPipe);
X	if ((close(fd) < 0) && (errorCode == 0)) {
X	    errorCode = errno;
X	}
X    }
X    if (pipePtr->errorId != NULL) {
X        fd = (int) Tcl_GetFileInfo(pipePtr->errorId, NULL);
X        Tcl_FreeFile(pipePtr->errorId);
X	if ((close(fd) < 0) && (errorCode == 0)) {
X	    errorCode = errno;
X	}
X    }
X    if (pipePtr->numPids > 0) {
X        for (i = 0; i < pipePtr->numPids; i++) {
X            if (pipePtr->pidPtr[i] != -1) {
X                Tcl_DetachPids(1, &pipePtr->pidPtr[i]);
X            }
X        }
X        ckfree((char *) pipePtr->pidPtr);
X    }
X    ckfree((char *) pipePtr);
X        
X    return errorCode;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenFileChannel --
X *
X *	Open an File based channel on Unix systems.
X *
X * Results:
X *	The new channel or NULL. If NULL, the output argument
X *	errorCodePtr is set to a POSIX error.
X *
X * Side effects:
X *	May open the channel and may cause creation of a file on the
X *	file system.
X *
X *----------------------------------------------------------------------
X */
X
Tcl_Channel
Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
X    Tcl_Interp *interp;			/* Interpreter for error reporting;
X                                         * can be NULL. */
X    char *fileName;			/* Name of file to open. */
X    char *modeString;			/* A list of POSIX open modes or
X                                         * a string such as "rw". */
X    int permissions;			/* If the open involves creating a
X                                         * file, with what modes to create
X                                         * it? */
{
X    int fd, seekFlag, mode, channelPermissions;
X    Tcl_File file;
X    Tcl_Channel chan;
X    char *nativeName, channelName[20];
X    Tcl_DString buffer;
X
X    mode = TclGetOpenMode(interp, modeString, &seekFlag);
X    if (mode == -1) {
X        return NULL;
X    }
X    switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
X	case O_RDONLY:
X	    channelPermissions = TCL_READABLE;
X	    break;
X	case O_WRONLY:
X	    channelPermissions = TCL_WRITABLE;
X	    break;
X	case O_RDWR:
X	    channelPermissions = (TCL_READABLE | TCL_WRITABLE);
X	    break;
X	default:
X	    panic("Tcl_OpenFileChannel: invalid mode value");
X	    return NULL;
X    }
X
X    nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
X    if (nativeName == NULL) {
X	return NULL;
X    }
X    fd = open(nativeName, mode, permissions);
X    Tcl_DStringFree(&buffer);
X
X    if (fd < 0) {
X        if (interp != (Tcl_Interp *) NULL) {
X            Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
X                    Tcl_PosixError(interp), (char *) NULL);
X        }
X        return NULL;
X    }
X    
X    file = Tcl_GetFile((ClientData) fd, TCL_UNIX_FD);
X    sprintf(channelName, "file%d", (int) Tcl_GetFileInfo(file, NULL));
X    
X    chan = Tcl_CreateChannel(&fileChannelType, channelName,
X            (channelPermissions & TCL_READABLE) ? file : NULL,
X            (channelPermissions & TCL_WRITABLE) ? file : NULL,
X            (ClientData) NULL);
X    if (chan == (Tcl_Channel) NULL) {
X        if (interp != (Tcl_Interp *) NULL) {
X            Tcl_AppendResult(interp, "could not open channel \"",
X                    channelName, "\": ", Tcl_PosixError(interp),
X                    (char *) NULL);
X        }
X        Tcl_FreeFile(file);
X        close(fd);
X        return NULL;
X    }
X
X    if (seekFlag) {
X        if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
X            if (interp != (Tcl_Interp *) NULL) {
X                Tcl_AppendResult(interp, "could not seek to end of file on \"",
X                        channelName, "\": ", Tcl_PosixError(interp),
X                        (char *) NULL);
X            }
X            Tcl_Close(chan);
X            return NULL;
X        }
X    }
X    return chan;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenCommandChannel --
X *
X *	Opens a communication channel to a sequence of commands. 
X *
X * Results:
X *	The channel or NULL on failure.
X *
X * Side effects:
X *	Creates processes, opens pipes.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
Tcl_Channel
Tcl_OpenCommandChannel(interp, argc, argv, modeString)
X    Tcl_Interp *interp;		/* Interpreter for error reporting. Can
X                                 * NOT be NULL. */
X    int argc;			/* How many arguments. */
X    char **argv;		/* Array of arguments for command pipe. */
X    char *modeString;		/* Which modes to open the channel in? */
{
X    int permissions = 0;	/* Which end(s) of pipe to read, write. */
X    PipeState *pipePtr;		/* The instance data. */
X    Tcl_File *inPipePtr, *outPipePtr;
X    Tcl_File inPipe, outPipe, errorId, pipeId;
X    int fd, numPids, *pidPtr, channelId;
X    int mode, seekFlag;
X    Tcl_Channel chan;
X    char channelName[20];
X
X    inPipe = outPipe = errorId = NULL;
X
X    /*
X     * If the modeString is NULL, then we want either a readable or a null
X     * channel.  This is used by exec; it can't tell what mode to request
X     * because there may be redirections.  Otherwise we parse the mode
X     * string and set the permissions appropriately.
X     */
X
X    if (modeString == NULL) {
X	outPipePtr = &outPipe;
X	inPipePtr = NULL;
X    } else {
X        mode = TclGetOpenMode(interp, modeString, &seekFlag);
X        if (mode == -1) {
X            return (Tcl_Channel) NULL;
X        }
X	switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
X	    case O_RDONLY:
X		permissions = TCL_READABLE;
X		break;
X	    case O_WRONLY:
X		permissions = TCL_WRITABLE;
X		break;
X	    case O_RDWR:
X		permissions = (TCL_READABLE | TCL_WRITABLE);
X		break;
X	    default:
X		panic("Tcl_OpenCommandChannel: invalid mode value");
X		break;
X	}
X	inPipePtr = (permissions & TCL_WRITABLE) ? &inPipe : NULL;
X	outPipePtr = (permissions & TCL_READABLE) ? &outPipe : NULL;
X    }
X    
X    numPids = Tcl_CreatePipeline(interp, argc, argv, &pidPtr, inPipePtr,
X            outPipePtr, &errorId);
X
X    if (numPids < 0) {
X        if (inPipe != NULL) {
X            fd = (int) Tcl_GetFileInfo(inPipe, NULL);
X            close(fd);
X            Tcl_FreeFile(inPipe);
X        }
X        if (outPipe != NULL) {
X            fd = (int) Tcl_GetFileInfo(outPipe, NULL);
X            close(fd);
X            Tcl_FreeFile(outPipe);
X        }
X        if (errorId != NULL) {
X            fd = (int) Tcl_GetFileInfo(errorId, NULL);
X            close(fd);
X	    Tcl_FreeFile(errorId);
X        }
X        return NULL;
X    }
X
X    if (modeString != NULL) {
X	
X	/*
X	 * Since we were called with a mode string, we need to
X	 * verify that the permissions match the set of pipes
X	 * that were created.
X	 */
X
X	if (permissions & TCL_READABLE) {
X	    if (outPipe == NULL) {
X		if (inPipe != NULL) {
X		    fd = (int) Tcl_GetFileInfo(inPipe, NULL);
X		    close(fd);
X		    Tcl_FreeFile(inPipe);
X		}
X		Tcl_AppendResult(interp, "can't read output from command:",
X			" standard output was redirected", (char *) NULL);
X		if (numPids > 0) {
X		    Tcl_DetachPids(numPids, pidPtr);
X		    ckfree((char *) pidPtr);
X		}
X		if (errorId != NULL) {
X		    fd = (int) Tcl_GetFileInfo(errorId, NULL);
X		    close(fd);
X		    Tcl_FreeFile(errorId);
X		}
X		return NULL;
X	    }
X	}
X	if (permissions & TCL_WRITABLE) {
X	    if (inPipe == NULL) {
X		if (outPipe != NULL) {
X		    fd = (int) Tcl_GetFileInfo(outPipe, NULL);
X		    close(fd);
X		    Tcl_FreeFile(outPipe);
X		}
X		Tcl_AppendResult(interp, "can't write input to command:",
X			" standard input was redirected", (char *) NULL);
X		if (numPids > 0) {
X		    Tcl_DetachPids(numPids, pidPtr);
X		    ckfree((char *) pidPtr);
X		}
X		if (errorId != NULL) {
X		    fd = (int) Tcl_GetFileInfo(errorId, NULL);
X		    close(fd);
X		    Tcl_FreeFile(errorId);
X		}
X		return NULL;
X	    }
X	}
X    } else {
X
X	/*
X	 * Since we were called without a mode string, we need to compute
X	 * the permissions according to whether an output pipe was
X	 * created.
X	 */
X
X	permissions = ((outPipe != NULL) ? TCL_READABLE : 0);
X    }
X    
X    pipePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
X
X    pipePtr->inPipe = inPipe;		/* Output to pipe. */
X    pipePtr->outPipe = outPipe;		/* Input from pipe. */
X    pipePtr->errorId = errorId;		/* Error output from pipe. */
X    pipePtr->numPids = numPids;		/* How many PIDs are
X                                         * attached to the pipe? */
X    pipePtr->pidPtr = pidPtr;		/* The PIDs themselves. */
X
X    if (permissions & TCL_WRITABLE) {
X        pipeId = inPipe;
X    } else if (permissions & TCL_READABLE) {
X        pipeId = outPipe;
X    } else {
X        pipeId = errorId;
X    }
X    if (pipeId == (Tcl_File) NULL) {
X        channelId = 0;
X    } else {
X        channelId = (int) Tcl_GetFileInfo(pipeId, NULL);
X    }
X        
X    /*
X     * For backward compatibility with previous versions of Tcl, we
X     * use "file%d" as the base name for pipes even though it would
X     * be more natural to use "pipe%d".
X     */
X
X    sprintf(channelName, "file%d", channelId);
X    chan = Tcl_CreateChannel(&pipeChannelType, channelName,
X            (permissions & TCL_READABLE) ? outPipe : NULL,
X            (permissions & TCL_WRITABLE) ? inPipe : NULL,
X            (ClientData) pipePtr);
X    if (chan == (Tcl_Channel) NULL) {
X        Tcl_AppendResult(interp, "pipe for command could not be created",
X                (char *) NULL);
X        if (numPids > 0) {
X            Tcl_DetachPids(numPids, pidPtr);
X            ckfree((char *) pidPtr);
X        }
X        if (inPipe != NULL) {
X            fd = (int) Tcl_GetFileInfo(inPipe, NULL);
X            close(fd);
X            Tcl_FreeFile(inPipe);
X        }
X        if (outPipe != NULL) {
X            fd = (int) Tcl_GetFileInfo(outPipe, NULL);
X            close(fd);
X            Tcl_FreeFile(outPipe);
X        }
X        if (errorId != NULL) {
X            fd = (int) Tcl_GetFileInfo(errorId, NULL);
X            close(fd);
X            Tcl_FreeFile(errorId);
X        }
X        return NULL;
X    }
X    return chan;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_PidCmd --
X *
X *	This procedure is invoked to process the "pid" Tcl command.
X *	See the user documentation for details on what it does.
X *
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	See the user documentation.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
int
Tcl_PidCmd(dummy, interp, argc, argv)
X    ClientData dummy;			/* Not used. */
X    Tcl_Interp *interp;			/* Current interpreter. */
X    int argc;				/* Number of arguments. */
X    char **argv;			/* Argument strings. */
{
X    Tcl_Channel chan;			/* The channel to get pids for. */
X    Tcl_ChannelType *chanTypePtr;	/* The type of that channel. */
X    PipeState *pipePtr;			/* The pipe state. */
X    int i;				/* Loops over PIDs attached to the
X                                         * pipe. */
X    char string[50];			/* Temp buffer for string rep. of
X                                         * PIDs attached to the pipe. */
X
X    if (argc > 2) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"",
X		argv[0], " ?channelId?\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X    if (argc == 1) {
X	sprintf(interp->result, "%ld", (long) getpid());
X    } else {
X        chan = Tcl_GetChannel(interp, argv[1], NULL);
X        if (chan == (Tcl_Channel) NULL) {
X	    return TCL_ERROR;
X	}
X	chanTypePtr = Tcl_GetChannelType(chan);
X	if (chanTypePtr != &pipeChannelType) {
X	    return TCL_OK;
X	}
X        pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
X        for (i = 0; i < pipePtr->numPids; i++) {
X	    sprintf(string, "%d", pipePtr->pidPtr[i]);
X	    Tcl_AppendElement(interp, string);
X	}
X    }
X    return TCL_OK;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclGetStdChannels --
X *
X *	Returns handles to the standard channels for stdin, stdout and
X *	stderr.
X *
X * Results:
X *	None; returns values through output parameters.
X *
X * Side effects:
X *	May cause the creation of these standard channels and the underlying
X *	files.
X *
X *----------------------------------------------------------------------
X */
X
void
TclGetStdChannels(stdinPtr, stdoutPtr, stderrPtr)
X    Tcl_Channel *stdinPtr,		/* Where to store the channels. */
X    	        *stdoutPtr,
X    		*stderrPtr;
{
X    /*
X     * If the channels were not created yet, create them now and
X     * store them in the static variables.
X     */
X
X    if (stdinPtr != NULL) {
X	if (stdinFile == NULL) {
X	    stdinFile = Tcl_GetFile((ClientData) 0, TCL_UNIX_FD);
X	    stdinChannel = CreateStdFileChannel("stdin", stdinFile, NULL);
X        }
X        *stdinPtr = (Tcl_Channel) stdinChannel;
X    }
X    if (stdoutPtr != NULL) {
X	if (stdoutFile == NULL) {
X	    stdoutFile = Tcl_GetFile((ClientData) 1, TCL_UNIX_FD);
X	    stdoutChannel = CreateStdFileChannel("stdout", NULL, stdoutFile);
X        }
X	*stdoutPtr = (Tcl_Channel) stdoutChannel;
X    }
X    if (stderrPtr != NULL) {
X        if (stderrFile == NULL) {
X	    stderrFile = Tcl_GetFile((ClientData) 2, TCL_UNIX_FD);
X	    stderrChannel = CreateStdFileChannel("stderr", NULL, stderrFile);
X        }
X        *stderrPtr = (Tcl_Channel) stderrChannel;
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * CreateStdFileChannel --
X *
X *	Create a channel suitable for use in wrapping a standard
X *	file handle.  Sets up the channel for use by the file driver.
X *
X * Results:
X *	Returns a newly allocated file channel.
X *
X * Side effects:
X *	Registers a new channel with the given name.
X *
X *----------------------------------------------------------------------
X */
X
static Tcl_Channel
CreateStdFileChannel(name, inFile, outFile)
X    char *name;			/* Name of standard channel. */
X    Tcl_File inFile;		/* File to use for input, or NULL. */
X    Tcl_File outFile;		/* File to use for output, or NULL. */
{
X    Tcl_Channel channel;
X
X    channel = Tcl_CreateChannel(&fileChannelType, name, inFile, outFile,
X	    (ClientData) NULL);
X
X    /*
X     * Set up the normal channel options for stdio handles.
X     */
X
X    if (channel != NULL) {
X	Tcl_SetChannelOption(NULL, channel, "-translation", "lf");
X	Tcl_SetChannelOption(NULL, channel, "-linemode", "on");
X    }
X    return channel;
}
SHAR_EOF
chmod 0644 tclUnixChan.c ||
echo 'restore of tclUnixChan.c failed'
Wc_c="`wc -c < 'tclUnixChan.c'`"
test 28602 -eq "$Wc_c" ||
	echo 'tclUnixChan.c: original size 28602, current size' "$Wc_c"
fi
# ============= tclUnixSock.c ==============
if test -f 'tclUnixSock.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclUnixSock.c (File already exists)'
else
echo 'x - extracting tclUnixSock.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclUnixSock.c' &&
/* 
X * tclUnixSock.c --
X *
X *	This file contains Unix-specific socket related code.
X *
X * Copyright (c) 1995 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X */
X
static char sccsid[] = "@(#) tclUnixSock.c 1.3 96/01/16 11:36:05";
X
#include "tcl.h"
#include "tclPort.h"
X
/*
X * The following variable holds the network name of this host.
X */
X
#ifndef SYS_NMLN
#   define SYS_NMLN 100
#endif
X
static char hostname[SYS_NMLN + 1];
static int  hostnameInited = 0;
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_GetHostName --
X *
X *	Get the network name for this machine, in a system dependent way.
X *
X * Results:
X *	A string containing the network name for this machine.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
char *
Tcl_GetHostName()
{
X    struct utsname u;
X
X    if (hostnameInited) {
X        return hostname;
X    }
X    
X    if (uname(&u) > -1) {
X        strcpy(hostname, u.nodename);
X        hostnameInited = 1;
X        return hostname;
X    }
X    return (char *) NULL;
}
/*
X *----------------------------------------------------------------------
X *
X * TclHasSockets --
X *
X *	This function determines whether sockets are available on the
X *	current system and returns an error in interp if they are not.
X *	Note that interp may be NULL.
X *
X * Results:
X *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with
X *	an error in interp.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
int
TclHasSockets(interp)
X    Tcl_Interp *interp;
{
X    return TCL_OK;
}
SHAR_EOF
chmod 0644 tclUnixSock.c ||
echo 'restore of tclUnixSock.c failed'
Wc_c="`wc -c < 'tclUnixSock.c'`"
test 1744 -eq "$Wc_c" ||
	echo 'tclUnixSock.c: original size 1744, current size' "$Wc_c"
fi
# ============= tclWin32Dll.c ==============
if test -f 'tclWin32Dll.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclWin32Dll.c (File already exists)'
else
echo 'x - extracting tclWin32Dll.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclWin32Dll.c' &&
/* 
X * tclWin32Dll.c --
X *
X *	This file contains the DLL entry point which sets up the 32-to-16-bit
X *	thunking code for SynchSpawn if the library is running under Win32s.
X *
X * Copyright (c) 1995-1996 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X *
X * SCCS: @(#) tclWin32Dll.c 1.11 96/01/30 12:42:48
X */
X
#include <windows.h>
#include "tcl.h"
#include "tclPort.h"
#include "tclWinInt.h"
X
/*
X * We require at least version 1.1 of the Winsock interfaces.
X */
X
#define WSA_VERSION_REQD MAKEWORD(1,1)
X
X
typedef DWORD (WINAPI * UT32PROC)(LPVOID lpBuff, DWORD dwUserDefined,
X	LPVOID *lpTranslationList);
X
typedef BOOL (WINAPI * PUTREGISTER)(HANDLE hModule, LPCSTR SixteenBitDLL,
X	LPCSTR InitName, LPCSTR ProcName, UT32PROC* ThirtyTwoBitThunk,
X	FARPROC UT32Callback, LPVOID Buff);
X
typedef VOID (WINAPI * PUTUNREGISTER)(HANDLE hModule);
X
typedef DWORD (APIENTRY * PUT32CBPROC)(LPVOID Buff, DWORD UserDefined);
X
UT32PROC      tclUTProc = NULL;
PUTREGISTER   tclUTRegister = NULL;
PUTUNREGISTER tclUTUnRegister = NULL;
PUT32CBPROC   tclUT32CBProc = NULL;
int           tclProcessesAttached = 0;
BOOL          tclWin32s = FALSE;
X
/*
X * The following data structure is used to keep track of all of the DLL's
X * opened by Tcl so that they can be freed with the Tcl.dll is unloaded.
X */
X
typedef struct LibraryList {
X    HINSTANCE handle;
X    struct LibraryList *nextPtr;
} LibraryList;
X
static LibraryList *libraryList = NULL;	/* List of currently loaded DLL's.  */
X
static HINSTANCE tclInstance;		/* Global library instance handle. */
int hasSockets = 0;			/* 1 if this sockets are available. */
X
/*
X * Declarations for functions that are only used in this file.
X */
X
static void 		UnloadLibraries _ANSI_ARGS_((void));
X
X
/*
X *----------------------------------------------------------------------
X *
X * DllEntryPoint --
X *
X *	DLL entry point. Establishes thunk.
X *
X * Results:
X *	TRUE on sucess, FALSE on failure.
X *
X * Side effects:
X *	Establishes 32-to-16 bit thunk.
X *
X *----------------------------------------------------------------------
X */
BOOL APIENTRY
DllEntryPoint(hInst, reason, reserved)
X    HINSTANCE hInst;		/* Library instance handle. */
X    DWORD reason;		/* Reason this function is being called. */
X    LPVOID reserved;		/* Not used. */
{
X    char buffer[] = "TCL16xx.DLL";
X    OSVERSIONINFO info;
X    HINSTANCE tclKernel32;
X    WSADATA wsaData;
X
X    switch (reason) {
X    case DLL_PROCESS_ATTACH:
X
X	/*
X	 * Registration of UT need to be done only once for first
X	 * attaching process.  At that time set the tclWin32s flag
X	 * to indicate if the DLL is executing under Win32s or not.
X	 */
X
X	if (tclProcessesAttached++) {
X	    return FALSE;         /* Not the first initialization. */
X	}
X
X	tclInstance = hInst;
X
X	/*
X	 * Find out if we're running on Win32s.
X	 */
X
X	info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
X	GetVersionEx(&info);
X	tclWin32s = (info.dwPlatformId == VER_PLATFORM_WIN32s);
X
X	if (tclWin32s) {
X	    /*
X	     * Load the Universal Thunking routines from kernel32.dll.
X	     */
X
X	    tclKernel32 = TclWinLoadLibrary("Kernel32.Dll");
X	    if (tclKernel32 == NULL) {
X		return FALSE;
X	    }
X
X	    tclUTRegister = (PUTREGISTER) GetProcAddress(tclKernel32,
X		    "UTRegister");
X	    tclUTUnRegister = (PUTUNREGISTER) GetProcAddress(tclKernel32,
X		    "UTUnRegister");
X	    if (!tclUTRegister || !tclUTUnRegister) {
X		UnloadLibraries();
X		return FALSE;
X	    }
X
X	    /*
X	     * Construct the complete name of tcl16xx.dll.
X	     */
X
X	    buffer[5] = '0' + TCL_MAJOR_VERSION;
X	    buffer[6] = '0' + TCL_MINOR_VERSION;
X
X	    /*
X	     * Register the Tcl thunk.
X	     */
X
X	    if (!(*tclUTRegister)(hInst, buffer, "UTInit", "UTProc",
X		    &tclUTProc, (FARPROC)tclUT32CBProc, NULL)) {
X		UnloadLibraries();
X		return FALSE;
X	    }
X	}
X
X	/*
X	 * Check to see if Sockets are supported on this system.  Since
X	 * win32s panics if we call WSAStartup on a system that doesn't
X	 * have winsock.dll, we need to look for it on the system first.
X	 */
X
X	if (!tclWin32s
X		|| (SearchPath(NULL, "WINSOCK", ".DLL", 0, NULL, NULL) != 0)) {
X	    if (WSAStartup(WSA_VERSION_REQD, &wsaData) == 0) {
X		if (wsaData.wVersion != WSA_VERSION_REQD) {
X		    WSACleanup();
X		} else {
X		    hasSockets = 1;
X		}
X	    }
X	}
X
X	return TRUE;
X
X    case DLL_PROCESS_DETACH:
X
X	tclProcessesAttached--;
X	if (tclProcessesAttached == 0) {
X
X	    /*
X	     * Unregister the Tcl thunk.
X	     */
X
X	    if (tclWin32s) {
X		(*tclUTUnRegister)(hInst);
X	    }
X
X	    /*
X	     * Shut down the sockets library.
X	     */
X
X	    if (hasSockets) {
X		WSACleanup();
X	    }
X
X	    /*
X	     * Cleanup any dynamically loaded libraries.
X	     */
X
X	    UnloadLibraries();
X	}
X	break;
X    }
X
X    return TRUE; 
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclWinLoadLibrary --
X *
X *	This function is a wrapper for the system LoadLibrary.  It is
X *	responsible for adding library handles to the library list so
X *	the libraries can be freed when tcl.dll is unloaded.
X *
X * Results:
X *	Returns the handle of the newly loaded library, or NULL on
X *	failure.
X *
X * Side effects:
X *	Loads the specified library into the process.
X *
X *----------------------------------------------------------------------
X */
X
HINSTANCE
TclWinLoadLibrary(name)
X    char *name;			/* Library file to load. */
{
X    HINSTANCE handle;
X    LibraryList *ptr;
X
X    handle = LoadLibrary(name);
X    if (handle != NULL) {
X	ptr = (LibraryList*) ckalloc(sizeof(LibraryList));
X	ptr->handle = handle;
X	ptr->nextPtr = libraryList;
X	libraryList = ptr;
X    } else {
X	TclWinConvertError(GetLastError());
X    }
X    return handle;
}
X
/*
X *----------------------------------------------------------------------
X *
X * UnloadLibraries --
X *
X *	Frees any dynamically allocated libraries loaded by Tcl.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Frees the libraries on the library list as well as the list.
X *
X *----------------------------------------------------------------------
X */
X
static void
UnloadLibraries()
{
X    LibraryList *ptr;
X
X    while (libraryList != NULL) {
X	FreeLibrary(libraryList->handle);
X	ptr = libraryList->nextPtr;
X	ckfree(libraryList);
X	libraryList = ptr;
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclSynchSpawn --
X *
X *	32-bit entry point to the 16-bit SynchSpawn code.
X *
X * Results:
X *	1 on sucess, 0 on failure.
X *
X * Side effects:
X *	Spawns a command and waits for it to complete.
X *
X *----------------------------------------------------------------------
X */
DWORD APIENTRY
TclSynchSpawn( LPCSTR CmdLine, UINT CmdShow )
{
X   DWORD Args[2];
X   PVOID Translist[2];
X
X   Args[0] = (DWORD) CmdLine;
X   Args[1] = (DWORD) CmdShow;
X
X   Translist[0] = &Args[0];
X   Translist[1] = NULL;
X
X   return( (*tclUTProc)( Args, TCLSYNCHSPAWN, Translist) );
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclWinGetTclInstance --
X *
X *	Retrieves the global library instance handle.
X *
X * Results:
X *	Returns the global library instance handle.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
HINSTANCE
TclWinGetTclInstance()
{
X    return tclInstance;
}
SHAR_EOF
chmod 0644 tclWin32Dll.c ||
echo 'restore of tclWin32Dll.c failed'
Wc_c="`wc -c < 'tclWin32Dll.c'`"
test 7269 -eq "$Wc_c" ||
	echo 'tclWin32Dll.c: original size 7269, current size' "$Wc_c"
fi
# ============= tclWinSock.c ==============
if test -f 'tclWinSock.c' -a X"$1" != X"-c"; then
	echo 'x - skipping tclWinSock.c (File already exists)'
else
echo 'x - extracting tclWinSock.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclWinSock.c' &&
/* 
X * tclWinSock.c --
X *
X *	This file contains Windows-specific socket related code.
X *
X * Copyright (c) 1995-1996 Sun Microsystems, Inc.
X *
X * See the file "license.terms" for information on usage and redistribution
X * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
X *
X * SCCS: @(#) tclWinSock.c 1.11 96/01/30 17:19:44
X */
X
#include "tclInt.h"
#include "tclPort.h"
#include "tclX.h"
X
/*
X * The preferred buffer size for Windows socket channels.
X */
X
#define TCP_BUFFER_SIZE 4096
X
/*
X * The following define declares a new user message for use on the
X * socket window.
X */
X
#define SOCKET_MESSAGE	WM_USER+1
X
/*
X * The following structure is used to store the data associated with
X * each socket.  A Tcl_File of type TCL_WIN_SOCKET will contain a
X * pointer to one of these structures in the clientdata slot.
X */
X
typedef struct SocketInfo {
X    SOCKET socket;		   /* Windows SOCKET handle. */
X    int flags;			   /* Bit field comprised of the flags
X				    * described below.  */
X    int checkMask;		   /* OR'ed combination of TCL_READABLE and
X				    * TCL_WRITABLE as set by an asynchronous
X				    * event handler. */
X    int watchMask;		   /* OR'ed combination of TCL_READABLE and
X				    * TCL_WRITABLE as set by Tcl_WatchFile. */
X    Tcl_File file;		   /* The file handle for the socket. */
X    Tcl_TcpAcceptProc *acceptProc; /* Proc to call on accept. */
X    ClientData acceptProcData;	   /* The data for the accept proc. */
X    struct SocketInfo *nextPtr;	   /* The next socket on the global socket
X				    * list. */
} SocketInfo;
X
/*
X * The following macros may be used to set the flags field of
X * a SocketInfo structure.
X */
X
#define SOCKET_WATCH 	(1<<1)
X				/* TclWinWatchSocket has been called since the
X				 * last time we entered Tcl_WaitForEvent. */
#define SOCKET_REGISTERED (1<<2)
X				/* A valid WSAAsyncSelect handler is
X				 * registered. */
#define SOCKET_ASYNCH	(1<<3)
X				/* The socket is in asynch mode. */
X
/*
X * Every open socket has an entry on the following list.
X */
X
static SocketInfo *socketList = NULL;
X
/*
X * Static functions defined in this file.
X */
X
static void		CleanupSockets _ANSI_ARGS_((ClientData clientData));
static SocketInfo *	CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
X			    int port, char *host, int server));
static int		InitSockets _ANSI_ARGS_((void));
static LRESULT CALLBACK	SocketProc _ANSI_ARGS_((HWND hwnd, UINT message,
X			    WPARAM wParam, LPARAM lParam));
static void		TcpAccept _ANSI_ARGS_((ClientData data, int mask));
static int		TcpBlockMode _ANSI_ARGS_((ClientData instanceData,
X	            	    Tcl_File inFile, Tcl_File outFile, int mode));
static int		TcpBufferSize _ANSI_ARGS_((ClientData instanceData));
static int		TcpClose _ANSI_ARGS_((ClientData instanceData,
X	            	    Tcl_File inFile, Tcl_File outFile));
static int		TcpInput _ANSI_ARGS_((ClientData instanceData,
X	            	    Tcl_File inFile, char *buf, int toRead,
X	            	    int *errorCode));
static int		TcpOutput _ANSI_ARGS_((ClientData instanceData,
X	            	    Tcl_File outFile, char *buf, int toWrite,
X	            	    int *errorCode));
X
/*
X * This structure describes the channel type structure for TCP socket
X * based IO.
X */
X
static Tcl_ChannelType tcpChannelType = {
X    "tcp",		/* Type name. */
X    TcpBlockMode,	/* Set blocking or non-blocking mode.*/
X    TcpBufferSize,	/* Buffer size. */
X    TcpClose,		/* Close proc. */
X    TcpInput,		/* Input proc. */
X    TcpOutput,		/* Output proc. */
X    NULL		/* Seek proc. */
};
X
/*
X * Remembers that socket initialization was done.
X */
X
extern int hasSockets;			/* 1 if this sockets are available. */
X
static int              socketsInitialized = 0;
static WSADATA          stWSAData;
X
/*
X * Socket notification window.  This window is used to receive socket
X * notification events.
X */
X
static HWND socketWindow = NULL;
X
/*
X * Window class for creating the socket notification window.
X */
X
static ATOM socketClass;
X
/*
X * Highest required version of WinSock:
X */
X
/* WinSock version information (use WSA_VERSION for WSAStartup()) */
#ifndef MAKEWORD
#define MAKEWORD(l,h) ((WORD)(((BYTE)(l))|(((WORD)(BYTE)(h))<<8)))
#endif
#define WSA_MAJOR_VERSION 1
#define WSA_MINOR_VERSION 1
#define WSA_VERSION MAKEWORD(WSA_MAJOR_VERSION, WSA_MINOR_VERSION)
X
X
/*
X *----------------------------------------------------------------------
X *
X * InitSockets --
X *
X *	Initialize the socket module.  Note that WSAStartup was called by the
X *	DllEntryPoint code, so we can assume that the WinSock library has
X *	already been initialized. 
X *
X * Results:
X *	Returns 1 on successful initialization, 0 on failure.
X *
X * Side effects:
X *	Registers a new window class and creates a window for use
X * 	in asynchronous socket notification.
X *
X *----------------------------------------------------------------------
X */
X
static int
InitSockets()
{
X    int status;
X    WNDCLASS class;
X
X    /*
X     * Note that WSAStartup was called by the DllEntryPoint code, so
X     * we can assume that the WinSock library has already been initialized.
X     */
X
X    class.style = 0;
X    class.cbClsExtra = 0;
X    class.cbWndExtra = 0;
X    class.hInstance = TclWinGetTclInstance();
X    class.hbrBackground = NULL;
X    class.lpszMenuName = NULL;
X    class.lpszClassName = "TclSocket";
X    class.lpfnWndProc = SocketProc;
X    class.hIcon = NULL;
X    class.hCursor = NULL;
X
X    /*
X     * Register the async notification window class and window.
X     */
X
X    socketClass = RegisterClass(&class);
X    if (!socketClass) {
X	TclWinConvertError(GetLastError());
X	WSACleanup();
X	return 0;
X    }
X    socketWindow = CreateWindowEx(0, (LPCTSTR)socketClass, "TclSocket",
X	    WS_OVERLAPPED, 0, 0, 0, 0, NULL, NULL,
X	    TclWinGetTclInstance(), NULL);
X    if (socketWindow == NULL) {
X	TclWinConvertError(GetLastError());
X	UnregisterClass((LPCTSTR)socketClass, TclWinGetTclInstance());
X	WSACleanup();
X	return 0;
X    }
X    socketsInitialized = 1;
X    Tcl_CreateExitHandler(CleanupSockets, (ClientData) NULL);
X    return 1;
}
X
/*
X *----------------------------------------------------------------------
X *
X * CleanupSockets --
X *
X *	Callback invoked during exit clean up to release the WinSock
X *      DLL.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Releases the WinSock DLL.
X *
X *----------------------------------------------------------------------
X */
X
X    /* ARGSUSED */
static void
CleanupSockets(clientData)
X    ClientData clientData;              /* Not used. */
{
X    DestroyWindow(socketWindow);
X    UnregisterClass((LPCTSTR)socketClass, TclWinGetTclInstance());
X    WSACleanup();
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpClose --
X *
X *	Close the socket.
X *
X * Results:
X *	0 if successful, the value of errno if failed.
X *
X * Side effects:
X *	Closes the socket.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
TcpClose(instanceData, inFile, outFile)
X    ClientData instanceData;	/* The socket to close. */
X    Tcl_File inFile, outFile;	/* Unused. */
{
X    SocketInfo *infoPtr = (SocketInfo *) instanceData;
X    int errorCode = 0;
X
X    /*
X     * We assume that inFile==outFile==sock and so only clean up one of them.
X     */
X    
X    if (closesocket(infoPtr->socket) == SOCKET_ERROR) {
X	TclWinConvertWSAError(WSAGetLastError());
X	errorCode = errno;
X    }
X
X    /*
X     * Delete a file handler that may be active for this socket.
X     * Channel handlers are already deleted in the generic IO close
X     * code which called this function.
X     */
X    
X    Tcl_DeleteFileHandler(infoPtr->file);
X
X    Tcl_FreeFile(infoPtr->file);
X
X    /*
X     * Remove the socket from socketList.
X     */
X
X    if (infoPtr == socketList) {
X	socketList = infoPtr->nextPtr;
X    } else {
X	SocketInfo *p;
X	for (p = socketList; p != NULL; p = p->nextPtr) {
X	    if (p->nextPtr == infoPtr) {
X		p->nextPtr = infoPtr->nextPtr;
X		break;
X	    }
X	}
X    }
X    ckfree((char *) infoPtr);
X
X    return errorCode;
}
X
/*
X *----------------------------------------------------------------------
X *
X * CreateSocket --
X *
X *	This function opens a new socket and initializes the
X *	SocketInfo structure.
X *
X * Results:
X *	Returns a new SocketInfo, or NULL with an error in interp.
X *
X * Side effects:
X *	Adds a new socket to the socketList.
X *
X *----------------------------------------------------------------------
X */
X
static SocketInfo *
CreateSocket(interp, port, host, server)
X    Tcl_Interp *interp;		/* For error reporting; can be NULL. */
X    int port;			/* Port number to open. */
X    char *host;			/* Name of host on which to open port. */
X    int server;			/* 1 if socket should be a server socket,
X				 * else 0 for a client socket. */
{
X    int status;
X    struct sockaddr_in sockaddr;	/* Socket address */
X    struct hostent *hostent;		/* Host database entry */
X    struct in_addr addr;		/* For 64/32 bit madness */
X    struct linger ling;			/* For making sockets linger. */
X    SOCKET sock;
X    SocketInfo *infoPtr;
X
X    if (TclHasSockets(interp) != TCL_OK) {
X	return NULL;
X    }
X
X    (void) memset((char *) &sockaddr, '\0', sizeof(struct sockaddr_in));
X    sockaddr.sin_family = AF_INET;
X    sockaddr.sin_port = htons((short) (port & 0xFFFF));
X    hostent = gethostbyname(host);
X    if (hostent != NULL) {
X	memcpy((char *) &addr,
X	    (char *) hostent->h_addr_list[0], (size_t) hostent->h_length);
X    } else {
X	addr.s_addr = inet_addr(host);
X	if (addr.s_addr == (unsigned long)-1) {
X	    goto error;
X	}
X    }
X
X    /*
X     * There is a rumor that this assignment may require care on
X     * some 64 bit machines.
X     */
X
X    sockaddr.sin_addr.s_addr = addr.s_addr;
X
X    sock = socket(AF_INET, SOCK_STREAM, 0);
X    if (sock == INVALID_SOCKET) {
X	goto error;
X    }
X
X    /*
X     * Set kernel space buffering
X     */
X
X    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);
X
X    /*
X     * Make socket close down gracefully.
X     */
X    
X    ling.l_onoff = 1;
X    ling.l_linger = 0;
X    (void) setsockopt(sock, SOL_SOCKET, SO_LINGER, (char *) &ling,
X            sizeof(ling));
X
X    if (server) {
X	/*
X	 * Set up to reuse server addresses automatically and bind to the
X	 * specified port.
X	 */
X    
X	status = 1;
X	(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
X		sizeof(status));
X	status = bind(sock, (struct sockaddr *) &sockaddr, sizeof(sockaddr));
X	if (status != SOCKET_ERROR) {
X	    listen(sock, 5);
X	}
X    } else {
X	/*
X	 * Attempt to connect. The connect may fail at present with an
X	 * EINPROGRESS but at a later time it will complete. The caller
X	 * will set up a file handler on the socket if she is interested in
X	 * being informed when the connect completes.
X	 */
X
X	status = connect(sock, (struct sockaddr *) &sockaddr,
X		sizeof(sockaddr));
X    }
X
X    if (status == SOCKET_ERROR) {
X	TclWinConvertWSAError(WSAGetLastError());
X        if (interp != NULL) {
X            Tcl_AppendResult(interp, "couldn't open socket: ",
X                    Tcl_PosixError(interp), (char *) NULL);
X        }
X        closesocket(sock);
X        return NULL;
X    }
X
X    /*
X     * Allocate a new SocketInfo for this socket.
X     */
X
X    infoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
X    infoPtr->flags = 0;
X    infoPtr->checkMask = 0;
X    infoPtr->watchMask = 0;
X    infoPtr->socket = sock;
X    infoPtr->file = Tcl_GetFile((ClientData) infoPtr, TCL_WIN_SOCKET);
X
X    /*
X     * Add this socket to the global list of sockets.
X     */
X
X    infoPtr->nextPtr = socketList;
X    socketList = infoPtr;
X
X    return infoPtr;
X
X  error:
X    TclWinConvertWSAError(WSAGetLastError());
X    if (interp != NULL) {
X	Tcl_AppendResult(interp, "couldn't open socket: ",
X		Tcl_PosixError(interp), (char *) NULL);
X    }
X    return NULL;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenTcpClient --
X *
X *	Opens a TCP client socket and creates a channel around it.
X *
X * Results:
X *	The channel or NULL if failed.  An error message is returned
X *	in the interpreter on failure.
X *
X * Side effects:
X *	Opens a client socket and creates a new channel.
X *
X *----------------------------------------------------------------------
X */
X
Tcl_Channel
Tcl_OpenTcpClient(interp, port, host)
X    Tcl_Interp *interp;			/* For error reporting; can be NULL. */
X    int port;				/* Port number to open. */
X    char *host;				/* Host on which to open port. */
{
X    Tcl_Channel chan;
X    SocketInfo *infoPtr;
X    char channelName[20];
X
X    /*
X     * Create a new client socket and wrap it in a channel.
X     */
X
X    infoPtr = CreateSocket(interp, port, host, 0);
X    if (infoPtr == NULL) {
X	return NULL;
X    }
X
X    infoPtr->acceptProc = NULL;
X    infoPtr->acceptProcData = (ClientData) NULL;
X
X    sprintf(channelName, "sock%d", infoPtr->socket);
X
X    chan = Tcl_CreateChannel(&tcpChannelType, channelName, infoPtr->file,
X	    infoPtr->file, (ClientData) infoPtr);
X
X    /*
X     * Sockets start out with EOL translation set to "auto".
X     */
X
X    return chan;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_OpenTcpServer --
X *
X *	Opens a TCP server socket and creates a channel around it.
X *
X * Results:
X *	The channel or NULL if failed.  An error message is returned
X *	in the interpreter on failure.
X *
X * Side effects:
X *	Opens a server socket and creates a new channel.
X *
X *----------------------------------------------------------------------
X */
X
Tcl_Channel
Tcl_OpenTcpServer(interp, port, host, acceptProc, acceptProcData)
X    Tcl_Interp *interp;			/* For error reporting - may be
X                                         * NULL. */
X    int port;				/* Port number to open. */
X    char *host;				/* Name of local host. */
X    Tcl_TcpAcceptProc *acceptProc;	/* Callback for accepting connections
X                                         * from new clients. */
X    ClientData acceptProcData;		/* Data for the callback. */
{
X    Tcl_Channel chan;
X    SocketInfo *infoPtr;
X    char channelName[20];
X
X    /*
X     * Create a new client socket and wrap it in a channel.
X     */
X
X    infoPtr = CreateSocket(interp, port, host, 1);
X    if (infoPtr == NULL) {
X	return NULL;
X    }
X
X    infoPtr->acceptProc = acceptProc;
X    infoPtr->acceptProcData = acceptProcData;
X
X    /*
X     * Set up the callback mechanism for accepting connections
X     * from new clients. The caller will use Tcl_TcpRegisterCallback
X     * to register a callback to call when a new connection is
X     * accepted.
X     */
X
X    Tcl_CreateFileHandler(infoPtr->file, TCL_READABLE, TcpAccept,
X            (ClientData) infoPtr);
X
X    sprintf(channelName, "sock%d", infoPtr->socket);
X
X    chan = Tcl_CreateChannel(&tcpChannelType, channelName, NULL, NULL,
X            (ClientData) infoPtr);
X
X    /*
X     * Sockets start out with EOL translation set to "auto".
X     */
X
X    return chan;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpAccept --
X *	Accept a TCP socket connection.  This is called by the event loop,
X *	and it in turns calls any registered callbacks for this channel.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Evals the Tcl script associated with the server socket.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static void
TcpAccept(data, mask)
X    ClientData data;			/* Callback token. */
X    int mask;				/* Not used. */
{
X    SocketInfo *infoPtr = (SocketInfo *) data;
X    SocketInfo *newInfoPtr;
X    SOCKET sock;
X    struct sockaddr_in addr;		/* The remote address */
X    int len;				/* For accept interface */
X    Tcl_Channel  chan;			/* Channel instance created. */
X    char channelName[20];
X
X    len = sizeof(struct sockaddr_in);
X    sock = accept(infoPtr->socket, (struct sockaddr *)&addr, &len);
X
X    infoPtr->checkMask &= ~TCL_READABLE;
X
X    if (sock == INVALID_SOCKET) {
X        return;
X    }
X
X    /*
X     * Clear the inherited event mask.
X     */
X
X    WSAAsyncSelect(sock, socketWindow, 0, 0);
X
X    newInfoPtr = (SocketInfo *) ckalloc((unsigned) sizeof(SocketInfo));
X    newInfoPtr->flags = 0;
X    newInfoPtr->checkMask = 0;
X    newInfoPtr->watchMask = 0;
X    newInfoPtr->socket = sock;
X    newInfoPtr->acceptProc = NULL;
X    newInfoPtr->acceptProcData = (ClientData) NULL;
X    newInfoPtr->file = Tcl_GetFile((ClientData) newInfoPtr, TCL_WIN_SOCKET);
X
X    sprintf(channelName, "sock%d", newInfoPtr->socket);
X
X    chan = Tcl_CreateChannel(&tcpChannelType, channelName, newInfoPtr->file,
X	    newInfoPtr->file, (ClientData) newInfoPtr);
X
X    if (chan == (Tcl_Channel) NULL) {
X	closesocket(newInfoPtr->socket);
X	Tcl_FreeFile(newInfoPtr->file);
X	ckfree((char *) newInfoPtr);
X	return;
X    } 
X
X    /*
X     * Add this socket to the global list of sockets.
X     */
X
X    newInfoPtr->nextPtr = socketList;
X    socketList = newInfoPtr;
X
X    /*
X     * Invoke the accept callback procedure.
X     */
X
X    if (infoPtr->acceptProc != NULL) {
X	(infoPtr->acceptProc) (infoPtr->acceptProcData, chan,
X		inet_ntoa(addr.sin_addr));
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpInput --
X *
X *	Reads from a TCP socket under Windows.
X *
X * Results:
X *	The number of bytes read or -1 on error.
X *
X * Side effects:
X *	Consumes input from the socket.
X *
X *----------------------------------------------------------------------
X */
X
static int
TcpInput(instanceData, inFile, buf, toRead, errorCodePtr)
X    ClientData instanceData;		/* The socket state. */
X    Tcl_File inFile;			/* Not used. */
X    char *buf;				/* Where to store data. */
X    int toRead;				/* Maximum number of bytes to read. */
X    int *errorCodePtr;			/* Where to store error codes. */
{
X    SocketInfo *infoPtr = (SocketInfo *) instanceData;
X    unsigned long bytesAvailable;
X    int bytesRead;
X    
X    *errorCodePtr = 0;
X
X    if (ioctlsocket(infoPtr->socket, FIONREAD, &bytesAvailable) == 0) {
X        if (bytesAvailable < toRead) {
X            toRead = bytesAvailable;
X        }
X        if ((toRead == 0) && !(infoPtr->flags & SOCKET_ASYNCH)) {
X            toRead = 1;
X        }
X    } else {
X        TclWinConvertWSAError(WSAGetLastError());
X        if (errno == ECONNRESET) {
X            return 0;
X        }
X        *errorCodePtr = errno;
X        return -1;
X    }
X
X    if ((toRead == 0) && (bytesAvailable == 0)) {
X        *errorCodePtr = EAGAIN;
X        return -1;
X    }
X    bytesRead = recv(infoPtr->socket, buf, toRead, 0);
X    if (bytesRead == SOCKET_ERROR) {
X	TclWinConvertWSAError(WSAGetLastError());
X        if (errno == ECONNRESET) {
X            return 0;
X        }
X        *errorCodePtr = errno;
X        return -1;
X    }
X
X    /*
X     * Clear the readable bit in the check mask.  If an async handler
X     * is still registered for this socket, then it will generate a new
X     * event if there is still data available.  When the event is
X     * processed, the readable bit will be turned back on.
X     */
X
X    infoPtr->checkMask &= ~TCL_READABLE;
X
X    return bytesRead;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpOutput --
X *
X *	Writes data to a socket under Windows.
X *
X * Results:
X *	The number of bytes written or -1 on failure.
X *
X * Side effects:
X *	Produces output on the socket.
X *
X *----------------------------------------------------------------------
X */
X
static int
TcpOutput(instanceData, outFile, buf, toWrite, errorCodePtr)
X    ClientData instanceData;		/* The socket state. */
X    Tcl_File outFile;			/* The socket to write to. */
X    char *buf;				/* Where to get data. */
X    int toWrite;			/* Maximum number of bytes to write. */
X    int *errorCodePtr;			/* Where to store error codes. */
{
X    SocketInfo *infoPtr = (SocketInfo *) instanceData;
X    int bytesWritten;
X
X    *errorCodePtr = 0;
X
X    bytesWritten = send(infoPtr->socket, buf, toWrite, 0);
X    if (bytesWritten == SOCKET_ERROR) {
X	TclWinConvertWSAError(WSAGetLastError());
X        *errorCodePtr = errno;
X        return -1;
X    }
X
X    /*
X     * Clear the readable bit in the check mask.  If an async handler
X     * is still registered for this socket, then it will generate a new
X     * event if there is still data available.  When the event is
X     * processed, the readable bit will be turned back on.
X     */
X
X    infoPtr->checkMask &= ~TCL_WRITABLE;
X
X    return bytesWritten;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpBlockMode--
X *
X *	Implements blocking and nonblocking on a socket under Windows.
X *
X * Results:
X *	0 on success, errno when failed.
X *
X * Side effects:
X *	Sets the device into blocking or nonblocking mode
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
TcpBlockMode(instanceData, inFile, outFile, mode)
X    ClientData instanceData;		/* Socket state. */
X    Tcl_File inFile;			/* Input side of socket. */
X    Tcl_File outFile;			/* Output side of socket. */
X    int mode;				/* The mode to set: one of
X                                         * TCL_MODE_BLOCKING or
X                                         * TCL_MODE_NONBLOCKING. */
{
X    SocketInfo *infoPtr = (SocketInfo *) instanceData;
X
X    if (mode == TCL_MODE_BLOCKING) {
X	infoPtr->flags |= SOCKET_ASYNCH;
X    } else {
X	infoPtr->flags &= ~SOCKET_ASYNCH;
X    }
X    return 0;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TcpBufferSize --
X *
X *	Returns the preferred buffer size for TCP channels.
X *
X * Results:
X *	The preferred buffer size.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
X	/* ARGSUSED */
static int
TcpBufferSize(clientData)
X    ClientData clientData;		/* Unused. */
{
X    return TCP_BUFFER_SIZE;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclWinWatchSocket --
X *
X *	This function imlements the socket specific portion of the
X *	Tcl_WatchFile function in the notifier.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	The watched socket will be placed into non-blocking mode, and
X *	an entry on the asynch handler list will be created if necessary. 
X *
X *----------------------------------------------------------------------
X */
X
void
TclWinWatchSocket(file, mask)
X    Tcl_File file;		/* Socket to watch. */
X    int mask;			/* OR'ed combination of TCL_READABLE,
X				 * TCL_WRITABLE, and TCL_EXCEPTION:
X				 * indicates conditions to wait for
X				 * in select. */
{
X    SocketInfo *infoPtr = (SocketInfo *) Tcl_GetFileInfo(file, NULL);
X
X    infoPtr->flags |= SOCKET_WATCH;
X
X    /*
X     * If the new mask includes more conditions than the current mask,
X     * then we mark the socket as unregistered so it will be reregistered
X     * the next time we enter Tcl_WaitForEvent.
X     */
X
X    mask |= infoPtr->watchMask;
X    if (infoPtr->watchMask != mask) {
X	infoPtr->flags &= ~SOCKET_REGISTERED;
X	infoPtr->watchMask = mask;
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclWinNotifySocket --
X *
X *	Set up event notifiers for any sockets that are being watched.
X *	Also, clean up any sockets that are no longer being watched.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	Adds and removes asynch select handlers.
X *
X *----------------------------------------------------------------------
X */
X
void
TclWinNotifySocket()
{
X    SocketInfo *infoPtr;
X
X    if (socketList == NULL) {
X	return;
X    }
X
X    /*
X     * Establish or remove any notifiers.
X     */
X
X    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
X	if (infoPtr->flags & SOCKET_WATCH) {
X	    if (!(infoPtr->flags & SOCKET_REGISTERED)) {
X		int events = 0;
X
X		if (infoPtr->watchMask & TCL_READABLE) {
X		    events |= (FD_READ | FD_ACCEPT | FD_CLOSE);
X		} else if (infoPtr->watchMask & TCL_WRITABLE) {
X		    events |= (FD_WRITE | FD_CONNECT);
X		}
X		WSAAsyncSelect(infoPtr->socket, socketWindow, SOCKET_MESSAGE,
X			events);
X	    }
X	} else {
X	    if (infoPtr->flags & SOCKET_REGISTERED) {
X		WSAAsyncSelect(infoPtr->socket, socketWindow, 0, 0);
X	    }
X	}
X    }
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclWinSocketReady --
X *
X *	This function is invoked by Tcl_FileReady to check whether
X *	the specified conditions are present on a socket.
X *
X * Results:
X *	The return value is 0 if none of the conditions specified by
X *	mask were true for socket the last time the system checked.
X *	If any of the conditions were true, then the return value is a
X *	mask of those that were true.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
int
TclWinSocketReady(file, mask)
X    Tcl_File file;	/* File handle for a stream. */
X    int mask;			/* OR'ed combination of TCL_READABLE,
X				 * TCL_WRITABLE, and TCL_EXCEPTION:
X				 * indicates conditions caller cares about. */
{
X    SocketInfo *infoPtr = (SocketInfo *) Tcl_GetFileInfo(file, NULL);
X
X    return (infoPtr->checkMask & mask);
}
X
/*
X *----------------------------------------------------------------------
X *
X * SocketProc --
X *
X *	This function is called when WSAAsyncSelect has been used
X *	to register interest in a socket event, and the event has
X *	occurred.
X *
X * Results:
X *	0 on success.
X *
X * Side effects:
X *	The checkMask for the given socket is updated to reflect the
X *	event which occured.
X *
X *----------------------------------------------------------------------
X */
X
static LRESULT CALLBACK
SocketProc(hwnd, message, wParam, lParam)
X    HWND hwnd;
X    UINT message;
X    WPARAM wParam;
X    LPARAM lParam;
{
X    int event;
X    SOCKET socket;
X    SocketInfo *infoPtr;
X
X    if ((hwnd != socketWindow) || (message != SOCKET_MESSAGE)) {
X	return DefWindowProc(hwnd, message, wParam, lParam);
X    }
X    event = WSAGETSELECTEVENT(lParam);
X    socket = (SOCKET) wParam;
X
X    /*
X     * Find the specified socket on the socket list and update its
X     * check flags.
X     */
X
X    for (infoPtr = socketList; infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
X	if (infoPtr->socket == socket) {
X
X	    if (event & (FD_READ | FD_ACCEPT | FD_CLOSE)) {
X		infoPtr->checkMask |= TCL_READABLE;
X	    }
X	    if (event & (FD_WRITE | FD_CONNECT)) {
X		infoPtr->checkMask |= TCL_WRITABLE;
X	    }
X	    break;
X	}
X    }
X    return 0;
}
X
/*
X *----------------------------------------------------------------------
X *
X * Tcl_GetHostName --
X *
X *	Returns the name of the local host.
X *
X * Results:
X *	Returns a string containing the host name, or NULL on error.
X *	The returned string must be freed by the caller.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
char *
Tcl_GetHostName()
{
X    static int  hostnameInitialized = 0;
X    static char hostname[255];	/* This buffer should be big enough for
X                                 * hostname plus domain name. */
X
X    if (TclHasSockets(NULL) != TCL_OK) {
X	return "";
X    }
X
X    if (hostnameInitialized) {
X        return hostname;
X    }
X    if (gethostname(hostname, 100) == 0) {
X        hostnameInitialized = 1;
X        return hostname;
X    }
X    return (char *) NULL;
}
X
/*
X *----------------------------------------------------------------------
X *
X * TclHasSockets --
X *
X *	This function determines whether sockets are available on the
X *	current system and returns an error in interp if they are not.
X *	Note that interp may be NULL.
X *
X * Results:
X *	Returns TCL_OK if the system supports sockets, or TCL_ERROR with
X *	an error in interp.
X *
X * Side effects:
X *	None.
X *
X *----------------------------------------------------------------------
X */
X
int
TclHasSockets(interp)
X    Tcl_Interp *interp;
{
X    if (hasSockets) {
X	if (!socketsInitialized) {
X	    if (!InitSockets()) {
X		Tcl_AppendResult(interp,
X			"couldn't initialize WinSock subsystem", NULL);
X		return TCL_ERROR;
X	    }
X	}
X	return TCL_OK;
X    }
X    if (interp != NULL) {
X	Tcl_AppendResult(interp, "sockets are not available on this system",
X		NULL);
X    }
X    return TCL_ERROR;
}
SHAR_EOF
chmod 0644 tclWinSock.c ||
echo 'restore of tclWinSock.c failed'
Wc_c="`wc -c < 'tclWinSock.c'`"
test 27898 -eq "$Wc_c" ||
	echo 'tclWinSock.c: original size 27898, current size' "$Wc_c"
fi
# ============= tclX.h ==============
if test -f 'tclX.h' -a X"$1" != X"-c"; then
	echo 'x - skipping tclX.h (File already exists)'
else
echo 'x - extracting tclX.h (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'tclX.h' &&
/*
X * This is a hack to prevent my interface changes from conflicting with tcl.h
X * or tclInt.h
X */
#define Tcl_TcpAcceptProc _Tcl_TcpAcceptProc
#define CreateSocket _CreateSocket
X
X
/*
X * These belong in tcl.h, they are only here for my convenience
X */
X
typedef void	(Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
X			Tcl_Channel chan, char *address, int port));
X
EXTERN Tcl_Channel      Tcl_OpenTcp _ANSI_ARGS_((Tcl_File sock, int server,
X			    Tcl_TcpAcceptProc *acceptProc,
X			    ClientData callbackData));
X
X
X
X
X
X
/*
X * These belong in tclInt.h, they are only here for my convenience
X */
X
EXTERN int              CommonBufferSize _ANSI_ARGS_((ClientData instanceData));
EXTERN int		CommonBlockMode _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile, int mode));
EXTERN int		CommonOutput _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File outFile, char *buf, int toWrite,
X			    int *errorCode));
X
EXTERN void		TcpAccept _ANSI_ARGS_((ClientData data, int mask));
EXTERN int		TcpClose _ANSI_ARGS_((ClientData instanceData,
X			    Tcl_File inFile, Tcl_File outFile));
EXTERN int		TcpInput _ANSI_ARGS_((ClientData instanceData,
X		            Tcl_File infile, char *buf, int toRead,
X        		    int *errorCode));
EXTERN int		TclSockInetAtoN _ANSI_ARGS_((Tcl_Interp *interp,
X			     char *string, struct in_addr *proto));
X
X
X
X
X
/*
X * These belong in tclWinPort.h, they are only here for my convenience
X */
X
#ifdef _TCLWINPORT
X
#define SocketClose(s) Win_SocketClose(s)
#define GetError TclWinConvertWSAError(WSAGetLastError())
X
#endif
X
X
/*
X * These belong in tclMacPort.h, they are only here for my convenience
X */
X
#ifdef _MACPORT
X
#define SocketClose(s) close((int)(s))
#define GetError
X
#endif
X
X
X
/*
X * These belong in tclUnixPort.h, they are only here for my convenience
X */
X
#ifdef _TCLUNIXPORT
X
#define SocketClose(s) close((int)(s))
#define GetError
X
#endif
SHAR_EOF
chmod 0644 tclX.h ||
echo 'restore of tclX.h failed'
Wc_c="`wc -c < 'tclX.h'`"
test 1905 -eq "$Wc_c" ||
	echo 'tclX.h: original size 1905, current size' "$Wc_c"
fi
exit 0
