#!/bin/sh
# This is a shell archive (produced by GNU sharutils 4.2).
# To extract the files from this archive, save it to some FILE, remove
# everything before the `!/bin/sh' line above, then type `sh FILE'.
#
# Made on 1998-07-23 22:58 EDT by <pkern>.
#
# Existing files will *not* be overwritten unless `-c' is specified.
#
# This shar contains:
# length mode       name
# ------ ---------- ------------------------------------------
#   3022 -r--r--r-- tcl-socket/Tcl7.5-diffs/socket.n-diffs
#   2372 -r--r--r-- tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs
#  10730 -r--r--r-- tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs
#    129 -rw-r--r-- tcl-socket/Tcl7.5-diffs/Readme
#    454 -rwxr-xr-x tcl-socket/eg-client.t
#    651 -rwxr-xr-x tcl-socket/eg-server.t
#   1348 -rw-r--r-- tcl-socket/example/Readme
#  12265 -rwxr-xr-x tcl-socket/example/bifftk
#   5034 -rwxr-xr-x tcl-socket/example/tbiff
#    657 -rwxr-xr-x tcl-socket/example/tst-bifftk
#    418 -rwxr-xr-x tcl-socket/example/tst-via-tbiff
#    689 -rw-r--r-- tcl-socket/example/tst.mesg
#    954 -rw-r--r-- tcl-socket/example/tst.mail
#    185 -rwxr-xr-x tcl-socket/example/tst-end-to-end
#    651 -rw-r--r-- tcl-socket/Readme
#
save_IFS="${IFS}"
IFS="${IFS}:"
gettext_dir=FAILED
locale_dir=FAILED
first_param="$1"
for dir in $PATH
do
  if test "$gettext_dir" = FAILED && test -f $dir/gettext \
     && ($dir/gettext --version >/dev/null 2>&1)
  then
    set `$dir/gettext --version 2>&1`
    if test "$3" = GNU
    then
      gettext_dir=$dir
    fi
  fi
  if test "$locale_dir" = FAILED && test -f $dir/shar \
     && ($dir/shar --print-text-domain-dir >/dev/null 2>&1)
  then
    locale_dir=`$dir/shar --print-text-domain-dir`
  fi
done
IFS="$save_IFS"
if test "$locale_dir" = FAILED || test "$gettext_dir" = FAILED
then
  echo=echo
else
  TEXTDOMAINDIR=$locale_dir
  export TEXTDOMAINDIR
  TEXTDOMAIN=sharutils
  export TEXTDOMAIN
  echo="$gettext_dir/gettext -s"
fi
touch -am 1231235999 $$.touch >/dev/null 2>&1
if test ! -f 1231235999 && test -f $$.touch; then
  shar_touch=touch
else
  shar_touch=:
  echo
  $echo 'WARNING: not restoring timestamps.  Consider getting and'
  $echo "installing GNU \`touch', distributed in GNU File Utilities..."
  echo
fi
rm -f 1231235999 $$.touch
#
if mkdir _sh13861; then
  $echo 'x -' 'creating lock directory'
else
  $echo 'failed to create lock directory'
  exit 1
fi
# ============= tcl-socket/Tcl7.5-diffs/socket.n-diffs ==============
if test ! -d 'tcl-socket'; then
  $echo 'x -' 'creating directory' 'tcl-socket'
  mkdir 'tcl-socket'
fi
if test ! -d 'tcl-socket/Tcl7.5-diffs'; then
  $echo 'x -' 'creating directory' 'tcl-socket/Tcl7.5-diffs'
  mkdir 'tcl-socket/Tcl7.5-diffs'
fi
if test -f 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' &&
*** doc/socket.n	1998/07/20 17:27:45	1.1
--- doc/socket.n	1998/07/20 18:27:15
***************
*** 23,30 ****
X  This command opens a network socket and returns a channel
X  identifier that may be used in future invocations of commands like
X  \fBread\fR, \fBputs\fR and \fBflush\fR.
! At present only the TCP network protocol is supported;  future
! releases may include support for additional protocols.
X  The \fBsocket\fR command may be used to open either the client or
X  server side of a connection, depending on whether the \fB\-server\fR
X  switch is specified.
--- 23,30 ----
X  This command opens a network socket and returns a channel
X  identifier that may be used in future invocations of commands like
X  \fBread\fR, \fBputs\fR and \fBflush\fR.
! At present only the TCP network and UNIX-domain protocols are supported;
! future releases may include support for additional protocols.
X  The \fBsocket\fR command may be used to open either the client or
X  server side of a connection, depending on whether the \fB\-server\fR
X  switch is specified.
***************
*** 66,71 ****
--- 66,78 ----
X  socket is in nonblocking mode and a \fBgets\fR or \fBflush\fR is done on
X  the socket before the connection attempt succeeds or fails, the operation
X  returns immediately and \fBfblocked\fR on the socket returns 1.
+ .TP
+ \fB\-local\fR
+ The \fB\-local\fR option will cause the client socket to be connected
+ to a unix-domain socket.
+ The \fIport\fR argument is the pathname to the unix-domain socket.
+ The \fIhost\fR argument is ignored (it must exist but it can be just
+ an empty string).
X  
X  .SH "SERVER SOCKETS"
X  .PP
***************
*** 87,92 ****
--- 94,104 ----
X  interfaces.  If the option is omitted then the server socket is bound
X  to the special address INADDR_ANY so that it can accept connections from
X  any interface.
+ .TP
+ \fB\-local\fI pathname\fR
+ Using this option establishes a server with a unix-domain socket.
+ \fIPathname\fR gives the location of the unix-domain socket to be
+ used to connect to this server.
X  .PP
X  Server channels cannot be used for input or output; their sole use is to
X  accept new client connections. The channels created for each incoming
***************
*** 109,114 ****
--- 121,128 ----
X  and the port number for the socket. If the host name cannot be computed,
X  the second element is identical to the address, the first element of the
X  list.
+ If this option is used for a channel associated with a unix-domain
+ socket, then the socket's pathname is returned.
X  .TP
X  \fB\-peername\fR
X  This option is not supported by server sockets. For client and accepted
***************
*** 116,121 ****
--- 130,137 ----
X  address, the host name and the port to which the peer socket is connected
X  or bound. If the host name cannot be computed, the second element of the
X  list is identical to the address, its first element.
+ If this option is used for a channel associated with a unix-domain
+ socket, then the socket's pathname is returned.
X  .PP
X  
X  .SH "SEE ALSO"
SHAR_EOF
  $shar_touch -am 0720200098 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' &&
  chmod 0444 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' ||
  $echo 'restore of' 'tcl-socket/Tcl7.5-diffs/socket.n-diffs' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/Tcl7.5-diffs/socket.n-diffs:' 'MD5 check failed'
6c87e4a27f1aca6d59f504520098d9fe  tcl-socket/Tcl7.5-diffs/socket.n-diffs
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/Tcl7.5-diffs/socket.n-diffs'`"
    test 3022 -eq "$shar_count" ||
    $echo 'tcl-socket/Tcl7.5-diffs/socket.n-diffs:' 'original size' '3022,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs ==============
if test -f 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' &&
*** generic/tclIOCmd.c	1998/06/01 20:15:58	1.1
--- generic/tclIOCmd.c	1998/07/20 17:24:58
***************
*** 10,15 ****
--- 10,16 ----
X   *
X   * SCCS: @(#) tclIOCmd.c 1.96 96/05/10 15:20:56
X   */
+ static char rcsid[] = "$Header: /local/src/usr.contrib/tcl7.5/generic/RCS/tclIOCmd.c,v 1.2 1998/07/20 17:24:42 pkern Exp $";
X  
X  #include	"tclInt.h"
X  #include	"tclPort.h"
***************
*** 1368,1373 ****
--- 1369,1375 ----
X      char *myaddr = NULL;
X      int myport = 0;
X      int async = 0;
+     int local = 0;
X      Tcl_Channel chan;
X      AcceptCallback *acceptCallbackPtr;
X      
***************
*** 1426,1434 ****
X                      return TCL_ERROR;
X                  }
X                  async = 1;
X  	    } else {
X  		Tcl_AppendResult(interp, "bad option \"", arg,
!                         "\", must be -async, -myaddr, -myport, or -server",
X                          (char *) NULL);
X  		return TCL_ERROR;
X  	    }
--- 1428,1438 ----
X                      return TCL_ERROR;
X                  }
X                  async = 1;
+             } else if (strcmp(arg, "-local") == 0) {
+ 		local = 1;
X  	    } else {
X  		Tcl_AppendResult(interp, "bad option \"", arg,
!                         "\", must be -async, -myaddr, -myport, -local, or -server",
X                          (char *) NULL);
X  		return TCL_ERROR;
X  	    }
***************
*** 1450,1464 ****
X  wrongNumArgs:
X  	Tcl_AppendResult(interp, "wrong # args: should be either:\n",
X  		argv[0],
!                 " ?-myaddr addr? ?-myport myport? ?-async? host port\n",
X  		argv[0],
!                 " -server command ?-myaddr addr? port",
X                  (char *) NULL);
X          return TCL_ERROR;
X      }
X  
X      if (a == argc-1) {
! 	if (TclSockGetPort(interp, argv[a], "tcp", &port) != TCL_OK) {
X  	    return TCL_ERROR;
X  	}
X      } else {
--- 1454,1472 ----
X  wrongNumArgs:
X  	Tcl_AppendResult(interp, "wrong # args: should be either:\n",
X  		argv[0],
!                 " ?-myaddr addr? ?-myport myport? ?-async? ?-local? host port\n",
X  		argv[0],
!                 " -server command ?-local? ?-myaddr addr? port",
X                  (char *) NULL);
X          return TCL_ERROR;
X      }
X  
X      if (a == argc-1) {
! 	if (local) {
! 	    port = -1;
! 	    host = argv[a];
! 	}
! 	else if (TclSockGetPort(interp, argv[a], "tcp", &port) != TCL_OK) {
X  	    return TCL_ERROR;
X  	}
X      } else {
SHAR_EOF
  $shar_touch -am 0720200198 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' &&
  chmod 0444 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' ||
  $echo 'restore of' 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs:' 'MD5 check failed'
1fe56dca5a801e131af54a2002b2b8f2  tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs'`"
    test 2372 -eq "$shar_count" ||
    $echo 'tcl-socket/Tcl7.5-diffs/tclIOCmd.c-diffs:' 'original size' '2372,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs ==============
if test -f 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' &&
*** unix/tclUnixChan.c	1998/06/01 17:43:54	1.1
--- unix/tclUnixChan.c	1998/07/20 17:22:51
***************
*** 11,20 ****
--- 11,23 ----
X   *
X   * SCCS: @(#) tclUnixChan.c 1.172 96/06/11 10:14:51
X   */
+ static char rcsid[] = "$Header: /local/src/usr.contrib/tcl7.5/unix/RCS/tclUnixChan.c,v 1.2 1998/07/20 17:22:32 pkern Exp $";
X  
X  #include	"tclInt.h"	/* Internal definitions for Tcl. */
X  #include	"tclPort.h"	/* Portability features for Tcl. */
X  
+ #include	<sys/un.h>
+ 
X  /*
X   * This structure describes per-instance state of a pipe based channel.
X   */
***************
*** 1251,1263 ****
X                                           * value; initialized by caller. */
X  {
X      TcpState *statePtr;
!     struct sockaddr_in sockname;
!     struct sockaddr_in peername;
X      struct hostent *hostEntPtr;
X      int sock;
!     int size = sizeof(struct sockaddr_in);
X      size_t len = 0;
X      char buf[128];
X  
X      statePtr = (TcpState *) instanceData;
X      sock = (int) Tcl_GetFileInfo(statePtr->sock, NULL);
--- 1254,1270 ----
X                                           * value; initialized by caller. */
X  {
X      TcpState *statePtr;
!     struct sockaddr sockname;
!     struct sockaddr peername;
X      struct hostent *hostEntPtr;
X      int sock;
!     int size = sizeof(struct sockaddr);
X      size_t len = 0;
X      char buf[128];
+     struct sockaddr_in *tcpsock;
+     struct sockaddr_in *tcppeer;
+     struct sockaddr_un *localsock;
+     struct sockaddr_un *localpeer;
X  
X      statePtr = (TcpState *) instanceData;
X      sock = (int) Tcl_GetFileInfo(statePtr->sock, NULL);
***************
*** 1268,1288 ****
X      if ((len == 0) ||
X              ((len > 1) && (optionName[1] == 'p') &&
X                      (strncmp(optionName, "-peername", len) == 0))) {
!         if (getpeername(sock, (struct sockaddr *) &peername, &size) >= 0) {
X              if (len == 0) {
X                  Tcl_DStringAppendElement(dsPtr, "-peername");
X                  Tcl_DStringStartSublist(dsPtr);
X              }
!             Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
!             hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
!                     sizeof(peername.sin_addr), AF_INET);
!             if (hostEntPtr != (struct hostent *) NULL) {
!                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
!             } else {
!                 Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
!             }
!             sprintf(buf, "%d", ntohs(peername.sin_port));
!             Tcl_DStringAppendElement(dsPtr, buf);
X              if (len == 0) {
X                  Tcl_DStringEndSublist(dsPtr);
X              } else {
--- 1275,1306 ----
X      if ((len == 0) ||
X              ((len > 1) && (optionName[1] == 'p') &&
X                      (strncmp(optionName, "-peername", len) == 0))) {
!         if (getpeername(sock, &peername, &size) >= 0) {
X              if (len == 0) {
X                  Tcl_DStringAppendElement(dsPtr, "-peername");
X                  Tcl_DStringStartSublist(dsPtr);
X              }
! 	    switch (peername.sa_family) {
! 	    case AF_INET:
! 		tcppeer = &peername;
! 		Tcl_DStringAppendElement(dsPtr, inet_ntoa(tcppeer->sin_addr));
! 		hostEntPtr = gethostbyaddr((char *) &(tcppeer->sin_addr),
! 		    sizeof(tcppeer->sin_addr), AF_INET);
! 		if (hostEntPtr != (struct hostent *) NULL) {
! 		    Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
! 		} else {
! 		    Tcl_DStringAppendElement(dsPtr, inet_ntoa(tcppeer->sin_addr));
! 		}
! 		sprintf(buf, "%d", ntohs(tcppeer->sin_port));
!                 Tcl_DStringAppendElement(dsPtr, buf);
! 		break;
! 	    case AF_UNIX:
! 		localpeer = &peername;
! 		Tcl_DStringAppendElement(dsPtr, localpeer->sun_path);
! 		break;
! 	    default:
! 		break;
! 	    }
X              if (len == 0) {
X                  Tcl_DStringEndSublist(dsPtr);
X              } else {
***************
*** 1294,1314 ****
X      if ((len == 0) ||
X              ((len > 1) && (optionName[1] == 's') &&
X                      (strncmp(optionName, "-sockname", len) == 0))) {
!         if (getsockname(sock, (struct sockaddr *) &sockname, &size) >= 0) {
X              if (len == 0) {
X                  Tcl_DStringAppendElement(dsPtr, "-sockname");
X                  Tcl_DStringStartSublist(dsPtr);
X              }
!             Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
!             hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
!                     sizeof(peername.sin_addr), AF_INET);
!             if (hostEntPtr != (struct hostent *) NULL) {
!                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
!             } else {
!                 Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
!             }
!             sprintf(buf, "%d", ntohs(sockname.sin_port));
!             Tcl_DStringAppendElement(dsPtr, buf);
X              if (len == 0) {
X                  Tcl_DStringEndSublist(dsPtr);
X              } else {
--- 1312,1343 ----
X      if ((len == 0) ||
X              ((len > 1) && (optionName[1] == 's') &&
X                      (strncmp(optionName, "-sockname", len) == 0))) {
!         if (getsockname(sock, &sockname, &size) >= 0) {
X              if (len == 0) {
X                  Tcl_DStringAppendElement(dsPtr, "-sockname");
X                  Tcl_DStringStartSublist(dsPtr);
X              }
! 	    switch (sockname.sa_family) {
! 	    case AF_INET:
! 		tcpsock = &sockname;
! 		Tcl_DStringAppendElement(dsPtr, inet_ntoa(tcpsock->sin_addr));
! 		hostEntPtr = gethostbyaddr((char *) &(tcpsock->sin_addr),
! 			sizeof(tcpsock->sin_addr), AF_INET);
! 		if (hostEntPtr != (struct hostent *) NULL) {
! 			Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
! 		} else {
! 			Tcl_DStringAppendElement(dsPtr, inet_ntoa(tcpsock->sin_addr));
! 		}
! 		sprintf(buf, "%d", ntohs(tcpsock->sin_port));
! 		Tcl_DStringAppendElement(dsPtr, buf);
! 		break;
! 	    case AF_UNIX:
! 		localsock = &sockname;
! 		Tcl_DStringAppendElement(dsPtr, localsock->sun_path);
! 		break;
! 	    default:
! 		break;
! 	    }
X              if (len == 0) {
X                  Tcl_DStringEndSublist(dsPtr);
X              } else {
***************
*** 1358,1378 ****
X                                   * do a synchronous connect or bind. */
X  {
X      int status, sock, asyncConnect, curState, origState;
!     struct sockaddr_in sockaddr;	/* socket address */
!     struct sockaddr_in mysockaddr;	/* Socket address for client */
X      TcpState *statePtr;
X  
X      sock = -1;
X      origState = 0;
!     if (! CreateSocketAddress(&sockaddr, host, port)) {
! 	goto addressError;
X      }
!     if ((myaddr != NULL || myport != 0) &&
! 	    ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
X  	goto addressError;
X      }
X  
!     sock = socket(AF_INET, SOCK_STREAM, 0);
X      if (sock < 0) {
X  	goto addressError;
X      }
--- 1387,1449 ----
X                                   * do a synchronous connect or bind. */
X  {
X      int status, sock, asyncConnect, curState, origState;
!     struct sockaddr_in tcpaddr;		/* socket address */
!     struct sockaddr_in mytcpaddr;	/* Socket address for client */
X      TcpState *statePtr;
+     int sockOptions;
+     struct sockaddr_un localaddr;	/* socket address */
+     struct sockaddr_un mylocaladdr;	/* Socket address for client */
+     struct sockaddr *sockaddr, *mysockaddr;
X  
X      sock = -1;
X      origState = 0;
!     sockOptions = SO_REUSEADDR;
! 
!     if (port < 0 && host != NULL) {
! /*	sockOptions = 0;	/* */
! 	if (strlen(host) >= sizeof(localaddr.sun_path)) {
! 	    errno = E2BIG;		/* XXX */
! 	    goto addressError;
! 	}
! 	strcpy(localaddr.sun_path, host);
! 	localaddr.sun_family = AF_UNIX;
! 	localaddr.sun_len = sizeof(localaddr.sun_len) +
! 			strlen(localaddr.sun_path) + 1;
! 	sockaddr = (struct sockaddr *)&localaddr;
X      }
!     else if (! CreateSocketAddress(&tcpaddr, host, port)) {
X  	goto addressError;
X      }
+     else {
+ 	tcpaddr.sin_len = sizeof(tcpaddr);
+ 	tcpaddr.sin_family = AF_INET;
+ 	sockaddr = (struct sockaddr *)&tcpaddr;
+     }
+ 
+     if ((myaddr != NULL || myport != 0)) {
+ 	if (myport < 0 && myaddr != NULL) {
+ /*	    sockOptions = 0;	/* */
+ 	    if (strlen(myaddr) >= sizeof(mylocaladdr.sun_path)) {
+ 		errno = E2BIG;		/* XXX */
+ 		goto addressError;
+ 	    }
+ 	    strcpy(mylocaladdr.sun_path, myaddr);
+ 	    mylocaladdr.sun_family = AF_UNIX;
+ 	    mylocaladdr.sun_len = sizeof(mylocaladdr.sun_len) +
+ 				strlen(mylocaladdr.sun_path) + 1;
+ 	    mysockaddr = (struct sockaddr *)&mylocaladdr;
+ 	}
+ 	else if (! CreateSocketAddress(&mytcpaddr, myaddr, myport)) {
+ 	    goto addressError;
+ 	}
+ 	else {
+ 	    mytcpaddr.sin_len = sizeof(mytcpaddr);
+ 	    mytcpaddr.sin_family = AF_INET;
+ 	    mysockaddr = (struct sockaddr *)&mytcpaddr;
+ 	}
+     }
X  
!     sock = socket(sockaddr->sa_family, SOCK_STREAM, 0);
X      if (sock < 0) {
X  	goto addressError;
X      }
***************
*** 1393,1412 ****
X  	 */
X      
X  	status = 1;
! 	(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
X  		sizeof(status));
! 	status = bind(sock, (struct sockaddr *) &sockaddr,
!                 sizeof(struct sockaddr));
X  	if (status != -1) {
X  	    status = listen(sock, TCL_LISTEN_LIMIT);
X  	} 
X      } else {
X  	if (myaddr != NULL || myport != 0) { 
X  	    status = 1;
! 	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
X  		    sizeof(status));
! 	    status = bind(sock, (struct sockaddr *) &mysockaddr,
! 		    sizeof(struct sockaddr));
X  	    if (status < 0) {
X  		goto bindError;
X  	    }
--- 1464,1481 ----
X  	 */
X      
X  	status = 1;
! 	(void) setsockopt(sock, SOL_SOCKET, sockOptions, (char *) &status,
X  		sizeof(status));
! 	status = bind(sock, sockaddr, sockaddr->sa_len);
X  	if (status != -1) {
X  	    status = listen(sock, TCL_LISTEN_LIMIT);
X  	} 
X      } else {
X  	if (myaddr != NULL || myport != 0) { 
X  	    status = 1;
! 	    (void) setsockopt(sock, SOL_SOCKET, sockOptions, (char *) &status,
X  		    sizeof(status));
! 	    status = bind(sock, mysockaddr, mysockaddr->sa_len);
X  	    if (status < 0) {
X  		goto bindError;
X  	    }
***************
*** 1427,1434 ****
X              status = 0;
X          }
X          if (status > -1) {
!             status = connect(sock, (struct sockaddr *) &sockaddr,
!                     sizeof(sockaddr));
X              if (status < 0) {
X                  if (errno == EINPROGRESS) {
X                      asyncConnect = 1;
--- 1496,1502 ----
X              status = 0;
X          }
X          if (status > -1) {
! 	    status = connect(sock, sockaddr, sockaddr->sa_len);
X              if (status < 0) {
X                  if (errno == EINPROGRESS) {
X                      asyncConnect = 1;
SHAR_EOF
  $shar_touch -am 0720200198 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' &&
  chmod 0444 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' ||
  $echo 'restore of' 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs:' 'MD5 check failed'
432c209b691f679e0b8d79fa3ab743ba  tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs'`"
    test 10730 -eq "$shar_count" ||
    $echo 'tcl-socket/Tcl7.5-diffs/tclUnixChan.c-diffs:' 'original size' '10730,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/Tcl7.5-diffs/Readme ==============
if test -f 'tcl-socket/Tcl7.5-diffs/Readme' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/Tcl7.5-diffs/Readme' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/Tcl7.5-diffs/Readme' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/Tcl7.5-diffs/Readme' &&
X
Here are the context diffs for the mods to the socket command.
Use patch to apply these diffs to your copy of the source tree.
X
SHAR_EOF
  $shar_touch -am 0723222598 'tcl-socket/Tcl7.5-diffs/Readme' &&
  chmod 0644 'tcl-socket/Tcl7.5-diffs/Readme' ||
  $echo 'restore of' 'tcl-socket/Tcl7.5-diffs/Readme' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/Tcl7.5-diffs/Readme:' 'MD5 check failed'
1839d5ad2ed90b674ff260861f8a2d80  tcl-socket/Tcl7.5-diffs/Readme
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/Tcl7.5-diffs/Readme'`"
    test 129 -eq "$shar_count" ||
    $echo 'tcl-socket/Tcl7.5-diffs/Readme:' 'original size' '129,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/eg-client.t ==============
if test -f 'tcl-socket/eg-client.t' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/eg-client.t' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/eg-client.t' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/eg-client.t' &&
#!/local/bin/tclsh
#
# demonstrate a unix-domain socket (client mode):
# connect to the unix-domain socket at "./portal"
# and then send something to its server.
#
# run eg-server.t in background before trying to run this script.
#
X
set sd [ socket -local "" "./portal" ]
X
puts $sd "hello, there. the time is now ..."
puts $sd [clock format [ clock seconds ]]
puts $sd "g'bye."
X
# just what is $sd?
puts "\nclient side : sd = $sd : [ fconfigure $sd ]\n"
SHAR_EOF
  $shar_touch -am 0721113498 'tcl-socket/eg-client.t' &&
  chmod 0755 'tcl-socket/eg-client.t' ||
  $echo 'restore of' 'tcl-socket/eg-client.t' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/eg-client.t:' 'MD5 check failed'
5a2c9252b16970066f527f421b9632b4  tcl-socket/eg-client.t
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/eg-client.t'`"
    test 454 -eq "$shar_count" ||
    $echo 'tcl-socket/eg-client.t:' 'original size' '454,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/eg-server.t ==============
if test -f 'tcl-socket/eg-server.t' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/eg-server.t' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/eg-server.t' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/eg-server.t' &&
#!/local/bin/tclsh
#
# demonstrate a unix-domain socket (server mode):
# create a unix-domain socket at "./portal" and
# attach the srvsock proc as the socket's server.
#
# run this script in background first before running eg-client.t.
#
X
proc srvsock { fd addr port } {
X	set n 0
X	puts "\nsrvsock { $fd $addr $port }" ; flush stdout
X	while { [ gets $fd l ] != -1 } {
X		incr n
X		puts "srvsock rcvd $n : $l"
X	}
X	flush stdout
}
X
set sd [ socket -server srvsock -local "./portal" ]
X
# note: might need to remove the ./portal left behind by previous calls.
X
# just how is $sd configured?
puts "\nserver side : sd = $sd : [ fconfigure $sd ]\n"
X
vwait name
SHAR_EOF
  $shar_touch -am 0721114198 'tcl-socket/eg-server.t' &&
  chmod 0755 'tcl-socket/eg-server.t' ||
  $echo 'restore of' 'tcl-socket/eg-server.t' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/eg-server.t:' 'MD5 check failed'
1877f5371217382b7707288263d6de09  tcl-socket/eg-server.t
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/eg-server.t'`"
    test 651 -eq "$shar_count" ||
    $echo 'tcl-socket/eg-server.t:' 'original size' '651,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/Readme ==============
if test ! -d 'tcl-socket/example'; then
  $echo 'x -' 'creating directory' 'tcl-socket/example'
  mkdir 'tcl-socket/example'
fi
if test -f 'tcl-socket/example/Readme' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/Readme' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/Readme' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/Readme' &&
X
Here some examples which use the new "socket ... -local" feature.
X
X
bifftk	- collect and display biff messages asynchronously.
------
Instead of continuously polling a spool file, bifftk uses the
newly-modified tcl "socket" command to set up a tcl/tk server
which can be contacted via a unix-domain socket (~/.biff_me).
Ideally, bifftk would be run in background by the user (see tbiff).
X
X
tbiff	- an alternative to xbiff?.
-----
tbiff is a companion to bifftk.  it manipulates a user's .forward file
to include or delete itself depending on the arguments used.
also, if run with "tbiff y", tbiff tries to start bifftk in background
(if it seems that the user's biff socket is unserved or non-existent).
X
X
tst-bifftk	- demonstrate/test a running bifftk.
----------
this script connects to the unix-domain socket (~/.biff_me)
and sends a fake biff-style text to that server.
[bifftk must already be running for this test to work]
X
X
tst-via-tbiff	- test bifftk via 'tbiff -relay'
-------------
this script uses 'tbiff -relay' to process a raw email message
and then passes the resulting biff message on to a run bifftk.
'tbiff -relay' is the command which would be included in the
user's .forward file so this a test of that feature.
X
X
tst-end-to-end	- a full test tbiff and bifftk
--------------
runs "tbiff y" and emails a test message to $USER.
X
SHAR_EOF
  $shar_touch -am 0723223698 'tcl-socket/example/Readme' &&
  chmod 0644 'tcl-socket/example/Readme' ||
  $echo 'restore of' 'tcl-socket/example/Readme' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/Readme:' 'MD5 check failed'
573700b8b57a308ad14006b91efc55ab  tcl-socket/example/Readme
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/Readme'`"
    test 1348 -eq "$shar_count" ||
    $echo 'tcl-socket/example/Readme:' 'original size' '1348,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/bifftk ==============
if test -f 'tcl-socket/example/bifftk' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/bifftk' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/bifftk' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/bifftk' &&
#!/local/bin/expectk
#
# collect and display biff/comsat messages via a
# unix-domain socket in the user's home directory.
# 
# i'm a neophyte when it comes to X11-related things
# so this may not be pretty but it seems to work ok.
#	pkern at utcc.utoronto.ca
#
# $Header: /local/homes/pkern/xp/RCS/bifftk,v 1.18 1998/07/23 18:06:29 pkern Exp $
#
X
##### ##### ##### ##### ##### ##### ##### ##### ##### #####
#
# configurable things.
#
# things are set quick-n-dirty here because i'm never sure what stuff
# to fetch from a user's .Xresources file (or whatever it's called).
#
X
#set title "bifftk"
X
#set font "9x15bold"
set font "7x14bold"
X
##### #####
# icon settings:
#####
# where to find the icon bitmaps ...
set icon(home)	"/usr/X11/include/X11/bitmaps/"
#####
# choose which email icon style to use ...
## [flagup, flagdown]
append icon(map,1) "@" $icon(home) "flagup"	; set icon(mask,1) ""
append icon(map,0) "@" $icon(home) "flagdown"	; set icon(mask,0) ""
## [letters, noletters]
#append icon(map,1) "@" $icon(home) "letters"	; set icon(mask,1) ""
#append icon(map,0) "@" $icon(home) "noletters"	; set icon(mask,0) ""
## [mailfull, mailempty]
#append icon(map,1) "@" $icon(home) "mailfull"
#append icon(mask,1) "@" $icon(home) "mailfullmsk"
#append icon(map,0) "@" $icon(home) "mailempty"
#append icon(mask,0) "@" $icon(home) "mailemptymsk"
#####
#?## icon pixmaps? no, not yet.
#?#set icon(home) "/usr/X11/include/X11/pixmaps/"
#?#append icon(map,1) "@" $icon(home) "xmail.xpm"  ; set icon(mask,1) ""
#?#append icon(map,0) "@" $icon(home) "xnomail.xpm"; set icon(mask,0) ""
##### #####
X
#
# "loud" choices: Loud or Hush
#
# this is a button label name, so its value
# means the opposite of the current state.
#
X
set loud Hush	; # ie. make it loud by default.
X
##### ##### ##### ##### ##### ##### ##### ##### ##### #####
#
# prep work, building blocks and definitions.
#
X
# the socket itself.
set sockfile "$env(HOME)/.biff_me"
X
#wm title . $title
X
# start up in iconified mode.
wm iconify .
X
proc quit { } {
X	global sockfile
X	catch { exec rm -f $sockfile } errmsg
# for debugging.
#	send_error "\n$sockfile: $errmsg\n"
X	exit -onexit {} ; exit
}
X
# try to catch every possible signal.
foreach sig [ split [ string toupper [ exec kill -l ]]] {
X	# a signal mask ...?
X	switch -- $sig {
X		ALRM	{ }	KILL	{ }	URG	{ }
X		STOP	{ }	TSTP	{ }	CONT	{ }
X		CHLD	{ }	TTIN	{ }	TTOU	{ }
X		IO	{ }	WINCH	{ }	INFO	{ }
X		default { lappend traps $sig }
X	}
}
trap quit $traps
#x#send_error "\ntraps {$traps}\n"
#x#foreach sig $traps { send_error "trap $sig = [ trap $sig ]\n" }
X
# quick exit(s).
#bind . <KeyPress-Escape> quit
#bind . <KeyPress-q> quit
bind . <KeyPress-Q> quit
X
# the menu bar.
frame .menubar -relief ridge -bd 2
button .menubar.list -text List -relief raised -command bifflist
button .menubar.okay -text Okay -relief raised -command "wm iconify ."
button .menubar.quit -text Quit -relief raised -command quit
button .menubar.help -text Help -relief raised -command menuhelp
button .menubar.done -text Clear -relief raised -command clear
X
button .menubar.loud -textvariable loud -relief raised -command hush
X
pack .menubar.list .menubar.okay .menubar.done \
X	.menubar.loud .menubar.quit -side left
pack .menubar.help -side right
X
proc menuhelp {} {
X	global sockfile
X
X	set msgtxt "
This expectk script collects and displays biff/comsat messages.
It created a unix-domain socket at $sockfile
and it is listening to that socket for messages either from comsat(8)
(in which case comsat has been augmented to check for such sockets in
user home directories and, if they exist, connect to them and send them
the latest biff messages) or from a 'tbiff -relay' pipe which had been
added to your .forward file by the 'tbiff y' command.
X
To exit this script, press <Esc> or press 'q'.
X
button	meaning
------	-------
List	show a list of stored messages.
Okay	(re)iconify the display.
Clear	flush all messages and (re)iconify, all in one step.
Loud	make the window pop open with each new message.
Hush	do the opposite of Loud.
Quit	exit the script.
X
And since you're reading this, then obviously
you've already clicked on the Help button.
"
X	append msglen [ string length $msgtxt ] "c"
X
X	catch { destroy .help }
X	set win ".help"
X	toplevel $win -relief raised -height 40m
X	bind $win <KeyPress-q> "destroy $win"
X	bind $win <KeyPress-space> "destroy $win"
X	bind $win <KeyPress-Escape> "destroy $win"
X	message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
X		-foreground blue -background goldenrod
X	pack $win.msg -expand 1 -fill both
}
X
# toggle loud.
proc hush {} {
X	global loud
X
X	set loud [expr {$loud == "Hush"} ? {"Loud"} : {"Hush"}]
}
X
# indicate a status change by changing the icon name and mask
# if in "Loud" mode then deiconify for a new message.
proc indicate { type } {
X	global icon nums loud
X
X	switch -- $type {
X	new {
X		# new input.
X		wm iconbitmap . $icon(map,1)
X		wm iconmask . $icon(mask,1)
X		wm iconname . " + $nums(unread) "
X		if {$loud == "Hush"} {
X			# pop up the window.
X			if {[wm state .] == "iconic"} { wm deiconify . }
X		}
X	}
X	empty {
X		wm iconbitmap . $icon(map,0)
X		wm iconmask . $icon(mask,0)
X		wm iconname . [wm title .]
X	}
X	default {
X		if {$nums(total) == 0} {
X			wm iconbitmap . $icon(map,0)
X			wm iconmask . $icon(mask,0)
X		} elseif {$nums(unread) > 0} {
X			wm iconname . " + $nums(unread) "
X		} else {
X			wm iconname . [wm title .]
X		}
X	}
X	}
}
X
# reset the displays.
proc reset { } {
X	global nums disp
X
X	set nums(unread) 0
X	set nums(seen) 0
X	set nums(total) 0
X	set disp(mesg) ""
X	set disp(stamp) ""
X	indicate empty
}
X
reset
X
# status bar.
frame .statbar -relief ridge -bd 2
label .statbar.new -text "new:"	-pady 2m
label .statbar.old -text "    read:"	-pady 2m
label .statbar.total -text "    total:"	-pady 2m
label .statbar.ttl -textvariable nums(total) -fg yellow -bg blue
label .statbar.just -textvariable nums(unread) -fg blue -bg green
label .statbar.seen -textvariable nums(seen) -fg blue
label .statbar.time -textvariable timestamp -fg blue
pack \
X	.statbar.new .statbar.just \
X	.statbar.old .statbar.seen \
X	.statbar.total .statbar.ttl \
X	-side left
pack .statbar.time -side right
X
# show the menu and status bars.
pack .menubar .statbar -side top -fill x
X
# .biff = the space for the info itself.
frame .biff -relief ridge -bd 2
label .biff.stamp -textvariable disp(stamp)
message .biff.msg -bd 1m -relief ridge -font $font \
X	-foreground yellow -background blue \
X	-width 80c -textvariable disp(mesg)
pack .biff.stamp -side top
pack .biff.msg -expand 1 -fill both
pack .biff -expand 1 -fill both
X
proc review { tag } {
X	global stash disp nums flags
X
X	regexp "^\[0-9]+" $tag secs
X
X	set disp(mesg) $stash($tag)
X	set disp(stamp) [ clock format $secs -format "%a %b %d %H:%M" ]
X	incr nums($flags($tag)) -1
X	set flags($tag) "seen"
X	incr nums($flags($tag))
}
X
proc delete { tag } {
X	global stash nums flags snips
X
X	incr nums(total) -1
X	incr nums($flags($tag)) -1
X	unset flags($tag)
X	unset stash($tag)
X	unset snips($tag)
}
X
proc get_tag { item } { regexp "^\[0-9,]+" $item tag ; return $tag }
X
# look - a listbox menu button.
proc look { } {
X	# get the selection index.
X	set spot [ .list.data curselection ]
X	if {"$spot" == ""} { return }
X
X	# show the biff message.
X	set tag [ get_tag [ selection get ] ]
X	review $tag
X
X	# refresh the selected line.
X	.list.data delete $spot
X	.list.data insert $spot [ listline $tag ]
X	.list.data selection set $spot
X
X	indicate seen
}
X
# drop - a listbox menu button.
proc drop { } {
X	set item [ .list.data curselection ]
X	if { $item == "" } { return }
X	delete [ get_tag [ selection get ] ]
X	.list.data delete $item
X	indicate dropped
}
X
# listhelp - a listbox menu button.
proc listhelp {} {
X	set msgtxt "
Click on an item to select it.
Left double-click on the item to look at it again.
Right double-click on the item to delete it.
X
Click on the Look button to view the selected message.
Click on the Drop button to delete the selected message.
Click on the Drain button to drop all the messages.
Click on the Done button to hide the list of stored messages.
X
And if you're reading this, then you've already
clicked on the Help button ... obviously.
"
X	append msglen [ string length $msgtxt ] "c"
X
X	catch { destroy .listhelp }
X	set win ".listhelp"
X	toplevel $win -relief raised -height 40m
X	bind $win <KeyPress-q> "destroy $win"
X	bind $win <KeyPress-space> "destroy $win"
X	bind $win <KeyPress-Escape> "destroy $win"
X	message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
X		-foreground blue -background goldenrod
X	pack $win.msg -expand 1 -fill both
}
X
# clean out the list.
proc drain { } {
X	global stash flags snips
X
X	if {[ info exists stash ]} {
X		reset
X		unset stash flags snips
X		catch { .list.data delete 0 end }
X	}
}
X
# drain, shrink and iconify - all in one swell foop.
proc clear { } {
X	drain
X	catch { destroy .list }
X	wm iconify .
}
X
# choose a snippet for the listbox.
proc snippet { str } {
X	set max 28
X
X	# if it's a biff message, try to extract the "From:" line.
X	if {[ regexp "New mail .*\n(From:\[^\n]+).*\n\n" $str x snip ] == 0} {
X		# nothing -- so just snip out the first non-empty line.
X		regexp "^\n*(\[^\n]+)\n" $str x snip
X	}
X	if {[ string length $snip ] > $max} {
X		set snip [ string range $snip 0 [ string wordstart $snip $max ] ]
X		append snip {[...]}
X	}
X	return $snip
}
X
# return a listbox line entry.
proc listline { tag } {
X	global flags snips
X
X	regsub ",\[0-9]+" $tag "" secs
X	set when [ clock format $secs -format "%a %H:%M" ]
X	return [ format "%-12s %6s  %s  \"%s\"" $tag $flags($tag) $when $snips($tag) ]
}
X
# bifflist - display a summary of stored messages.
proc bifflist { } {
X	global stash font
X
X	catch { destroy .list }
X	set win ".list"
X	frame $win -relief ridge -bd 2
X	frame $win.buttons -relief ridge -bd 2
X	button $win.buttons.look -text Look -relief raised -command look
X	button $win.buttons.drop -text Drop -relief raised -command drop
X	button $win.buttons.drain -text Drain -relief raised -command drain
X	button $win.buttons.done -text Done -relief raised -command "destroy $win"
X	button $win.buttons.help -text Help -relief raised -command listhelp
X	bind $win.buttons <KeyPress-space> "destroy $win"
X
X	pack \
X		$win.buttons.look \
X		$win.buttons.drop \
X		$win.buttons.drain \
X		$win.buttons.done \
X			-side left
X	pack $win.buttons.help -side right
X	pack $win.buttons -expand 1 -fill both
X
X	listbox $win.data -bd 2 -yscrollcommand "$win.s set" \
X			-font $font -width 72 -height 4
X	foreach tag [ lsort [ array names stash ] ] {
X		$win.data insert end [ listline $tag ]
X	}
X
X	bind $win.data <KeyPress-space> "destroy $win"
X
X	bind $win.data <Double-Button-1> look
X	bind $win.data <Double-Button-3> drop
X	scrollbar $win.s -command "$win.data yview"
X
X	pack $win.s -side right -fill y
X	pack $win.data -side left -expand 1 -fill both
X	pack $win -before .biff -expand 1 -fill both
}
X
# biffy - the socket server.
proc biffy { fd addr port } {
X	global stash timestamp disp nums flags snips
X
X	fconfigure $fd -translation binary
X
X	set raw [ read $fd ]
X	if {[string length "$raw"] == 0} { return }
X
X	set now [ clock seconds ]
X	set timestamp [ clock format $now -format "%a %b %d %H:%M:%S" ]
X
X	# allow for multiple biffs in a single second.
X	set n 0 ; while {[ info exists stash($now,$n) ]} { incr n }
X	set tag "$now,$n"
X
X	# convert CR+LF or LF+CR combinations into LFs.
X	regsub -all "(\n\r|\r\n)" $raw "\n" txt
X
X	# delete a leading BEL (ctl-G, ascii-7).
X	regsub [ format "^%c" 7 ] $txt "" bifftxt
X
X	set stash($tag) $bifftxt
X	set flags($tag) "unread"
X	set snips($tag) [ snippet $bifftxt ]
X
X	# update the displays.
X	set nums(total) [ array size stash ]
X	incr nums($flags($tag))
X	set disp(mesg) $bifftxt
X	set disp(stamp) $timestamp
X
X	# update the listbox - if it's being displayed.
X	if {[ lsearch -exact [ pack slaves . ] ".list" ] != -1} {
X		bifflist
X	}
X
X	indicate new
}
X
##### ##### ##### ##### ##### ##### ##### ##### ##### #####
#
# run it.
#
X
# check for an existing socket server.
if {[ catch { set sd [ socket -local "" $sockfile ]} ]} {
X	# hmm, none. so clean up the dead socket, if any.
X	exec rm -f $sockfile
} else {
X	send_error "$sockfile: already in use.\n"
X	exit 1
}
X
# start.
if {[ catch { set sd [ socket -server biffy -local $sockfile ]} errmsg ]} {
X	# uh oh.
X	send_error "$sockfile: $errmsg\n"
X	exit 1
}
X
exit -onexit quit
exec chmod 600 $sockfile
vwait allDone
SHAR_EOF
  $shar_touch -am 0723143698 'tcl-socket/example/bifftk' &&
  chmod 0755 'tcl-socket/example/bifftk' ||
  $echo 'restore of' 'tcl-socket/example/bifftk' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/bifftk:' 'MD5 check failed'
62f558e6af4db4556a0cd94489d39421  tcl-socket/example/bifftk
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/bifftk'`"
    test 12265 -eq "$shar_count" ||
    $echo 'tcl-socket/example/bifftk:' 'original size' '12265,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/tbiff ==============
if test -f 'tcl-socket/example/tbiff' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/tbiff' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/tbiff' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/tbiff' &&
#!/local/bin/tclsh
#
# tbiff - a companion to bifftk.
#
# usage: tbiff [ y | n | -relay ]
#
#  tbiff	- check biffing state.
#  tbiff n	- disable biffing.
#  tbiff y	- enable biffing (and start bifftk in bkgnd, if needed).
#
#  tbiff -relay
#		- read an email message on stdin, digest it into
#		  a biff text and relay that text to bifftk.
#		- primarily for use via a user's .forward file.
#	  	  eg.
#			username, "|/usr/local/bin/tbiff -relay"
#		- only used if comsat is not aware of biff sockets.
#
#  see also "man biff"
#
# pkern at utcc.utoronto.ca
#
#####
X
#
# does comsat know about biff sockets?
#
# [comment/uncomment the following 2 lines as appropriate]
X
set comsat 0	;# no
#set comsat 1	;# yes
X
#####
#
# if comsat does NOT know about biff sockets ...
#
#   "tbiff y" will try to (re)write $HOME/.forward so that it includes
#    a call to "tbiff -relay".  "tbiff y" will try to start up bifftk
#    if it seems the user's biff socket is not "alive."
#
#   "tbiff n" will try to rewrite $HOME/.forward to delete any calls
#    to "tbiff -relay".
#
#   "tbiff" simply searches $HOME/.forward for any "tbiff -relay" calls
#    and if found, it then tests for the biff socket.
#
#####
#
# if comsat knows about biff sockets ...
#
#
#   "tbiff y" will try to start up bifftk if it seems the user's biff
#    socket is not already "alive."
#
#   "tbiff n" deletes the biff socket. the user has to stop the bifftk.
#
#   "tbiff" simply tests for the biff socket.
#
#####
#
# $Header: /local/homes/pkern/xp/RCS/tbiff,v 1.6 1998/07/23 18:12:40 pkern Exp $
#
#####
X
set dotforward "$env(HOME)/.forward"
set pattern ", \"|$argv0 -relay\""
X
# the path to the user's biff socket ...
set sockfile "$env(HOME)/.biff_me"
X
if {$argc == 0} {
X	# this is a query.
X	if {$comsat} {
X		if {[catch {set sd [socket -local "" $sockfile ]} ]} {
X			# no socket/socket is dead.
X			puts "is n"
X		} else {
X			puts "is y"
X		}
X	} elseif {[ file isfile $dotforward ] == 0} {
X		puts "is n"
X	} elseif {[catch { set fd [ open $dotforward r ]} errmsg]} {
X		puts "is n"
X	} elseif {[regexp -- "$pattern" [ read -nonewline $fd ]]} {
X		if {[catch {set sd [socket -local "" $sockfile ]} ]} {
X			# no socket/socket is dead.
X			puts "is n"
X		} else {
X			puts "is y"
X		}
X	} else {
X		puts "is n"
X	}
X	exit 0
} elseif {$argc != 1} {
X	puts stderr "usage: $argv0 [y | n]"
X	exit 1
} elseif {$argv == "-relay"} {
X	# skip.
} else {
X	switch -exact $argv {
X		n	{ set add 0 }
X		y	{ set add 1 }
X		default	{ puts stderr "usage: $argv0 [y | n]" ; exit 1 }
X	}
X	if {$comsat == 0} {
X		#
X		# comsat is unaware of biff sockets.
X		# so (re)write .forward based on the command line arg:
X		#   - if arg1 is y, then include self as an additional
X		#	address (if not already present).
X		#   - if arg1 is n, then delete self from the list.
X		# 
X		if {[catch {set fd [ open $dotforward r ]} ]} {
X			set str $env(USER)
X		} else {
X			set str [ read -nonewline $fd ] 
X			close $fd
X		}
X		if {[regexp -- "$pattern" "$str" ]} {
X			if {$add == 0} {
X				# escape any pipes in $pattern (sigh).
X				regsub -all -- {\|} $pattern {\\|} pat
X				# delete all matching patterns.
X				regsub -all -- $pat $str "" new
X			}
X		} elseif {$add} {
X			append new $str $pattern
X		}
X		if {[info exists new ]} {
X			catch { exec mv $dotforward "$dotforward.bak" }
X			set fd [ open $dotforward w 0644 ]
X			puts $fd $new
X			close $fd
X		}
X	}
X	if {$add} {
X		# try to start up bifftk, if it's not already running.
X		if {[catch {set sd [socket -local "" $sockfile ]} ]} {
X			catch { exec bifftk & }
X		}
X	} elseif {$comsat} {
X		# [ugly] delete the socket. the user will need
X		# to manually exit the corresponding bifftk.
X		catch { exec rm -f $sockfile }
X	}
X	exit 0
}
X
if {$comsat} {
X	# if comsat is aware of biff sockets
X	# then there's no point in continuing.
X
X	# absorb the rest of the message [zmailer].
X	read stdin
X
X	exit 0
}
X
#
# we're expecting a full mail message on stdin ...
#
X
# get the message headers and save the useful ones.
while {[set n [ gets stdin line ]] > 0} {
X	switch -glob $line {
X		"Subject:*"	{ set subj $line }
X		"From:*"	{ set from $line }
X		"Date:*"	{ set date $line }
X		"To:*"		{ set addr $line }
X	}
}
X
#
# we should now be at the first empty line (or at EOF).
#
X
# read up to 3 lines of the message body.
foreach x { 1 2 3 } {
X	set n [ gets stdin line ]
X	if {$n < 0} { break }
X	append mailmesg $line "\r\n"
}
X
if {$n < 0} {
X	# ok, that was the last line.
X	append mailmesg "---"
} else {
X	# but wait! there's more!
X	append mailmesg "...more..."
}
X
# absorb the rest of the message [zmailer].
read stdin
X
# build the biff blurb.
set mailbiff [ format "%c\r
New mail for <%s> has arrived:\r
---\r
%s\r\n%s\r\n%s\r\n%s\r
\r
%s\r\n" 7 $env(USER) $from $addr $date $subj $mailmesg ]
X
# connect to the user's biff socket.
if {[ catch { set sd [ socket -local "" $sockfile ]} errmsg ]} {
X	# no socket or no server; so just exit quietly.
X	exit 0
}
X
# send the blurb.
fconfigure $sd -translation binary
puts -nonewline $sd $mailbiff
X
#x## uncomment for debugging.
#x#puts [ fconfigure $sd ]
#x#puts $mailbiff
SHAR_EOF
  $shar_touch -am 0723223498 'tcl-socket/example/tbiff' &&
  chmod 0755 'tcl-socket/example/tbiff' ||
  $echo 'restore of' 'tcl-socket/example/tbiff' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/tbiff:' 'MD5 check failed'
89998eecbb4c52a1786d704790978330  tcl-socket/example/tbiff
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/tbiff'`"
    test 5034 -eq "$shar_count" ||
    $echo 'tcl-socket/example/tbiff:' 'original size' '5034,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/tst-bifftk ==============
if test -f 'tcl-socket/example/tst-bifftk' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/tst-bifftk' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/tst-bifftk' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/tst-bifftk' &&
#!/local/bin/tclsh
#
# test bifftk
#
# $Header: /local/homes/pkern/xp/RCS/bifftst,v 1.1 1998/06/09 17:52:22 pkern Exp $
X
set sockfile "$env(HOME)/.biff_me"
X
# a biff test message.
set mailbiff [ format "%c\r
New mail for <me@here> has arrived:\r
---\r
Date:	%s
\rFrom:	<bifftst@here>
\rTo:	moi, myself, me
\rSubject: just testing
\r
\rJust a test line.
\rAnd here's another line.
\r...more...
\r" 7 [clock format [clock seconds]] ]
X
X
if {[ catch { set sd [ socket -local "" $sockfile ]} errmsg ]} {
X	puts $errmsg
X	exit 1
}
fconfigure $sd -translation binary
puts -nonewline $sd $mailbiff
X
# uncomment for debugging.
#puts [ fconfigure $sd ]
#puts $mailbiff
SHAR_EOF
  $shar_touch -am 0720162798 'tcl-socket/example/tst-bifftk' &&
  chmod 0755 'tcl-socket/example/tst-bifftk' ||
  $echo 'restore of' 'tcl-socket/example/tst-bifftk' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/tst-bifftk:' 'MD5 check failed'
2f6943157918b2fa5c39d14c64d9c795  tcl-socket/example/tst-bifftk
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/tst-bifftk'`"
    test 657 -eq "$shar_count" ||
    $echo 'tcl-socket/example/tst-bifftk:' 'original size' '657,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/tst-via-tbiff ==============
if test -f 'tcl-socket/example/tst-via-tbiff' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/tst-via-tbiff' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/tst-via-tbiff' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/tst-via-tbiff' &&
#!/bin/sh -x
#
# an intermediate test of tbiff and bifftk.
# (ie. don't involve the email system, yet).
#
X
# make sure this directory is the source of the scripts.
PATH=.:$PATH ; export PATH
X
# remember what the current state is.
orig=`tbiff`
X
# try to make sure bifftk is running.
tbiff y
X
# process a message.
tbiff -relay < ./tst.mail
X
# try to return to the original state.
case "$orig" in 'is n') tbiff n ;; esac
SHAR_EOF
  $shar_touch -am 0723144598 'tcl-socket/example/tst-via-tbiff' &&
  chmod 0755 'tcl-socket/example/tst-via-tbiff' ||
  $echo 'restore of' 'tcl-socket/example/tst-via-tbiff' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/tst-via-tbiff:' 'MD5 check failed'
ea6da3168e2dac61b9f89923d161eeed  tcl-socket/example/tst-via-tbiff
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/tst-via-tbiff'`"
    test 418 -eq "$shar_count" ||
    $echo 'tcl-socket/example/tst-via-tbiff:' 'original size' '418,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/tst.mesg ==============
if test -f 'tcl-socket/example/tst.mesg' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/tst.mesg' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/tst.mesg' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/tst.mesg' &&
Although we modern persons tend to take our electric lights, radios,
mixers, etc., for granted, hundreds of years ago people did not have
any of these things, which is just as well because there was no place
to plug them in.  Then along came the first Electrical Pioneer,
Benjamin Franklin, who flew a kite in a lighting storm and received a
serious electrical shock.  This proved that lighting was powered by the
same force as carpets, but it also damaged Franklin's brain so severely
that he started speaking only in incomprehensible maxims, such as "A
penny saved is a penny earned."  Eventually he had to be given a job
running the post office.
X		-- Dave Barry, "What is Electricity?"
SHAR_EOF
  $shar_touch -am 0723144698 'tcl-socket/example/tst.mesg' &&
  chmod 0644 'tcl-socket/example/tst.mesg' ||
  $echo 'restore of' 'tcl-socket/example/tst.mesg' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/tst.mesg:' 'MD5 check failed'
4fc2a327d36ca0fd51866ec7e5704cce  tcl-socket/example/tst.mesg
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/tst.mesg'`"
    test 689 -eq "$shar_count" ||
    $echo 'tcl-socket/example/tst.mesg:' 'original size' '689,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/tst.mail ==============
if test -f 'tcl-socket/example/tst.mail' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/tst.mail' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/tst.mail' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/tst.mail' &&
XFrom moi Thu Jul 16 22:30:46 1998
Received: by this.host.on.the.net id <337317>; Thu, 16 Jul 1998 22:30:41 +0100
To:	myself
XFrom:	me
Subject: just testing
Message-Id: <98Jul16.223041edt.337317@this.host.on.the.net>
Date:	Thu, 16 Jul 1998 22:30:41 +0100
Status: R
X
Although we modern persons tend to take our electric lights, radios,
mixers, etc., for granted, hundreds of years ago people did not have
any of these things, which is just as well because there was no place
to plug them in.  Then along came the first Electrical Pioneer,
Benjamin Franklin, who flew a kite in a lighting storm and received a
serious electrical shock.  This proved that lighting was powered by the
same force as carpets, but it also damaged Franklin's brain so severely
that he started speaking only in incomprehensible maxims, such as "A
penny saved is a penny earned."  Eventually he had to be given a job
running the post office.
X		-- Dave Barry, "What is Electricity?"
X
SHAR_EOF
  $shar_touch -am 0723143598 'tcl-socket/example/tst.mail' &&
  chmod 0644 'tcl-socket/example/tst.mail' ||
  $echo 'restore of' 'tcl-socket/example/tst.mail' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/tst.mail:' 'MD5 check failed'
106c74e7608720132422c4f450e848b9  tcl-socket/example/tst.mail
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/tst.mail'`"
    test 954 -eq "$shar_count" ||
    $echo 'tcl-socket/example/tst.mail:' 'original size' '954,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/example/tst-end-to-end ==============
if test -f 'tcl-socket/example/tst-end-to-end' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/example/tst-end-to-end' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/example/tst-end-to-end' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/example/tst-end-to-end' &&
#!/bin/sh -x
#
# an end-to-end test of tbiff and bifftk.
#
X
# try to make sure bifftk is running.
tbiff y
X
fgrep tbiff $HOME/.forward
X
Mail -s "testing tbiff/bifftk" $USER < ./tst.mesg
SHAR_EOF
  $shar_touch -am 0723152398 'tcl-socket/example/tst-end-to-end' &&
  chmod 0755 'tcl-socket/example/tst-end-to-end' ||
  $echo 'restore of' 'tcl-socket/example/tst-end-to-end' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/example/tst-end-to-end:' 'MD5 check failed'
4e2da62430909cdeae62ace31511bff7  tcl-socket/example/tst-end-to-end
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/example/tst-end-to-end'`"
    test 185 -eq "$shar_count" ||
    $echo 'tcl-socket/example/tst-end-to-end:' 'original size' '185,' 'current size' "$shar_count!"
  fi
fi
# ============= tcl-socket/Readme ==============
if test -f 'tcl-socket/Readme' && test "$first_param" != -c; then
  $echo 'x -' SKIPPING 'tcl-socket/Readme' '(file already exists)'
else
  $echo 'x -' extracting 'tcl-socket/Readme' '(text)'
  sed 's/^X//' << 'SHAR_EOF' > 'tcl-socket/Readme' &&
X
Hello.  Here's an attempt at modifying the Tcl "socket" command to
allow it to use unix-domain sockets as well as network sockets.
X
The modification involved adding "-local" to the socket command options.
X
contents
--------
Readme		- this file.
Tcl7.5-diffs	- patches to tcl7.5
eg-client.t	- a simple example of client-mode socket usage.
eg-server.t	- a simple example of server-mode socket usage.
example		- sample tcl and expectk scripts which make
X		  use of the modified socket command.
X
These patches seem to work under bsdi-3.1.
The bifftk script is in daily use on my workstation.
X
Hope this proves useful.
X
Paul Kern.
pkern@utcc.utoronto.ca
X
SHAR_EOF
  $shar_touch -am 0723222798 'tcl-socket/Readme' &&
  chmod 0644 'tcl-socket/Readme' ||
  $echo 'restore of' 'tcl-socket/Readme' 'failed'
  if ( md5sum --help 2>&1 | grep 'sage: md5sum \[' ) >/dev/null 2>&1 \
  && ( md5sum --version 2>&1 | grep -v 'textutils 1.12' ) >/dev/null; then
    md5sum -c << SHAR_EOF >/dev/null 2>&1 \
    || $echo 'tcl-socket/Readme:' 'MD5 check failed'
58fcf30ce53771fa07dddd7e781e835f  tcl-socket/Readme
SHAR_EOF
  else
    shar_count="`LC_ALL= LC_CTYPE= LANG= wc -c < 'tcl-socket/Readme'`"
    test 651 -eq "$shar_count" ||
    $echo 'tcl-socket/Readme:' 'original size' '651,' 'current size' "$shar_count!"
  fi
fi
rm -fr _sh13861
exit 0