#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	Connect.n
#	INSTALL
#	README
#	main.c.patch
#	tclRawTCP.c
#	tclRawTCP.h
#	tcpdemo
#	tkRawTCP.c
# This archive created: Mon Mar 22 14:11:34 1993
# By:	Vivek Khera (khera@cs.duke.edu)
# 	Duke University CS Dept.
export PATH; PATH=/bin:$PATH
echo shar: extracting "'Connect.n'" '(5315 characters)'
if test -f 'Connect.n'
then
	echo shar: will not over-write existing file "'Connect.n'"
else
sed 's/^X//' << \SHAR_EOF > 'Connect.n'
X'\"
X'\" Copyright 1989 Regents of the University of California
X'\" Permission to use, copy, modify, and distribute this
X'\" documentation for any purpose and without fee is hereby
X'\" granted, provided that this notice appears in all copies.
X'\" The University of California makes no representations about
X'\" the suitability of this material for any purpose.  It is
X'\" provided "as is" without express or implied warranty.
X'\" 
X'\" $Id: Connect.n,v 1.2 1993/03/19 18:13:55 khera Exp $
X'
X.so man.macros
X.de UL
X\\$1\l'|0\(ul'\\$2
X..
X.HS Connect tcl
X.BS
X.SH NAME
Xaccept, connect, filehandler, shutdown \- Opens and handles TCP connections
X.BE
X.TP
X\fBaccept \fIfile\fR
XAccepts a connection on an existing server \fIfile\fR (created with the
X\fIconnect\fR command) and returns an identifier with may be used in
Xcommands like \fBread\fR, \fBwrite\fR and \fBclose\fR.
X
XIf the listening socket is a INET domain socket, the remote machine IP
Xaddress and remote port number of the connection are stored as a list in
Xthe global array \fBconnect_info\fR in the element referenced by the
Xidentifier returned from \fBaccept\fR.
X
XIf the socket is a UNIX domain socket, then an empty string is stored in
Xthe array \fBconnect_info\fR.
X.TP
X\fBconnect \fR?\fI"-server"\fR? \fIhost\fR \fIport\fR
XConnects to or sets up an INET server with TCP and returns an identifier
Xthat may be used in future invocations of commands.
X
XIf \fI"-server"\fR is specified then a listening socket is set up. If \fIhost\fR
Xis a non-empty string, this specifies the remote address in the same
Xway as bind(2) does. If \fIhost\fR is an empty string, then any machine
Xmay connect. If
X\fIport\fR is empty or 0, then the system will select a port number for you.
XThe returned identifier may be used in commands like \fBaccept\fR,
X\fBclose\fR and \fBfilehandler\fR. The port number of the connection is
Xsaved in the global array \fBconnect_info\fR in the element with the same
Xname as the returned identifier. You may only use the returned identifier
Xin the \fBclose\fR, \fBaccept\fR and \fBfilehandler\fR commands.
X
XIf \fI"-server"\fR is not specified, then a connection is made to a remote
Xserver. The returned identifier may be used in commands 
Xlike \fBread\fR, \fBwrite\fR, \fBgets\fR, \fBputs\fR
Xand \fBclose\fR.  \fIhost\fR gives the name of the host to connect to.
X\fIport\fR gives the desired port.
X
XEven if every socket is opened for both reading and writing, \fBseek\fR
Xmust not be invoked between a read and a write.
X.TP
X\fBconnect \fR?\fI"-server"\fR? \fIpath\fR
XSet up a UNIX domain socket. This command is identical to the one above
Xexcept that a UNIX domain socket is created with an address specified by
X\fIpath\fR. An empty string is stored in the global array \fBconnect_info\fR.
X.TP
X\fBshutdown \fIfile\fR \fIcode\fR
XShutdown a connection for reading, writing or both.
X
XIf \fIcode\fR is \fB"0"\fR, \fB"read"\fR or \fB"receives"\fR then further
Xreceives on \fIfile\fR will be disabled.
X
XIf \fIcode\fR is \fB"1"\fR, \fB"write"\fR or \fB"sends"\fR, then further
Xsends on \fIfile\fR will be disabled (and eof will be sent on the socket).
X
XIf \fIcode\fR is \fB"2"\fR, \fB"all"\fR or \fB"both"\fR, then further reads and
Xwrites on \fIfile\fR will be disabled.
X
X.TP
X\fBfilehandler \fIfile\fR ?\fImode\fR \fIcommand\fR?
XThe \fBfilehander\fR command is only used with Tk.  The command
Xspecifies a TCL command to be called whenever the given \fIfile\fR can
Xbe read, written, and/or when there is an exeptional condition.  The
X\fImode\fR argument indicates the situations when the \fIcommand\fR
Xwill be called.  It may be any combination of the following values:
X.RS
X.TP
X\fBr\fR
XCall \fIcommand\fR whenever the there is data to read from the socket.
XThe command procedure is called with two arguemnts: \fBr\fR to
Xindicate that there is something to read, and a \fIfile\fR id
Xthat can be used for reading.  The procedure should read at least some
Xdata from the socket, or otherwise the procedure will be called
Xcontinuously. 
X.TP
X\fBw\fR
XCall \fIcommand\fR whenever data can be written to the socket.  This
Xoption is rarely used since most sockets can be written most of the time.
X.TP
X\fBe\fR
XCall \fIcommand\fR whenever there is an exceptional condition pending
Xon the socket.  The \fIcommand\fR procedure is called with two
Xarguments: an \fBe\fR to indicate exception, and a \fIfile\fR id that
Xcan be used as an argument to \fBread\fR, \fBclose\fR etc.
X.PP
XThe same \fIcommand\fR may be used for several different conditions.
XThe first argument supplied to \fIcommand\fR denotes always the
Xcondition type.  If there are several different conditions (e.g. the
Xfile can be both read and written), the \fIcommand\fR will be called
Xseparately for each condition.
X
XSpecifying a new command with \fBfilehandler\fR will remove any
Xearlier command from use.  NOTE!  Currently there is a small memory
Xleak whenever a new command replaces an existing one.
X
XWhen a \fIcommand\fR procedure is specified for the socket via
X\fBfilehandler\fR command, the socket will be automatically closed and the
Xassociated file handler deleted if there is a pending eof or error
Xcondition after executing the user supplied \fIcommand\fR procedure.
X.SH AUTHOR
XPekka Nikander, Telecom Finland (Pekka.Nikander@ajk.tele.fi)
XExtended by Tim MacKenzie (tym@dibbler.cs.monash.edu.au)
SHAR_EOF
if test 5315 -ne "`wc -c < 'Connect.n'`"
then
	echo shar: error transmitting "'Connect.n'" '(should have been 5315 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'INSTALL'" '(916 characters)'
if test -f 'INSTALL'
then
	echo shar: will not over-write existing file "'INSTALL'"
else
sed 's/^X//' << \SHAR_EOF > 'INSTALL'
Xto install this:
X
X1) unpack the tk3.2 distribution.
X2) copy the tclRawTCP.? files into the tcl subdirectory.  add the
X   tclRawTCP.o object to the list of objects to be built, and possibly
X   add the tclRawTCP.h file to the install targets.
X3) copy the tkRawTCP.c file to the tk directory, and add tkRawTCP.o to the
X   list of objects to be built.
X4) apply the main.c.patch file to main.c to build the commands into wish.
X5) copy the Connect.n man page to the tcl/doc directory if you want.
X6) rebuild the whole thing
X7) run the demo to see it in action.
X8) install it.
X
XThis is a slightly re-organized version of the one by Tim MacKenzie as
Xdescribed in the README file.  I've split out the tk code so that the socket
Xcode can be used without tk, and I've updated it to compile and run with the
Xtk3.2 distribution.  At least the demo.tcl file runs fine...
X
XV. Khera <khera@cs.duke.edu>
XMon Mar 22 14:09:49 EST 1993
SHAR_EOF
if test 916 -ne "`wc -c < 'INSTALL'`"
then
	echo shar: error transmitting "'INSTALL'" '(should have been 916 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'README'" '(1430 characters)'
if test -f 'README'
then
	echo shar: will not over-write existing file "'README'"
else
sed 's/^X//' << \SHAR_EOF > 'README'
XThis is a raw tcp package for tck/tk. It is based on tcpConnect by
XPekka Nikander <pnr@innopoli.ajk.tele.fi> and has been modified
Xto create servers, accept connections, shutdown parts of connections and
Xuse UNIX domain sockets.
X
XThere are undoubtedly problems with this package, please let me know about them
Xso they can be repaired.
X
XThere are four commands:
X1) connect [-server] (host port)|(path)
X    returns a file identifier in the same way as the 'open' tcl command.
X    If -server is specified, create a listening socket, otherwise connect to
X	a remote server.
X    If two other parameters are specified, these are assumed to be the host
X	and port of a INET address. If only one other parameter is given it
X	is assumed to be a path for a UNIX domain socket.
X    For INET domain sockets, the global array connect_info(file_id) is set
X	to the port obtained or connected to.
X
X2) accept file_id
X    Accept a connection on a socket created with 'connect -server'. Returns
X    a fileid in the same way as 'open'. For INET sockets, the global array
X    connect_info(file_id) will contain the remote host ip and port number.
X
X3) shutdown file_id type
X    Shuts down a full duplex connection for reading, writing or both.
X
X4) filehandler file_id [type procedure] 
X    Set up a procedure for handling events on a file (such as able to read,
X    write etc).
X
X-Tim MacKenzie (tym@dibbler.cs.monash.edu.au)
XThu Jun 25 15:11:13 EST 1992
SHAR_EOF
if test 1430 -ne "`wc -c < 'README'`"
then
	echo shar: error transmitting "'README'" '(should have been 1430 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'main.c.patch'" '(1364 characters)'
if test -f 'main.c.patch'
then
	echo shar: will not over-write existing file "'main.c.patch'"
else
sed 's/^X//' << \SHAR_EOF > 'main.c.patch'
X*** 1.72	1993/02/03 10:20:42
X--- main.c	1993/03/19 18:15:12
X***************
X*** 17,27 ****
X   */
X  
X  #ifndef lint
X! static char rcsid[] = "$Header: /usr/xtmp/khera/tk3.2/main.c,v 1.72 1993/02/03 10:20:42 ouster Exp $ SPRITE (Berkeley)";
X  #endif
X  
X  #include "tkConfig.h"
X  #include "tkInt.h"
X  
X  /*
X   * Declarations for library procedures:
X--- 17,28 ----
X   */
X  
X  #ifndef lint
X! static char rcsid[] = "$Header: /usr/xtmp/khera/tk3.2/main.c,v 1.73 1993/03/19 18:15:01 khera Exp $ SPRITE (Berkeley)";
X  #endif
X  
X  #include "tkConfig.h"
X  #include "tkInt.h"
X+ #include <tclRawTCP.h>
X  
X  /*
X   * Declarations for library procedures:
X***************
X*** 213,218 ****
X--- 214,229 ----
X      Tcl_CreateCommand(interp, "square", Tk_SquareCmd, (ClientData) w,
X  	    (void (*)()) NULL);
X  #endif
X+ 
X+     /* connect/filehandler commands */
X+     Tcl_CreateCommand(interp,"accept",Tcp_AcceptCmd,
X+ 		      (ClientData) NULL,(void (*) ()) NULL);
X+     Tcl_CreateCommand(interp,"shutdown",Tcp_ShutdownCmd,
X+ 		      (ClientData) NULL,(void (*) ()) NULL);
X+     Tcl_CreateCommand(interp,"connect",Tcp_ConnectCmd,
X+ 		      (ClientData) NULL,(void (*) ()) NULL);
X+     Tcl_CreateCommand(interp,"filehandler",Tcp_FileHandlerCmd,
X+ 		      (ClientData) NULL,(void (*) ()) NULL);
X  
X      /*
X       * Execute Wish's initialization script, followed by the script specified
SHAR_EOF
if test 1364 -ne "`wc -c < 'main.c.patch'`"
then
	echo shar: error transmitting "'main.c.patch'" '(should have been 1364 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'tclRawTCP.c'" '(12569 characters)'
if test -f 'tclRawTCP.c'
then
	echo shar: will not over-write existing file "'tclRawTCP.c'"
else
sed 's/^X//' << \SHAR_EOF > 'tclRawTCP.c'
X/*
X * tcpConnect.c --
X *
X * 	This file contains a simple Tcl "connect" command
X *	that returns an standard Tcl File descriptor (as would
X *	be returned by Tcl_OpenCmd).
X * Extended to create servers, accept connections, shutdown parts of full
X *   duplex connections and handle UNIX domain sockets.
X *
X * Author: Pekka Nikander <pnr@innopoli.ajk.tele.fi>
X * Modified: Tim MacKenzie <tym@dibbler.cs.monash.edu.au) 
X *
X * Copyright 1992 Telecom Finland
X *
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that this copyright
X * notice appears in all copies.  Telecom Finland
X * makes no representations about the suitability of this
X * software for any purpose.  It is provided "as is" without
X * express or implied warranty.
X *
X * Created: Sun Mar 22 18:20:29 1992
X * based on: Last modified: Sun Mar 22 21:34:31 1992 pnr
X * Last modified: Mon Jun 29 15:25:14 EST 1992 tym
X * 
X */
X
X#ifndef lint
Xstatic char rcsid[] = "$Id: tclRawTCP.c,v 1.4 1993/03/19 18:14:14 khera Exp $";
X#endif /* not lint */
X
X#include "tclInt.h"
X#include "tclUnix.h"
X#include "tclRawTCP.h"
X
X#include <assert.h>
X#include <string.h>
X#include <sys/types.h>
X#include <sys/socket.h>
X#include <netinet/in.h>
X#include <netdb.h>
X#include <arpa/inet.h>
X#include <sys/un.h>
X
Xstatic int inet_connect _ANSI_ARGS_((char *host, char *port,int server));
Xstatic int unix_connect _ANSI_ARGS_((char *path, int server));
X
X/*
X *------------------------------------------------------------------
X *
X * Tcp_MakeOpenFile --
X *
X *    Set up on OpenFile structure in the interpreter for a newly 
X *      opened file
X *	
X * Results:
X *	none
X *
X * Side effects:
X *	Adds an OpenFile to the list.
X *------------------------------------------------------------------
X */
X
X/* ARGSUSED */
Xstatic void
XTcp_MakeOpenFile(interp,fd,r,w)
X    Tcl_Interp *interp;
X    int fd;
X    int r,w;
X{/* Create an OpenFile structure using f and install it in the interpreter with
X  * Readable and Writable set to r and w
X  */
X    Interp *iPtr = (Interp *) interp;
X    register OpenFile *filePtr;
X
X    filePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
X
X    filePtr->f = NULL;
X    filePtr->f2 = NULL;
X
X	 /* Open the file with the correct type (doesn't handle !r && !w) */
X    filePtr->f = fdopen(fd,(r&&w)?"r+":(r?"r":"w"));
X
X	 /* Don't do buffered communication if full-duplex... it breaks! */
X	 if (r&w) setbuf(filePtr->f,0);
X
X    filePtr->readable = r;
X    filePtr->writable = w;
X    filePtr->numPids = 0;
X    filePtr->pidPtr = NULL;
X    filePtr->errorId = -1;
X
X    /*
X     * Enter this new OpenFile structure in the table for the
X     * interpreter.  May have to expand the table to do this.
X     */
X
X    TclMakeFileTable(iPtr, fd);
X    if (iPtr->filePtrArray[fd] != NULL) {
X	panic("Tcl_OpenCmd found file already open");
X    }
X    iPtr->filePtrArray[fd] = filePtr;
X}
X
X/*
X *------------------------------------------------------------------
X *
X * Tcp_ConnectCmd --
X *
X *	Open a socket connection to a given host and service.
X *	
X * Results:
X *	A standard Tcl result.
X *
X * Side effects:
X *	An open socket connection.
X *      Sets the global variable connect_info(file%d) to the obtained
X *        port when setting up server.
X *------------------------------------------------------------------
X */
X
X/* ARGSUSED */
Xint
XTcp_ConnectCmd(notUsed, interp, argc, argv)
X    ClientData notUsed;
X    Tcl_Interp *interp;
X    int argc;
X    char **argv;
X{
X    Interp *iPtr = (Interp *) interp;
X    char *host,*port;
X    int fd;
X    int server=0;
X    int unicks = 0;
X    
X    if (argc != 2 && argc != 3 &&
X	(argc != 4 || (argc == 4 && strcmp(argv[1],"-server")))) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		     " ?-server? address_spec\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X
X    if (!strcmp(argv[1],"-server"))
X	server = 1;
X
X    /*
X     * Create the connection
X     */
X    if (argc - server == 2) {/* Unix domain socket */
X	unicks = 1;
X	fd = unix_connect(argv[1+server],server);
X    } else
X	fd = inet_connect(argv[1+server], argv[2+server],server);
X
X    if (fd < 0) {
X	/* Tell them why it fell apart */
X	if (unicks)
X	    if (server)
X		Tcl_AppendResult(interp,
X		    "Couldn't setup listening socket with path \"",
X		    argv[1+server],"\" : ",Tcl_UnixError(interp),
X		    (char *) NULL);
X	    else
X		Tcl_AppendResult(interp,
X		    "Couldn't connect to \"",argv[1],"\" : ",
X		    Tcl_UnixError(interp),(char *) NULL);
X	else
X	    if (server)
X		Tcl_AppendResult(interp,
X		    "couldn't setup listening socket on port:",
X		    atoi(argv[3])==0?"any":argv[3]," using address \"",
X		    strlen(argv[2])?argv[2]:"anywhere.","\": ",
X		    Tcl_UnixError(interp), (char *)NULL);
X	    else
X		Tcl_AppendResult(interp, "couldn't open connection to \"",
X				 argv[1], "\" port \"", argv[2], "\": ",
X				 Tcl_UnixError(interp), (char *) NULL);
X	return TCL_ERROR;
X    }
X
X    sprintf(interp->result, "file%d", fd);
X    if (server && !unicks) {
X	/* Find out what port we got */
X	char buf[50];
X	struct sockaddr_in sockaddr;
X	int res,len=sizeof(sockaddr);
X	res =getsockname(fd,(struct sockaddr *) &sockaddr, &len);
X	if (res < 0) {
X	    sprintf(buf,"%d",errno);
X	} else 
X	    sprintf(buf,"%d",(int)ntohs(sockaddr.sin_port));
X	Tcl_SetVar2(interp,"connect_info",interp->result,buf,TCL_GLOBAL_ONLY);
X    }
X
X    Tcp_MakeOpenFile(iPtr,fd,1,1-server);
X
X    return TCL_OK;
X}
X
X/*
X *------------------------------------------------------------------
X *
X * Tcp_ShutdownCmd --
X *
X *    Shutdown a socket for reading writing or both using shutdown(2)
X *	
X * Results:
X *	standard tcl result.
X *
X * Side effects:
X *	Modifies the OpenFile structure appropriately
X *------------------------------------------------------------------
X */
X
X/* ARGSUSED */
Xint
XTcp_ShutdownCmd(notUsed, interp, argc, argv)
X    ClientData notUsed;
X    Tcl_Interp *interp;
X    int argc;
X    char **argv;
X{
X    Interp *iPtr = (Interp *) interp;
X    OpenFile *filePtr;
X    register FILE *f;
X    int fd;
X
X    if (argc != 3) {
X    wrong_args:
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		     " fileid <option>\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X
X    if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
X        return TCL_ERROR;
X    }
X
X    f = filePtr->f;
X    fd = fileno(filePtr->f);
X    if (!strcmp(argv[2],"0") || !strcmp(argv[2],"receives") || 
X	    !strcmp(argv[2],"read")) {
X	if (!filePtr->readable) {
X	    Tcl_AppendResult(interp, "File is not readable",(char *) NULL);
X	    return TCL_ERROR;
X	}
X	if (shutdown(fd,0)) {
X	    Tcl_AppendResult(interp, "shutdown: ", Tcl_UnixError(interp),
X		(char *) NULL);
X	    return TCL_ERROR;
X	}
X	filePtr->readable=0;
X    } else if (!strcmp(argv[2],"1") || !strcmp(argv[2],"sends") ||
X	    !strcmp(argv[2],"write")) {
X	if (!filePtr->writable) {
X	    Tcl_AppendResult(interp, "File is not writable",(char *) NULL);
X	    return TCL_ERROR;
X	}
X	if (shutdown(fd,1)) {
X	    Tcl_AppendResult(interp, "shutdown: ", Tcl_UnixError(interp),
X		(char *) NULL);
X	    return TCL_ERROR;
X	}
X	filePtr->writable=0;
X    } else if (!strcmp(argv[2],"2") || !strcmp(argv[2],"all") ||
X	    !strcmp(argv[2],"both")) {
X	if (shutdown(fd,2)) {
X	    Tcl_AppendResult(interp, "shutdown: ", Tcl_UnixError(interp),
X		(char *) NULL);
X	    return TCL_ERROR;
X	}
X	filePtr->writable=0;
X	filePtr->readable=0;
X    } else
X	goto wrong_args;
X    return TCL_OK;
X}
X	
X
X		
X/*
X *------------------------------------------------------------------
X *
X * Tcp_AcceptCmd --
X *
X *    Accept a connection on a listening socket
X *	
X * Results:
X *	a standard tcl result
X *
X * Side effects:
X *	Opens a new file.
X *      Sets the global variable connect_info(file%d) to a list
X *         containing the remote address (host ip, port) of the
X *         connector.
X *------------------------------------------------------------------
X */
X
X/* ARGSUSED */
Xint
XTcp_AcceptCmd(notUsed, interp, argc, argv)
X    ClientData notUsed;
X    Tcl_Interp *interp;
X    int argc;
X    char **argv;
X{
X    Interp *iPtr = (Interp *) interp;
X    struct sockaddr_in sockaddr;
X    int len = sizeof sockaddr;
X    OpenFile *filePtr;
X    register FILE *f;
X    int fd;
X
X    if (argc != 2) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		     " listening_socket\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X
X    if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
X        return TCL_ERROR;
X    }
X    if (!filePtr->readable) {
X        Tcl_AppendResult(interp, "\"", argv[1],
X                "\" wasn't opened for reading", (char *) NULL);
X        return TCL_ERROR;
X    }
X
X    f = filePtr->f;
X    fd = fileno(filePtr->f);
X    
X    fd = accept(fd,(struct sockaddr *)&sockaddr,&len);
X    if (fd < 0) {
X	Tcl_AppendResult(interp, "accept:", strerror(errno), (char *)NULL);
X	return TCL_ERROR;
X    }
X		
X    {/* Set the global connect_info */
X	char buf[100];
X	char nm[10];
X	if (sockaddr.sin_family == AF_INET)
X	    sprintf(buf,"%s %d",inet_ntoa(sockaddr.sin_addr),
X		   ntohs(sockaddr.sin_port));
X	else
X	    buf[0]=0;  /* Empty string for UNIX domain sockets */
X	sprintf(nm,"file%d",fd);
X	Tcl_SetVar2(interp,"connect_info",nm,buf,TCL_GLOBAL_ONLY);
X    }
X
X    /*
X     * Create the FILE*
X     */
X    Tcp_MakeOpenFile(iPtr,fd,1,1);
X
X    sprintf(interp->result, "file%d", fd);
X    return TCL_OK;
X}
X
X/*
X *----------------------------------------------------------------
X *
X * unix_connect --
X *
X * 	Create a (unix_domain) fd connection using given rendeavous
X *
X * Results:
X *	An open fd or -1.
X *
X * Side effects:
X * 	None.
X *----------------------------------------------------------------
X */
X
Xstatic int
Xunix_connect(path,server)
X    char *path;		/* Path name to create or use */
X    int  server;        /* 1->make server, 0->connect to server */
X{
X    struct sockaddr_un sockaddr;
X    int sock, status;
X    extern int errno;
X    
X    sock = socket(PF_UNIX, SOCK_STREAM, 0);
X    if (sock < 0) {
X	return -1;
X    }
X    
X    sockaddr.sun_family = AF_UNIX;
X    strncpy(sockaddr.sun_path,path,sizeof(sockaddr.sun_path)-1);
X    sockaddr.sun_path[sizeof(sockaddr.sun_path)-1] = 0; /* Just in case */
X    
X    if (server)
X	status = bind(sock,(struct sockaddr *) &sockaddr, sizeof(sockaddr));
X    else
X	status = connect(sock, (struct sockaddr *) &sockaddr, sizeof(sockaddr));
X    
X    if (status < 0) {
X	close (sock);
X	return -1;
X    }
X
X    if (server) {
X	listen(sock,5);
X	return sock;
X    }
X    
X    return sock;
X}
X
X/*
X *----------------------------------------------------------------
X *
X * inet_connect --
X *
X * 	Create a (inet domain) fd connection to given host and port.
X *
X * Results:
X *	An open fd or -1.
X *
X * Side effects:
X * 	None.
X *----------------------------------------------------------------
X */
X
Xstatic int
Xinet_connect(host, service,server)
X    char *host;			/* Host to connect, name or IP address */
X    char *service;		/* Port to use, service name or port number */
X    int  server;
X{
X    struct hostent *hostent, _hostent;
X    struct servent *servent, _servent;
X    struct protoent *protoent;
X    struct sockaddr_in sockaddr;
X    int sock, status;
X    int hostaddr, hostaddrPtr[2];
X    int servport;
X    extern int errno;
X    
X    hostent = gethostbyname(host);
X    if (hostent == NULL) {
X	hostaddr = inet_addr(host);
X	if (hostaddr == -1) {
X	    if (server && !strlen(host)) 
X		hostaddr = INADDR_ANY;
X	    else {
X		errno = EINVAL;
X		return -1;
X	    }
X	}	
X	_hostent.h_addr_list = (char **)hostaddrPtr;
X	_hostent.h_addr_list[0] = (char *)&hostaddr;
X	_hostent.h_addr_list[1] = NULL;
X	_hostent.h_length = sizeof(hostaddr);
X	_hostent.h_addrtype = AF_INET;
X	hostent = &_hostent;
X    }
X    servent = getservbyname(service, "tcp");
X    if (servent == NULL) {
X	servport = htons(atoi(service));
X	if (servport == -1) { 
X	    errno = EINVAL;
X	    return -1;
X	}
X	_servent.s_port = servport;
X	_servent.s_proto = "tcp";
X	servent = &_servent;
X    }
X    protoent = getprotobyname(servent->s_proto);
X    if (protoent == NULL) {
X	errno = EINVAL;
X	return -1;
X    }
X    
X    sock = socket(PF_INET, SOCK_STREAM, protoent->p_proto);
X    if (sock < 0) {
X	return -1;
X    }
X    
X    sockaddr.sin_family = AF_INET;
X    memcpy((char *)&(sockaddr.sin_addr.s_addr),
X	   (char *) hostent->h_addr_list[0],
X	   (size_t) hostent->h_length);
X    sockaddr.sin_port = servent->s_port;
X    
X    if (server)
X	status = bind(sock,(struct sockaddr *) &sockaddr, sizeof(sockaddr));
X    else
X	status = connect(sock, (struct sockaddr *) &sockaddr, sizeof(sockaddr));
X    
X    if (status < 0) {
X	close (sock);
X	return -1;
X    }
X
X    if (server) {
X	listen(sock,5);
X	return sock;
X    }
X    
X    return sock;
X}
SHAR_EOF
if test 12569 -ne "`wc -c < 'tclRawTCP.c'`"
then
	echo shar: error transmitting "'tclRawTCP.c'" '(should have been 12569 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'tclRawTCP.h'" '(621 characters)'
if test -f 'tclRawTCP.h'
then
	echo shar: will not over-write existing file "'tclRawTCP.h'"
else
sed 's/^X//' << \SHAR_EOF > 'tclRawTCP.h'
X/*
X * Some declarations for the commands we are going to add.
X *
X */
X
X#ifndef _tcp_connect_h
X#define _tcp_connect_h
X
X#include <tcl.h>
X
Xextern int		Tcp_AcceptCmd _ANSI_ARGS_((ClientData clientData,
X			    Tcl_Interp *interp, int argc, char **argv));
Xextern int		Tcp_ConnectCmd _ANSI_ARGS_((ClientData clientData,
X			    Tcl_Interp *interp, int argc, char **argv));
Xextern int		Tcp_ShutdownCmd _ANSI_ARGS_((ClientData clientData,
X			    Tcl_Interp *interp, int argc, char **argv));
Xextern int		Tcp_FileHandlerCmd _ANSI_ARGS_((ClientData clientData,
X			    Tcl_Interp *interp, int argc, char **argv));
X#endif _tcp_connect_h
SHAR_EOF
if test 621 -ne "`wc -c < 'tclRawTCP.h'`"
then
	echo shar: error transmitting "'tclRawTCP.h'" '(should have been 621 characters)'
fi
fi # end of overwriting check
echo shar: extracting "'tcpdemo'" '(2059 characters)'
if test -f 'tcpdemo'
then
	echo shar: will not over-write existing file "'tcpdemo'"
else
sed 's/^X//' << \SHAR_EOF > 'tcpdemo'
X#!/usr/local/bin/wish -f
X
Xglobal connect_info
Xbutton .fred -text quit -command exit
Xpack append . .fred {top fillx filly}
X
Xproc check_command {list} {
X	foreach name $list {
X		if {[info commands $name] != $name} {
X			puts stderr "You do not have the \"$name\" command installed"
X			exit
X		}
X	}
X}
X
Xcheck_command {connect accept filehandler shutdown}
X
Xproc accept_conn {type fid} {
X# Accept a connection, receive 1 line, print it out, close the connection
X	global connect_info
X	set new_conn [accept $fid]
X	set host [lindex $connect_info($new_conn) 0]
X	set port [lindex $connect_info($new_conn) 1]
X	puts stdout "Accepted new conn from host '$host', port $port ... it said:"
X	puts stdout [gets $new_conn]
X	shutdown $new_conn read
X	# Don't allow any more reads... not really necessary here... just a demo
X	puts $new_conn "Thank you for that wonderful contribution"
X	close $new_conn
X	puts stdout "Connection closed"
X}
X
X# Setup server on system allocated port with wildcard incoming address matching
Xset inet_server [connect -server "" ""] 
X# Get the port number
Xset port_num $connect_info($inet_server)
X
Xputs stdout "I got port $port_num, try 'telnet localhost $port_num'"
Xputs stdout "It will accept one line and then close the connection"
X
X# select will trigger when accept will not block if we want reads.
Xfilehandler $inet_server r accept_conn
X
Xputs stdout ""
X
X# Connect to a port on this machine and read something
X
Xif {[catch "connect localhost daytime" daytime] != 0} {
X	puts stdout "Cannot connect to 'daytime' socket on your machine!"
X	puts stdout "$daytime"
X} else {
X	puts stdout "Daytime on your machine is: [read $daytime]"
X	close $daytime
X}
X
X# Example UNIX domain server socket
X# if {[catch "connect -server /home/tym/.socket" unix_server] != 0} {
X#    puts stdout "Couldn't open socket: $unix_server"
X# } else {
X#    filehandler $unix_server r accept_conn
X# }
X#
X# Example client
X# if {[catch "connect /home/tym/.socket" unix_client] != 0} {
X#    puts stdout "Couldn't connect: $unix_client"
X# } else {
X#    puts $unix_client "hello there"
X#    ...
X# }
SHAR_EOF
if test 2059 -ne "`wc -c < 'tcpdemo'`"
then
	echo shar: error transmitting "'tcpdemo'" '(should have been 2059 characters)'
fi
chmod +x 'tcpdemo'
fi # end of overwriting check
echo shar: extracting "'tkRawTCP.c'" '(4920 characters)'
if test -f 'tkRawTCP.c'
then
	echo shar: will not over-write existing file "'tkRawTCP.c'"
else
sed 's/^X//' << \SHAR_EOF > 'tkRawTCP.c'
X/* 
X * tk support for raw TCP socket interface built into tcl
X */
X#include <assert.h>
X
X#include <tk.h>
X#include <tclInt.h>
X
Xtypedef struct {
X    Tcl_Interp *interp;
X    OpenFile *filePtr;
X    char *tclCmd;
X    char *fileId;
X} FileCmd;
X
Xstatic void HandleSocket _ANSI_ARGS_ ((ClientData clientData, int mask));
X
X/*
X *----------------------------------------------------------------
X *
X * Tcp_FileHandlerCmd --
X *
X * 	Register a file handler with an open file.  If there is
X *	already and existing handler, it will be no longer called.
X *	If no mask and command are given, any existing handler
X *	will be deleted.
X *
X * Results:
X *	A standard Tcl result. (Always OK).
X *
X * Side effects:
X *	A new file handler is associated with a give TCL open file.
X *	Whenever the file is readable, writeable and/or there is
X *	an expection condition on the file, a user supplied TCL
X *	command is called.
X *
X *----------------------------------------------------------------
X */
X
X/* ARGSUSED */
Xint
XTcp_FileHandlerCmd(notUsed, interp, argc, argv)
X    ClientData notUsed;
X    Tcl_Interp *interp;
X    int argc;
X    char **argv;
X{
X    FileCmd *cmdPtr;
X    OpenFile *filePtr;
X    int mask;
X
X    if (argc != 2 && argc != 4) {
X	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
X		  " fileId ?mode command?\"", (char *) NULL);
X	return TCL_ERROR;
X    }
X
X    if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) {
X	return TCL_ERROR;
X    }
X
X    if (argc == 2) {
X	/*
X	 * NOTE!  Currently the cmdPtr structure will be left
X	 * 	  *unfreed* if the file handler is deleted
X	 *	  via this code.  Tough.  Would need a hash table
X	 *	  or something...
X	 */
X	Tk_DeleteFileHandler(fileno(filePtr->f));
X	return TCL_OK;
X    }
X    
X    /*
X     * Find out on what situations the user is interested in.
X     * This is not the most elegant or efficient way to do this,
X     * but who cares?  (I do, but not much enough :-)
X     */
X    mask = 0;
X    if (strchr(argv[2], 'r')) {
X	mask |= TK_READABLE;
X    }
X    if (strchr(argv[2], 'w')) {
X	mask |= TK_WRITABLE;
X    }
X    if (strchr(argv[2], 'e')) {
X	mask |= TK_EXCEPTION;
X    }
X    if (mask == 0 || (strlen(argv[2]) != strspn(argv[2], "rwe"))) {
X	Tcl_AppendResult(interp, "bad mask argument \"", argv[2],
X		 "\": should be any combination of \"r\", \"w\" and \"e\"",
X			 (char *) NULL);
X	fclose(filePtr->f);
X	return TCL_ERROR;
X    }
X
X    cmdPtr = (FileCmd *)ckalloc(sizeof(FileCmd));
X    cmdPtr->interp = interp;
X    cmdPtr->filePtr = filePtr;
X    cmdPtr->tclCmd = ckalloc(strlen(argv[3]) + 1);
X    strcpy(cmdPtr->tclCmd, argv[3]);
X    cmdPtr->fileId = ckalloc(strlen(argv[1]) + 1);
X    strcpy(cmdPtr->fileId, argv[1]);
X    
X    /*
X     * NOTE! There may be an earlier file handler.   Should do something.
X     */
X    Tk_CreateFileHandler(fileno(filePtr->f), mask, HandleSocket,
X			 (ClientData) cmdPtr);
X
X    return TCL_OK;
X}
X/*
X *----------------------------------------------------------------
X *
X * HandleSocket --
X *
X * 	This procedure is called from Tk_DoOneEvent whenever there is
X *	a desired condition on a given open socket.  An Tcl command
X *	given by the user is executed to handle the connection.  If
X *	and EOF or ERROR condition is noticed, all memory resources
X *	associated with the socket are released and the socket is closed.
X *
X * Results:
X *	None.
X *
X * Side effects:
X *	The user supplied command can do anything.
X *
X *----------------------------------------------------------------
X */
X
Xstatic void
XHandleSocket(clientData, mask)
X    ClientData clientData;
X    int mask;
X{
X    int result;
X    FileCmd *cmdPtr = (FileCmd *) clientData;
X    OpenFile *filePtr = cmdPtr->filePtr;
X    Tcl_Interp *interp = cmdPtr->interp;
X    OpenFile *dummy;
X    int delete;
X    int fd = fileno(filePtr->f);
X
X    Tk_Preserve((ClientData) cmdPtr);
X
X    delete = 0;
X    if (TclGetOpenFile(interp, cmdPtr->fileId, &dummy) != TCL_OK) {
X	/* File is closed! */
X	Tcl_ResetResult(interp);
X	delete = 1;
X    } else {
X	assert(dummy == cmdPtr->filePtr);
X
X	if (mask & TK_EXCEPTION) {
X	    result = Tcl_VarEval(interp, cmdPtr->tclCmd, " e ", cmdPtr->fileId,
X				 (char *) NULL);
X	    if (result != TCL_OK) {
X		Tk_BackgroundError(interp);
X	    }
X	}
X	if (mask & TK_READABLE) {
X	    result = Tcl_VarEval(interp, cmdPtr->tclCmd, " r ", cmdPtr->fileId,
X				 (char *) NULL);
X	    if (result != TCL_OK) {
X		Tk_BackgroundError(interp);
X	    }
X	}
X	if (mask & TK_WRITABLE) {
X	    result = Tcl_VarEval(interp, cmdPtr->tclCmd, " w ", cmdPtr->fileId,
X				 (char *) NULL);
X	    if (result != TCL_OK) {
X		Tk_BackgroundError(interp);
X	    }
X	}
X	
X	if (feof(filePtr->f) || ferror(filePtr->f)) {
X	    result = Tcl_VarEval(interp, "close ", cmdPtr->fileId,
X				 (char *) NULL);
X	    if (result != TCL_OK) {
X		Tk_BackgroundError(interp);
X	    }
X	    delete = 1;
X	}
X    }
X
X    Tk_Release((ClientData) cmdPtr);
X
X    if (delete) {
X	Tk_DeleteFileHandler(fd);
X	Tk_EventuallyFree((ClientData) cmdPtr, (Tk_FreeProc *) free);
X    }
X}
SHAR_EOF
if test 4920 -ne "`wc -c < 'tkRawTCP.c'`"
then
	echo shar: error transmitting "'tkRawTCP.c'" '(should have been 4920 characters)'
fi
fi # end of overwriting check
#	End of shell archive
exit 0
