home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / experimental / tclSocket.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-03-29  |  48.4 KB  |  1,338 lines
  1. /*
  2.  * tclSocket.c --
  3.  *
  4.  * This file defines all the Socket system calls to be usable with Tcl
  5.  *---------------------------------------------------------------------------
  6.  * Copyright 1992 Lance Ellinghouse. lance@markv.com
  7.  *
  8.  * Permission to use, copy, modify, and distribute this software and its
  9.  * documentation for any purpose and without fee is hereby granted, provided
  10.  * that the above copyright notice appear in all copies. Lance Ellinghouse
  11.  * makes no representations about the suitability of this software for any 
  12.  * purpose.  It is provided "as is" without express or implied warranty.
  13.  */
  14.  
  15. /*
  16.  * Version 1.3: 
  17.  */
  18.  
  19. /*
  20.  * ChangeLog:
  21.  *
  22.  * Version 1.3: 
  23.  *     03/17/92: (Sent to markd@sco.com on 03/17/92)
  24.  *     Cleaned up the error return messages
  25.  *     Fixed a few minor bugs
  26.  *     02/27/92:
  27.  *     Added Tcl_SocketCmd() back in and redid the calling structure
  28.  *         to be "socket cmd" instead of just "cmd". This makes it more
  29.  *         Tcl like.
  30.  *     Added Tcl_SocketDelete()
  31.  *     Modified Tcl_InitSocket() to use Tcl_SocketCmd() and Tcl_SocketDelete()
  32.  *     address(sin_addr.s_addr) changed to address(sin_addr) to make things
  33.  *         easier and more in line with Tcl.
  34.  *
  35.  * Version 1.2: 02/16/91 (Posted to Net on 02/26/92)
  36.  *     Changed layout of code to make it more modular and flexible.
  37.  *     Added "rcmd" for super-user access to run remote commands
  38.  *           (Not Fully Tested)
  39.  *     Added "rexec" for access to run remote commands
  40.  *           (Not Fully Tested)
  41.  *     Added "gethostbyaddr"
  42.  *           (Not Fully Tested)
  43.  *     Added "getpeername"
  44.  *     Added "getsockname"
  45.  *     Added "shutdown"
  46.  *           (Not Fully Tested)
  47.  *     Fixed a number of bugs
  48.  *
  49.  * Version 1.1: 02/14/91
  50.  *     Changed all Inet address handling to use and return octet format
  51.  *     where ever possible. Also changed all returned port numbers to
  52.  *     be in HOST format instead of NETWORK format. These changes make it
  53.  *     more in the spirit of Tcl.
  54.  *
  55.  * Version 1.0:
  56.  *     Released to general usage on UseNet
  57.  *
  58.  */
  59.  
  60. #include "tclSocket.h"
  61.  
  62.  
  63. /*
  64.  *----------------------------------------------------------------------
  65.  *
  66.  *  [file#] socket socket {socket_family} {socket_type} {protocol}
  67.  *      socket_family = AF_INET (default)
  68.  *      socket_type = SOCK_STREAM (default), SOCK_DGRAM, SOCK_RAW
  69.  *      protocol = socket protocol. Default = 0
  70.  *
  71.  *  socket bind {file#} {server_addr}
  72.  *      file# = value returned by socket
  73.  *      server_addr = socket_address. This is a array name (see below for description)
  74.  *
  75.  *  socket listen {file#} {backlog}
  76.  *      file# = value returned by socket
  77.  *      backlog = number of outstanding connections (default and max is 5)
  78.  *
  79.  *  socket connect {file#} {server_addr}
  80.  *      file# = value returned by socket
  81.  *      server_addr = socket_address. This is a array name (see below for description)
  82.  *
  83.  *  [newfile#] socket accept {file#} {client_addr}
  84.  *      newfile# = New socket descriptor from client
  85.  *      file# = value returned by socket
  86.  *      client_addr = socket_address of client connection. This is an array name.
  87.  *
  88.  *  [nvalue] socket htonl {value}
  89.  *  [nvalue] socket htons {value}
  90.  *  [value]  socket ntohl {nvalue}
  91.  *  [value]  socket ntohs {nvalue}
  92.  *      value = value in HOST order
  93.  *      nvalue = value in NETWORK order
  94.  *
  95.  *  socket gethostbyname {hostent_var_name} {hostname}
  96.  *      hostent_var_name = host_ent. This is the name of an array as defined below in host_ent
  97.  *      hostname = name of host being looked up
  98.  *
  99.  *  [hostname] socket gethostname
  100.  *      hostname = the current machine's hostname as known by the system
  101.  *
  102.  *  socket getprotobyname {protoent_var_name} {protoname}
  103.  *      protoent_var_name = proto_ent. This is the name of an array as defined below in proto_ent
  104.  *      protoname = name to look up in the protocol's list. i.e. TCP, UDP, etc
  105.  *
  106.  *  socket getservbyname {servent_var_name} {service_name} {protocol}
  107.  *      servent_var_name = serv_ent. This is the name of an array as defined below in serv_ent
  108.  *      service_name = name of service to look up
  109.  *      protocol = name of protocol you wish to use, i.e. TCP, UDP
  110.  *
  111.  *  [file#] socket rcmd host_var_name port_num local_user_name remote_user_name command
  112.  *      file# = stream file handle connected to remote command's STDIN and STDOUT and STDERR
  113.  *      host_var_name = host name to connect to. Will be replaced with full hostname
  114.  *      port_num = port number to connect to. I.E. rshd or others gotten by getservbyname?
  115.  *      local_user_name = user name for local user
  116.  *      remote_user_name = user name to run command under
  117.  *      command = command to execute on remote machine
  118.  *  ***NOTE: only the super-user can run this command correctly
  119.  *
  120.  *  [file#] socket rexec host_var_name port_num user passwd command
  121.  *      file# = stream file handle connected to remote command's STDIN and STDOUT and STDERR
  122.  *      host_var_name = host name to connect to. Will be replaced with full hostname
  123.  *      port_num = port number to connect to. I.E. rshd or others gotten by getservbyname?
  124.  *      user = user name to run command under
  125.  *      passwd = password for user (can be "" and will be looked up
  126.  *              in user's .netrc or prompted for it.
  127.  *      command = command to execute on remote machine
  128.  *
  129.  *  socket getpeername file# peer_socket_var
  130.  *      file# = open socket file handle
  131.  *      peer_socket_var = socket_address of peer socket
  132.  *
  133.  *  socket getsockname file# sock_addr_var
  134.  *      file# = open socket file handle
  135.  *      sock_addr_var = socket_address of peer socket
  136.  *
  137.  *  socket shutdown file# how
  138.  *      file# = open socket file handle
  139.  *      how = how to shut down. NO_READ or NO_WRITE or NO_RDWR
  140.  *
  141.  ************ Array and structure definitions
  142.  *
  143.  *  socket_address = This is used to pass socket addresses around.
  144.  *                  It is an array with each index a specific entry.
  145.  *                  The index values are below along with allowable
  146.  *                  entries:
  147.  *      sin_family = AF_INET (default)
  148.  *      sin_addr = INADDR_ANY or x.x.x.x notation 
  149.  *                           (as returned by gethostbyname$(haddr) )
  150.  *      sin_port = port number in host order
  151.  *
  152.  *  host_ent = This is used to store the result of gethostbyname.
  153.  *                  It is an array with each index a specifiv entry.
  154.  *                  The index values are below.
  155.  *      h_name = Official name of host
  156.  *      h_aliases = This is a LIST of aliases for the Official hostname
  157.  *      h_addrtype = host's address type. Currently same as AF_INET
  158.  *      h_length = length in bytes of address.. This can be used in other places as needed.
  159.  *      h_addr = primary address for this host (in x.x.x.x notation)
  160.  *      h_addr_list = LIST of address aliases for this host. h_addr is NOT in this list.
  161.  *
  162.  *  proto_ent = This is used to store the result of getprotobyname.
  163.  *                  It is an array with each index a specifiv entry.
  164.  *                  The index values are below.
  165.  *      p_name = Official name of protocol
  166.  *      p_aliases = This is a LIST of aliases for the Official protoname
  167.  *      p_proto = This is the Protocol number that can be passed to "socket" and such.
  168.  *
  169.  *  serv_ent = This is used to store the result of getservbyname.
  170.  *                  It is an array with each index a specifiv entry.
  171.  *                  The index values are below.
  172.  *      s_name = Official name of service
  173.  *      s_aliases = LIST of aliases for the Official service name
  174.  *      s_port = port number to connect to (in host byte order)
  175.  *      s_proto = protocol name to use
  176.  *
  177.  ************
  178.  *
  179.  * Results:
  180.  *  A standard Tcl result. Defined above in '[]'s.
  181.  *
  182.  *----------------------------------------------------------------------
  183.  */
  184.  
  185. static char *socketCmdName = (char *)NULL;
  186.  
  187. static int  Get_sin(Tcl_Interp *iptr, char *cmdName, char *varName,
  188.                     struct sockaddr_in *sin, int *length)
  189. {
  190.         int     result = TCL_ERROR;
  191.         char    *value;
  192.         char    rtnval[50];
  193.  
  194.         /* Now load all values! */
  195.         if (sin->sin_family == AF_INET) {
  196.             strcpy(rtnval,"AF_INET");
  197.         }
  198.         if ((value = Tcl_SetVar2(iptr,varName,"sin_family",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  199.             result = TCL_ERROR;
  200.             goto exitPoint;
  201.         }
  202.  
  203.         strcpy(rtnval,inet_ntoa(sin->sin_addr));
  204.         if ((value = Tcl_SetVar2(iptr,varName,"sin_addr",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  205.             result = TCL_ERROR;
  206.             goto exitPoint;
  207.         }
  208.  
  209.         sprintf(rtnval,"%hu",ntohs(sin->sin_port));
  210.         if ((value = Tcl_SetVar2(iptr,varName,"sin_port",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  211.             result = TCL_ERROR;
  212.             goto exitPoint;
  213.         }
  214.         *length = sizeof(struct sockaddr_in);
  215.         result = TCL_OK;
  216. exitPoint:
  217.         return (result);
  218. }
  219.  
  220. static int  Set_sin(Tcl_Interp *iptr, char *cmdName, char *varName,
  221.                     struct sockaddr_in *sin, char *lenParm, int *length)
  222. {
  223.         int     result = TCL_OK;
  224.         char    *value;
  225.  
  226.         if ((value = Tcl_GetVar2(iptr,varName,"sin_family",TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  227.             result = TCL_ERROR;
  228.             goto exitPoint;
  229.         } else {
  230.             if (STREQU(value, "AF_INET")) {
  231.                 sin->sin_family = AF_INET;
  232.             }
  233.         }
  234.         if ((value = Tcl_GetVar2(iptr,varName,"sin_addr",TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  235.             result = TCL_ERROR;
  236.             goto exitPoint;
  237.         } else {
  238.             if (STREQU(value, "INADDR_ANY")) {
  239.                 sin->sin_addr.s_addr = INADDR_ANY;
  240.             } else {
  241.                 sin->sin_addr.s_addr = inet_addr(value);
  242.             }
  243.         }
  244.         if ((value = Tcl_GetVar2(iptr,varName,"sin_port",TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  245.             result = TCL_ERROR;
  246.             goto exitPoint;
  247.         } else {
  248.             sin->sin_port = htons((u_short)atoi(value));
  249.         }
  250.         if (lenParm != (char *)NULL) {
  251.             *length = atoi(lenParm);
  252.         } else {
  253.             *length = sizeof(struct sockaddr_in);
  254.         }
  255.         result = TCL_OK;
  256. exitPoint:
  257.         return (result);
  258. }
  259.  
  260.  
  261.     /* ARGSUSED */
  262. static int cmd_accept(dummy, iptr, argc, argv)
  263.     ClientData dummy;   /* Not used */
  264.     Tcl_Interp *iptr;   /* Current interpreter */
  265.     int argc;           /* Number of arguments */
  266.     char **argv;        /* Argument strings */
  267. {
  268.         int                 length = 0;
  269.         struct sockaddr_in  sin;
  270.         OpenFile            *origPtr=(OpenFile *)NULL,
  271.                             *newPtr=(OpenFile *)NULL;
  272.         int                 newFD;
  273.         char                fdName[15];
  274.         int                 result;
  275.         Interp              *iPtr=(Interp *)iptr;
  276.  
  277.         
  278.         if (argc != 3) {
  279.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  280.                                 ": wrong # of arguments: ", socketCmdName, " ",
  281.                                 argv[0],
  282.                                 " file# client_addr_var", (char *)NULL);
  283.             result = TCL_ERROR;
  284.             goto exitPoint;
  285.         }
  286.         if (TclGetOpenFile(iptr,argv[1],&origPtr)!=TCL_OK) {
  287.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  288.                                 ": ", argv[1], " is not a valid file descriptor",
  289.                                 (char *)NULL);
  290.             result = TCL_ERROR;
  291.             goto exitPoint;
  292.         }
  293.         if (origPtr->readable != 1 || origPtr->writable != 1) {
  294.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  295.                                 ": ", argv[1],
  296.                                 " is not readable and writeable. Possibly not a true socket",
  297.                                 (char *)NULL);
  298.             result = TCL_ERROR;
  299.             goto exitPoint;
  300.         }
  301.         if (argc==4)
  302.             length = atoi(Tcl_GetVar(iptr,argv[3],0));
  303.         else
  304.             length = sizeof(struct sockaddr_in);
  305.  
  306.         if ((newFD = accept(fileno(origPtr->f), &sin, &length)) < 0) {
  307.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  308.                                 ": failed: ", Tcl_UnixError(iptr), (char *)NULL);
  309.             result = TCL_ERROR;
  310.             goto exitPoint;
  311.         }
  312.         newPtr = (OpenFile *)ckalloc(sizeof(OpenFile));
  313.         newPtr->f = NULL;
  314.         newPtr->f2 = NULL;
  315.         newPtr->readable = 0;
  316.         newPtr->writable = 0;
  317.         newPtr->numPids = 0;
  318.         newPtr->pidPtr = NULL;
  319.         newPtr->errorId = 0;
  320.         newPtr->f = fdopen(newFD,"a+");
  321.         if (newPtr->f == (FILE *)NULL) {
  322.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  323.                                 ": fdopen failed: ", Tcl_UnixError(iptr), (char *)NULL);
  324.             result = TCL_ERROR;
  325.             goto exitPoint;
  326.         }
  327.         newPtr->readable = newPtr->writable = 1;
  328.         TclMakeFileTable(iPtr,newFD);
  329.         if (iPtr->filePtrArray[newFD] != (OpenFile *)NULL) {
  330.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], "socket already open error",
  331.                 (char *)NULL);
  332.             result = TCL_ERROR;
  333.             goto exitPoint;
  334.         }
  335.         iPtr->filePtrArray[newFD] = newPtr;
  336.         setvbuf(newPtr->f, (char *)NULL, _IONBF, 0);
  337.         sprintf(fdName,"file%d",newFD);
  338.         Tcl_SetResult(iptr,fdName,TCL_VOLATILE);
  339.  
  340.         result = Get_sin(iptr, argv[0], argv[2], &sin, &length);
  341.         if (result == TCL_ERROR) {
  342.             newPtr = (OpenFile *)NULL;
  343.             goto exitPoint;
  344.         }
  345.  
  346.         result = TCL_OK;
  347. exitPoint:
  348.         if (result == TCL_ERROR)
  349.             if (newPtr != (OpenFile *)NULL)
  350.                 ckfree((char *)newPtr);
  351.         return(result);
  352. }
  353.  
  354.     /* ARGSUSED */
  355. static int cmd_bind(dummy, iptr, argc, argv)
  356.     ClientData dummy;   /* Not used */
  357.     Tcl_Interp *iptr;   /* Current interpreter */
  358.     int argc;           /* Number of arguments */
  359.     char **argv;        /* Argument strings */
  360. {
  361.         char                *p1,
  362.                             *p2,
  363.                             *value;
  364.         int                 length = 0;
  365.         struct sockaddr_in  sin;
  366.         OpenFile            *filePtr=(OpenFile *)NULL;
  367.         int                 result;
  368.  
  369.         if (argc < 3 || argc > 4) {
  370.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  371.                                 ": wrong # of arguments: ", socketCmdName, 
  372.                                 " ", argv[0], " file# server_addr",
  373.                                 (char *)NULL);
  374.             result = TCL_ERROR;
  375.             goto exitPoint;
  376.         }
  377.         if (TclGetOpenFile(iptr,argv[1],&filePtr)!=TCL_OK) {
  378.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  379.                                 ": ", argv[1], " is not a valid file descriptor",
  380.                                 (char *)NULL);
  381.             result = TCL_ERROR;
  382.             goto exitPoint;
  383.         }
  384.         if (filePtr->readable != 1 || filePtr->writable != 1) {
  385.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  386.                         ": ", argv[1], " is not readable and writeable. Possibly not a true socket",
  387.                         (char *)NULL);
  388.             result = TCL_ERROR;
  389.             goto exitPoint;
  390.         }
  391.         sin.sin_family = AF_INET;
  392.         sin.sin_addr.s_addr = INADDR_ANY;
  393.         sin.sin_port = 0;
  394.         result = Set_sin(iptr, argv[0], argv[2], &sin, (argc==4?argv[3]:NULL), &length);
  395.         if (result == TCL_ERROR) {
  396.             goto exitPoint;
  397.         }
  398.         if (bind(fileno(filePtr->f),&sin,length) < 0) {
  399.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  400.                         ": failed: ", Tcl_UnixError(iptr),
  401.                         (char *)NULL);
  402.             result = TCL_ERROR;
  403.             goto exitPoint;
  404.         }
  405.         Tcl_ResetResult(iptr);
  406.         result = TCL_OK;
  407. exitPoint:
  408.         return(result);
  409. }
  410.  
  411.     /* ARGSUSED */
  412. static int cmd_connect(dummy, iptr, argc, argv)
  413.     ClientData dummy;   /* Not used */
  414.     Tcl_Interp *iptr;   /* Current interpreter */
  415.     int argc;           /* Number of arguments */
  416.     char **argv;        /* Argument strings */
  417. {
  418.         int                 length = 0;
  419.         struct sockaddr_in  sin;
  420.         OpenFile            *filePtr=(OpenFile *)NULL;
  421.         int                 result;
  422.  
  423.         if (argc != 3) {
  424.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  425.                             ": wrong # of arguments: ",
  426.                             socketCmdName, " ", argv[0], " file# server_addr",
  427.                             (char *)NULL);
  428.             result = TCL_ERROR;
  429.             goto exitPoint;
  430.         }
  431.         if (TclGetOpenFile(iptr,argv[1],&filePtr)!=TCL_OK) {
  432.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  433.                             ": ", argv[1], " is not a valid file descriptor",
  434.                             (char *)NULL);
  435.             result = TCL_ERROR;
  436.             goto exitPoint;
  437.         }
  438.         if (filePtr->readable != 1 || filePtr->writable != 1) {
  439.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  440.                             ": ", argv[1], " is not readable and writeable. Possibly not a true socket",
  441.                             (char *)NULL);
  442.             result = TCL_ERROR;
  443.             goto exitPoint;
  444.         }
  445.         sin.sin_family = AF_INET;
  446.         sin.sin_addr.s_addr = INADDR_ANY;
  447.         sin.sin_port = 0;
  448.         result = Set_sin(iptr, argv[0], argv[2], &sin, (argc==4?argv[3]:NULL), &length);
  449.         if (result == TCL_ERROR) {
  450.             goto exitPoint;
  451.         }
  452.         if (connect(fileno(filePtr->f),&sin,length) < 0) {
  453.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  454.                             ": failed: ", Tcl_UnixError(iptr),
  455.                             (char *)NULL);
  456.             result = TCL_ERROR;
  457.             goto exitPoint;
  458.         }
  459.         Tcl_ResetResult(iptr);
  460.         result = TCL_OK;
  461. exitPoint:
  462.         return(result);
  463. }
  464.  
  465. static int SetHostInfo(iptr, cmd_name, host, varName)
  466.     Tcl_Interp      *iptr;
  467.     char            *cmd_name;
  468.     struct hostent  *host;
  469.     char            *varName;
  470. {
  471.         struct in_addr  saddr;
  472.         char            rtnval[50];
  473.         char            *list;
  474.         char            *tmplist;
  475.         char            *value;
  476.         int             index;
  477.         int             result;
  478.  
  479.         if ((value = Tcl_SetVar2(iptr,varName,"h_name",host->h_name,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  480.             result = TCL_ERROR;
  481.             goto exitPoint;
  482.         }
  483.         list = ckalloc(5);
  484.         strcpy(list,"");
  485.         index = 0;
  486.         while (host->h_aliases[index] != (char *)NULL) {
  487.             tmplist = ckalloc(strlen(list)+strlen(host->h_aliases[index])+5);
  488.             if (index == 0)
  489.                 sprintf(tmplist,"%s%s",list,host->h_aliases[index]);
  490.             else
  491.                 sprintf(tmplist,"%s %s",list,host->h_aliases[index]);
  492.             ckfree(list);
  493.             list=tmplist;
  494.             index++;
  495.         }
  496.         if ((value = Tcl_SetVar2(iptr,varName,"h_aliases",list,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  497.             ckfree(list);
  498.             result = TCL_ERROR;
  499.             goto exitPoint;
  500.         }
  501.         ckfree(list);
  502.         sprintf(rtnval,"%d",host->h_addrtype);
  503.         if ((value = Tcl_SetVar2(iptr,varName,"h_addrtype",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  504.             result = TCL_ERROR;
  505.             goto exitPoint;
  506.         }
  507.         sprintf(rtnval,"%d",host->h_length);
  508.         if ((value = Tcl_SetVar2(iptr,varName,"h_length",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  509.             result = TCL_ERROR;
  510.             goto exitPoint;
  511.         }
  512.         bcopy(host->h_addr_list[0], (char *)&saddr, host->h_length);
  513.         strcpy(rtnval,inet_ntoa(saddr));
  514.         if ((value = Tcl_SetVar2(iptr,varName,"h_addr",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  515.             result = TCL_ERROR;
  516.             goto exitPoint;
  517.         }
  518.         list = ckalloc(5);
  519.         strcpy(list,"");
  520.         index = 1;
  521.         while (host->h_addr_list[index] != (char *)NULL) {
  522.             bcopy(host->h_addr_list[index], (char *)&saddr, host->h_length);
  523.             strcpy(rtnval,inet_ntoa(saddr));
  524.             tmplist = ckalloc(strlen(list)+strlen(rtnval)+5);
  525.             if (index == 1)
  526.                 sprintf(tmplist,"%s%s",list,rtnval);
  527.             else
  528.                 sprintf(tmplist,"%s %s",list,rtnval);
  529.             ckfree(list);
  530.             list=tmplist;
  531.             index++;
  532.         }
  533.         if ((value = Tcl_SetVar2(iptr,varName,"h_addr_list",list,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  534.             ckfree(list);
  535.             result = TCL_ERROR;
  536.             goto exitPoint;
  537.         }
  538.         ckfree(list);
  539.  
  540.         result = TCL_OK;
  541. exitPoint:
  542.         return(result);
  543. }
  544.  
  545.     /* ARGSUSED */
  546. static int cmd_gethostby(dummy, iptr, argc, argv)
  547.     ClientData dummy;   /* Not used */
  548.     Tcl_Interp *iptr;   /* Current interpreter */
  549.     int argc;           /* Number of arguments */
  550.     char **argv;        /* Argument strings */
  551. {
  552.         struct hostent  *host;
  553.         extern int      h_errno;
  554.         char            rtnval[50];
  555.         char            *varName;
  556.         char            *value;
  557.         int             index;
  558.         int             result;
  559.         int             is_gethostbyname = FALSE;
  560.  
  561.         if (STREQU(argv[0],"gethostbyname"))
  562.             is_gethostbyname = TRUE;
  563.         else
  564.             is_gethostbyname = FALSE;
  565.  
  566.         if (argc != 3) {
  567.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], 
  568.                                     ": wrong # of arguments: ",
  569.                                     socketCmdName, " ", argv[0], (char *)NULL);
  570.             if (is_gethostbyname == TRUE)
  571.                 Tcl_AppendResult(iptr, 
  572.                                     " host_ent_var_name hostname",
  573.                                     (char *)NULL);
  574.             else
  575.                 Tcl_AppendResult(iptr, 
  576.                                     " host_ent_var_name IPAddress",
  577.                                     (char *)NULL);
  578.             result = TCL_ERROR;
  579.             goto exitPoint;
  580.         }
  581.         varName = argv[1];
  582. tryingAgain:
  583.         if (is_gethostbyname == TRUE)
  584.             host = gethostbyname (argv[2]);
  585.         else
  586.             host = gethostbyaddr (argv[2], strlen(argv[2]), AF_INET);
  587.         if (host == (struct hostent *)NULL) {
  588.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  589.                                     ": Error: ", (char *)NULL);
  590.             switch (h_errno) {
  591.                 case TRY_AGAIN:
  592.                     /* Sleep for 2 sec and then try again.. 
  593.                         afterall that is what it is telling us to do */
  594.                     sleep(2);
  595.                     goto tryingAgain;
  596.                     break;
  597.                 case HOST_NOT_FOUND:
  598.                     Tcl_AppendResult(iptr, "Host Not Found.", (char *)NULL);
  599.                     break;
  600.                 case NO_RECOVERY:
  601.                     Tcl_AppendResult(iptr, "DNS unrecoverable failure.", (char *)NULL);
  602.                     break;
  603.                 case NO_ADDRESS:
  604.                     Tcl_AppendResult(iptr, "This host has NO address.", (char *)NULL);
  605.                     break;
  606.                 default:
  607.                     Tcl_AppendResult(iptr, "Unknown Error #", (char *)NULL);
  608.                     sprintf(rtnval,"%d.", h_errno);
  609.                     Tcl_AppendResult(iptr, rtnval, (char *)NULL);
  610.                     break;
  611.             }
  612.             result = TCL_ERROR;
  613.             goto exitPoint;
  614.         }
  615.         
  616.         result = SetHostInfo(iptr, argv[0], host, varName);
  617.         if (result == TCL_OK)
  618.             Tcl_ResetResult(iptr);
  619. exitPoint:
  620.         endhostent();
  621.         return(result);
  622. }
  623.  
  624.     /* ARGSUSED */
  625. static int cmd_gethostname(dummy, iptr, argc, argv)
  626.     ClientData dummy;   /* Not used */
  627.     Tcl_Interp *iptr;   /* Current interpreter */
  628.     int argc;           /* Number of arguments */
  629.     char **argv;        /* Argument strings */
  630. {
  631.         char    rtnval[MAXHOSTNAMELEN+1];
  632.         int     result;
  633.  
  634.         if (argc != 1) {
  635.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  636.                                 ": wrong # of arguments: ",
  637.                                 socketCmdName, " ", argv[0],
  638.                                 (char *)NULL);
  639.             result = TCL_ERROR;
  640.             goto exitPoint;
  641.         }
  642.         rtnval[0]='\0';
  643.         gethostname(rtnval,MAXHOSTNAMELEN);
  644.         Tcl_SetResult(iptr,rtnval,TCL_VOLATILE);
  645.         result = TCL_OK;
  646. exitPoint:
  647.         return (result);
  648. }
  649.  
  650.     /* ARGSUSED */
  651. static int cmd_getprotobyname(dummy, iptr, argc, argv)
  652.     ClientData dummy;   /* Not used */
  653.     Tcl_Interp *iptr;   /* Current interpreter */
  654.     int argc;           /* Number of arguments */
  655.     char **argv;        /* Argument strings */
  656. {
  657.         struct protoent     *proto;
  658.         char                rtnval[50];
  659.         char                *varName;
  660.         char                *list;
  661.         char                *tmplist;
  662.         char                *value;
  663.         int                 index;
  664.         int                 result;
  665.  
  666.         if (argc != 3) {
  667.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  668.                                 ": wrong # of arguments: ", 
  669.                                 socketCmdName, " ", argv[0], " protoent_var_name protocol_name",
  670.                                 (char *)NULL);
  671.             result = TCL_ERROR;
  672.             goto exitPoint;
  673.         }
  674.         varName = argv[1];
  675.         if ((proto=getprotobyname(argv[2]))==(struct hostent *)NULL) {
  676.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  677.                                 ": Error: Protocol \"", argv[2], "\" not found.",
  678.                                 (char *)NULL);
  679.             result = TCL_ERROR;
  680.             goto exitPoint;
  681.         }
  682.         
  683.         if ((value = Tcl_SetVar2(iptr,varName,"p_name",proto->p_name,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  684.             result = TCL_ERROR;
  685.             goto exitPoint;
  686.         }
  687.         list = ckalloc(5);
  688.         strcpy(list,"");
  689.         index = 0;
  690.         while (proto->p_aliases[index] != (char *)NULL) {
  691.             tmplist = ckalloc(strlen(list)+strlen(proto->p_aliases[index])+5);
  692.             if (index == 0)
  693.                 sprintf(tmplist,"%s%s",list,proto->p_aliases[index]);
  694.             else
  695.                 sprintf(tmplist,"%s %s",list,proto->p_aliases[index]);
  696.             ckfree(list);
  697.             list=tmplist;
  698.             index++;
  699.         }
  700.         if ((value = Tcl_SetVar2(iptr,varName,"p_aliases",list,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  701.             ckfree(list);
  702.             result = TCL_ERROR;
  703.             goto exitPoint;
  704.         }
  705.         ckfree(list);
  706.         sprintf(rtnval,"%d",proto->p_proto);
  707.         if ((value = Tcl_SetVar2(iptr,varName,"p_proto",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  708.             result = TCL_ERROR;
  709.             goto exitPoint;
  710.         }
  711.  
  712.         Tcl_ResetResult(iptr);
  713.         result = TCL_OK;
  714. exitPoint:
  715.         endprotoent();
  716.         return(result);
  717. }
  718.  
  719.     /* ARGSUSED */
  720. static int cmd_getservbyname(dummy, iptr, argc, argv)
  721.     ClientData dummy;   /* Not used */
  722.     Tcl_Interp *iptr;   /* Current interpreter */
  723.     int argc;           /* Number of arguments */
  724.     char **argv;        /* Argument strings */
  725. {
  726.         struct servent      *serv;
  727.         char                rtnval[50];
  728.         char                *varName;
  729.         char                *list;
  730.         char                *tmplist;
  731.         char                *value;
  732.         int                 index;
  733.         int                 result;
  734.  
  735.         if (argc != 4) {
  736.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  737.                                 ": wrong # of arguments: ",
  738.                                 socketCmdName, " ", argv[0],
  739.                                 " servent_var_name service protocol_name",
  740.                                 (char *)NULL);
  741.             result = TCL_ERROR;
  742.             goto exitPoint;
  743.         }
  744.         varName = argv[1];
  745.         if ((serv=getservbyname(argv[2], argv[3]))==(struct servent *)NULL) {
  746.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  747.                                 ": Error: Service \"", argv[2],
  748.                                 "\" for Protocol \"", argv[3],
  749.                                 "\" not found.",
  750.                                 (char *)NULL);
  751.             result = TCL_ERROR;
  752.             goto exitPoint;
  753.         }
  754.         
  755.         if ((value = Tcl_SetVar2(iptr,varName,"s_name",serv->s_name,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  756.             result = TCL_ERROR;
  757.             goto exitPoint;
  758.         }
  759.         list = ckalloc(5);
  760.         strcpy(list,"");
  761.         index = 0;
  762.         while (serv->s_aliases[index] != (char *)NULL) {
  763.             tmplist = ckalloc(strlen(list)+strlen(serv->s_aliases[index])+5);
  764.             if (index == 0)
  765.                 sprintf(tmplist,"%s%s",list,serv->s_aliases[index]);
  766.             else
  767.                 sprintf(tmplist,"%s %s",list,serv->s_aliases[index]);
  768.             ckfree(list);
  769.             list=tmplist;
  770.             index++;
  771.         }
  772.         if ((value = Tcl_SetVar2(iptr,varName,"s_aliases",list,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  773.             ckfree(list);
  774.             result = TCL_ERROR;
  775.             goto exitPoint;
  776.         }
  777.         ckfree(list);
  778.         sprintf(rtnval,"%d",ntohs((ushort)serv->s_port));
  779.         if ((value = Tcl_SetVar2(iptr,varName,"s_port",rtnval,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  780.             result = TCL_ERROR;
  781.             goto exitPoint;
  782.         }
  783.         if ((value = Tcl_SetVar2(iptr,varName,"s_proto",serv->s_proto,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  784.             result = TCL_ERROR;
  785.             goto exitPoint;
  786.         }
  787.  
  788.         Tcl_ResetResult(iptr);
  789.         result = TCL_OK;
  790. exitPoint:
  791.         endservent();
  792.         return(result);
  793. }
  794.  
  795.     /* ARGSUSED */
  796. static int cmd_htonl(dummy, iptr, argc, argv)
  797.     ClientData dummy;   /* Not used */
  798.     Tcl_Interp *iptr;   /* Current interpreter */
  799.     int argc;           /* Number of arguments */
  800.     char **argv;        /* Argument strings */
  801. {
  802.         char    rtnval[30];
  803.         int     result;
  804.         unsigned long   arg=0, value=0;
  805.  
  806.         if (argc != 2) {
  807.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  808.                                 ": wrong # of arguments: ",
  809.                                 socketCmdName, " ", argv[0], " number",
  810.                                 (char *)NULL);
  811.             result = TCL_ERROR;
  812.             goto exitPoint;
  813.         }
  814.  
  815.         arg = (unsigned long)atol(argv[1]);
  816.         value = htonl(arg);
  817.         sprintf(rtnval,"%lu",value);
  818.  
  819.         Tcl_SetResult(iptr,rtnval,TCL_VOLATILE);
  820.         result = TCL_OK;
  821. exitPoint:
  822.         return(result);
  823. }
  824.  
  825.     /* ARGSUSED */
  826. static int cmd_htons(dummy, iptr, argc, argv)
  827.     ClientData dummy;   /* Not used */
  828.     Tcl_Interp *iptr;   /* Current interpreter */
  829.     int argc;           /* Number of arguments */
  830.     char **argv;        /* Argument strings */
  831. {
  832.         char    rtnval[30];
  833.         int     result;
  834.         unsigned short  arg=0, value=0;
  835.         if (argc != 2) {
  836.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  837.                                 ": wrong # of arguments: ",
  838.                                 socketCmdName, " ", argv[0], " number",
  839.                                 (char *)NULL);
  840.             result = TCL_ERROR;
  841.             goto exitPoint;
  842.         }
  843.  
  844.         arg = (unsigned short)atoi(argv[1]);
  845.         value = htons(arg);
  846.         sprintf(rtnval,"%hu",value);
  847.  
  848.         Tcl_SetResult(iptr,rtnval,TCL_VOLATILE);
  849.         result = TCL_OK;
  850. exitPoint:
  851.         return(result);
  852. }
  853.  
  854.     /* ARGSUSED */
  855. static int cmd_listen(dummy, iptr, argc, argv)
  856.     ClientData dummy;   /* Not used */
  857.     Tcl_Interp *iptr;   /* Current interpreter */
  858.     int argc;           /* Number of arguments */
  859.     char **argv;        /* Argument strings */
  860. {
  861.         OpenFile    *filePtr=(OpenFile *)NULL;
  862.         int         backlog=5;
  863.         int         result;
  864.  
  865.         if (argc < 2 || argc > 3) {
  866.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  867.                                 ": wrong # of arguments: ",
  868.                                 socketCmdName, " ", argv[0], " file# [backlog]",
  869.                                 (char *)NULL);
  870.             result = TCL_ERROR;
  871.             goto exitPoint;
  872.         }
  873.         if (TclGetOpenFile(iptr,argv[1],&filePtr)!=TCL_OK) {
  874.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  875.                                 ": ", argv[1], "s is not a valid file descriptor",
  876.                                 (char *)NULL);
  877.             result = TCL_ERROR;
  878.             goto exitPoint;
  879.         }
  880.         if (filePtr->readable != 1 || filePtr->writable != 1) {
  881.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  882.                         ": ", argv[1], " is not readable and writeable. Possibly not a true socket",
  883.                         (char *)NULL);
  884.             result = TCL_ERROR;
  885.             goto exitPoint;
  886.         }
  887.         if (argc == 3) {
  888.             backlog = atoi(argv[2]);
  889.             if (backlog < 0)
  890.                 backlog = 0;
  891.             if (backlog > 5)
  892.                 backlog = 5;
  893.         }
  894.         if (listen(fileno(filePtr->f),backlog) < 0) {
  895.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  896.                         ": failed: ", Tcl_UnixError(iptr),
  897.                         (char *)NULL);
  898.             result = TCL_ERROR;
  899.             goto exitPoint;
  900.         }
  901.         Tcl_ResetResult(iptr);
  902.         result = TCL_OK;
  903. exitPoint:
  904.         return(result);
  905. }
  906.  
  907.     /* ARGSUSED */
  908. static int cmd_ntohl(dummy, iptr, argc, argv)
  909.     ClientData dummy;   /* Not used */
  910.     Tcl_Interp *iptr;   /* Current interpreter */
  911.     int argc;           /* Number of arguments */
  912.     char **argv;        /* Argument strings */
  913. {
  914.         char    rtnval[30];
  915.         int     result;
  916.         unsigned long   arg=0, value=0;
  917.         if (argc != 2) {
  918.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  919.                                 ": wrong # of arguments: ",
  920.                                 socketCmdName, " ", argv[0], " number",
  921.                                 (char *)NULL);
  922.             result = TCL_ERROR;
  923.             goto exitPoint;
  924.         }
  925.  
  926.         arg = (unsigned long)atol(argv[1]);
  927.         value = ntohl(arg);
  928.         sprintf(rtnval,"%lu",value);
  929.  
  930.         Tcl_SetResult(iptr,rtnval,TCL_VOLATILE);
  931.         result = TCL_OK;
  932. exitPoint:
  933.         return(result);
  934. }
  935.  
  936.     /* ARGSUSED */
  937. static int cmd_ntohs(dummy, iptr, argc, argv)
  938.     ClientData dummy;   /* Not used */
  939.     Tcl_Interp *iptr;   /* Current interpreter */
  940.     int argc;           /* Number of arguments */
  941.     char **argv;        /* Argument strings */
  942. {
  943.         char    rtnval[30];
  944.         int     result;
  945.         unsigned short  arg=0, value=0;
  946.         if (argc != 2) {
  947.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  948.                                 ": wrong # of arguments: ",
  949.                                 socketCmdName, " ", argv[0], " number",
  950.                                 (char *)NULL);
  951.             result = TCL_ERROR;
  952.             goto exitPoint;
  953.         }
  954.  
  955.         arg = (unsigned short)atoi(argv[1]);
  956.         value = ntohs(arg);
  957.         sprintf(rtnval,"%hu",value);
  958.  
  959.         Tcl_SetResult(iptr,rtnval,TCL_VOLATILE);
  960.         result = TCL_OK;
  961. exitPoint:
  962.         return(result);
  963. }
  964.  
  965.     /* ARGSUSED */
  966. static int cmd_socket(dummy, iptr, argc, argv)
  967.     ClientData dummy;   /* Not used */
  968.     Tcl_Interp *iptr;   /* Current interpreter */
  969.     int argc;           /* Number of arguments */
  970.     char **argv;        /* Argument strings */
  971. {
  972.         int         domain=AF_INET;
  973.         int         type=SOCK_STREAM;
  974.         int         protocol=0;
  975.         int         s;
  976.         OpenFile    *filePtr=(OpenFile *)NULL;
  977.         int         result;
  978.         Interp      *iPtr=(Interp *)iptr;
  979.  
  980.         filePtr = (OpenFile *)ckalloc(sizeof(OpenFile));
  981.         filePtr->f = NULL;
  982.         filePtr->f2 = NULL;
  983.         filePtr->readable = 0;
  984.         filePtr->writable = 0;
  985.         filePtr->numPids = 0;
  986.         filePtr->pidPtr = NULL;
  987.         filePtr->errorId = 0;
  988.         switch (argc) {
  989.             case 4:
  990.                 protocol=atoi(argv[3]);
  991.             case 3:
  992.                 if (STREQU(argv[2],"SOCK_STREAM")) {
  993.                     type=SOCK_STREAM;
  994.                 } else if (STREQU(argv[2],"SOCK_DGRAM")) {
  995.                     type=SOCK_DGRAM;
  996.                 } else if (STREQU(argv[2],"SOCK_RAW")) {
  997.                     type=SOCK_RAW;
  998.                 }
  999.             case 2:
  1000.                 if (STREQU(argv[1],"AF_INET")) {
  1001.                     domain=AF_INET;
  1002.                 }
  1003.         }
  1004.         s=socket(domain,type,protocol);
  1005.         if (s < 0) {
  1006.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], ": failed: ",
  1007.                 Tcl_UnixError(iptr), (char *)NULL);
  1008.             result = TCL_ERROR;
  1009.             goto exitPoint;
  1010.         }
  1011.         filePtr->f = fdopen(s,"a+");
  1012.         if (filePtr->f == (FILE *)NULL) {
  1013.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], ": fdopen failed: ",
  1014.                 Tcl_UnixError(iptr), (char *)NULL);
  1015.             close(s);
  1016.             result = TCL_ERROR;
  1017.             goto exitPoint;
  1018.         }
  1019.         filePtr->readable = filePtr->writable = 1;
  1020.         TclMakeFileTable(iPtr,s);
  1021.         if (iPtr->filePtrArray[s] != (OpenFile *)NULL) {
  1022.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], ": socket already open error",
  1023.                 (char *)NULL);
  1024.             result = TCL_ERROR;
  1025.             goto exitPoint;
  1026.         }
  1027.         iPtr->filePtrArray[s] = filePtr;
  1028.         setvbuf(filePtr->f, (char *)NULL, _IONBF, 0);
  1029.         sprintf(iPtr->result,"file%d",s);
  1030.         result = TCL_OK;
  1031. exitPoint:
  1032.         if (result == TCL_ERROR)
  1033.             if (filePtr != (OpenFile *)NULL)
  1034.                 ckfree((char *)filePtr);
  1035.         return(result);
  1036. }
  1037.  
  1038.     /* ARGSUSED */
  1039. static int cmd_rexecrcmd(dummy, iptr, argc, argv)
  1040.     ClientData dummy;   /* Not used */
  1041.     Tcl_Interp *iptr;   /* Current interpreter */
  1042.     int argc;           /* Number of arguments */
  1043.     char **argv;        /* Argument strings */
  1044. {
  1045.         int             s;
  1046.         OpenFile        *filePtr=(OpenFile *)NULL;
  1047.         int             result;
  1048.         Interp          *iPtr=(Interp *)iptr;
  1049.         char            hostname[MAXHOSTNAMELEN];
  1050.         char            *h;
  1051.         unsigned short  port_num=0;
  1052.         char            *value;
  1053.         int             is_rexec=FALSE;
  1054.  
  1055.         filePtr = (OpenFile *)ckalloc(sizeof(OpenFile));
  1056.         filePtr->f = NULL;
  1057.         filePtr->f2 = NULL;
  1058.         filePtr->readable = 0;
  1059.         filePtr->writable = 0;
  1060.         filePtr->numPids = 0;
  1061.         filePtr->pidPtr = NULL;
  1062.         filePtr->errorId = 0;
  1063.  
  1064.         if (STREQU(argv[0], "rexec"))
  1065.             is_rexec = TRUE;
  1066.         else
  1067.             is_rexec = FALSE;
  1068.  
  1069.         if (argc != 6) {
  1070.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1071.                                     ": wrong # of arguments: ",
  1072.                                     socketCmdName, " ", argv[0],
  1073.                                     (char *)NULL);
  1074.             if (is_rexec == TRUE)
  1075.                 Tcl_AppendResult(iptr,
  1076.                                 " host_var_name port user passwd cmd",
  1077.                                 (char *)NULL);
  1078.             else
  1079.                 Tcl_AppendResult(iptr,
  1080.                                 " host_var_name port locuser remuser cmd",
  1081.                                 (char *)NULL);
  1082.             result = TCL_ERROR;
  1083.             goto exitPoint;
  1084.         }
  1085.         if ((value = Tcl_GetVar(iptr,argv[1],TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  1086.             result = TCL_ERROR;
  1087.             goto exitPoint;
  1088.         } else {
  1089.             strcpy(hostname,value);
  1090.         }
  1091.         port_num = (unsigned short)atoi(argv[2]);
  1092.         h = hostname;
  1093.         if (is_rexec == TRUE)
  1094.             s=rexec(&h,port_num,argv[3],argv[4],argv[5],(int *)0);
  1095.         else
  1096.             s=rcmd(&h,port_num,argv[3],argv[4],argv[5],(int *)0);
  1097.         if (s < 0) {
  1098.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], ": failed: ",
  1099.                 Tcl_UnixError(iptr), (char *)NULL);
  1100.             result = TCL_ERROR;
  1101.             goto exitPoint;
  1102.         }
  1103.         filePtr->f = fdopen(s,"a+");
  1104.         if (filePtr->f == (FILE *)NULL) {
  1105.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], ": fdopen failed: ",
  1106.                 Tcl_UnixError(iptr), (char *)NULL);
  1107.             close(s);
  1108.             result = TCL_ERROR;
  1109.             goto exitPoint;
  1110.         }
  1111.         filePtr->readable = filePtr->writable = 1;
  1112.         TclMakeFileTable(iPtr,s);
  1113.         if (iPtr->filePtrArray[s] != (OpenFile *)NULL) {
  1114.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0], ":socket already open error",
  1115.                 (char *)NULL);
  1116.             result = TCL_ERROR;
  1117.             goto exitPoint;
  1118.         }
  1119.         iPtr->filePtrArray[s] = filePtr;
  1120.         setvbuf(filePtr->f, (char *)NULL, _IONBF, 0);
  1121.         sprintf(iPtr->result,"file%d",s);
  1122.         result = TCL_OK;
  1123.         if ((value = Tcl_SetVar(iptr,argv[1],hostname,TCL_LEAVE_ERR_MSG))==(char *)NULL) {
  1124.             result = TCL_ERROR;
  1125.             goto exitPoint;
  1126.         }
  1127. exitPoint:
  1128.         if (result == TCL_ERROR)
  1129.             if (filePtr != (OpenFile *)NULL)
  1130.                 ckfree((char *)filePtr);
  1131.         return(result);
  1132. }
  1133.  
  1134.     /* ARGSUSED */
  1135. static int cmd_getnameinfo(dummy, iptr, argc, argv)
  1136.     ClientData dummy;   /* Not used */
  1137.     Tcl_Interp *iptr;   /* Current interpreter */
  1138.     int argc;           /* Number of arguments */
  1139.     char **argv;        /* Argument strings */
  1140. {
  1141.         int                 length = 0;
  1142.         struct sockaddr_in  sin;
  1143.         int                 result;
  1144.         OpenFile            *origPtr = (OpenFile *)NULL;
  1145.         int                 is_getpeername = FALSE;
  1146.         
  1147.         if (STREQU(argv[0],"getpeername"))
  1148.             is_getpeername = TRUE;
  1149.         else
  1150.             is_getpeername = FALSE;
  1151.  
  1152.         if (argc != 3) {
  1153.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1154.                                 ": wrong # of arguments: ",
  1155.                                 socketCmdName, " ", argv[0], " file# addr_var",
  1156.                                 (char *)NULL);
  1157.             result = TCL_ERROR;
  1158.             goto exitPoint;
  1159.         }
  1160.         if (TclGetOpenFile(iptr,argv[1],&origPtr)!=TCL_OK) {
  1161.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1162.                                 ": ", argv[1], " is not a valid file descriptor",
  1163.                                 (char *)NULL);
  1164.             result = TCL_ERROR;
  1165.             goto exitPoint;
  1166.         }
  1167.         if (origPtr->readable != 1 || origPtr->writable != 1) {
  1168.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1169.                         ": ", argv[1], " is not readable and writeable. Possibly not a true socket",
  1170.                                 (char *)NULL);
  1171.             result = TCL_ERROR;
  1172.             goto exitPoint;
  1173.         }
  1174.         if (argc==4)
  1175.             length = atoi(Tcl_GetVar(iptr,argv[3],0));
  1176.         else
  1177.             length = sizeof(struct sockaddr_in);
  1178.  
  1179.         if (is_getpeername == TRUE)
  1180.             result = getpeername(fileno(origPtr->f), &sin, &length);
  1181.         else
  1182.             result = getsockname(fileno(origPtr->f), &sin, &length);
  1183.  
  1184.         if (result < 0) {
  1185.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1186.                         ": failed: ", Tcl_UnixError(iptr),
  1187.                                 (char *)NULL);
  1188.             result = TCL_ERROR;
  1189.             goto exitPoint;
  1190.         }
  1191.  
  1192.         result = Get_sin(iptr, argv[0], argv[2], &sin, &length);
  1193.         if (result == TCL_ERROR) {
  1194.             goto exitPoint;
  1195.         }
  1196.         result = TCL_OK;
  1197. exitPoint:
  1198.         return(result);
  1199. }
  1200.     
  1201.     /* ARGSUSED */
  1202. static int cmd_shutdown(dummy, iptr, argc, argv)
  1203.     ClientData dummy;   /* Not used */
  1204.     Tcl_Interp *iptr;   /* Current interpreter */
  1205.     int argc;           /* Number of arguments */
  1206.     char **argv;        /* Argument strings */
  1207. {
  1208.         int                 result;
  1209.         OpenFile            *origPtr = (OpenFile *)NULL;
  1210.         int                 how;
  1211.         
  1212.         if (argc != 3) {
  1213.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1214.                             ": wrong # of arguments: ",
  1215.                             socketCmdName, " ", argv[0], " file# NO_READ|NO_WRITE|NO_RDWR",
  1216.                             (char *)NULL);
  1217.             result = TCL_ERROR;
  1218.             goto exitPoint;
  1219.         }
  1220.         if (STREQU(argv[2],"NO_READ"))
  1221.             how = 0;
  1222.         else if (STREQU(argv[2],"NO_WRITE"))
  1223.             how = 1;
  1224.         else if (STREQU(argv[2],"NO_RDWR"))
  1225.             how = 2;
  1226.         else {
  1227.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1228.                                 ": ", argv[2], " not a valid option. Valid options are: NO_READ, NO_WRITE, NO_RDWR",
  1229.                                 (char *)NULL);
  1230.             result = TCL_ERROR;
  1231.             goto exitPoint;
  1232.  
  1233.         }
  1234.         if (TclGetOpenFile(iptr,argv[1],&origPtr)!=TCL_OK) {
  1235.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1236.                                 ": ", argv[1], " is not a valid file descriptor",
  1237.                                 (char *)NULL);
  1238.             result = TCL_ERROR;
  1239.             goto exitPoint;
  1240.         }
  1241.         if (origPtr->readable != 1 || origPtr->writable != 1) {
  1242.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1243.                         ": ", argv[1], " is not readable and writeable. Possibly not a true socket",
  1244.                                 (char *)NULL);
  1245.             result = TCL_ERROR;
  1246.             goto exitPoint;
  1247.         }
  1248.  
  1249.         result = shutdown(fileno(origPtr->f), how);
  1250.  
  1251.         if (result < 0) {
  1252.             Tcl_AppendResult(iptr, socketCmdName, " ", argv[0],
  1253.                         ": failed: ", Tcl_UnixError(iptr),
  1254.                                 (char *)NULL);
  1255.             result = TCL_ERROR;
  1256.             goto exitPoint;
  1257.         }
  1258.  
  1259.         result = TCL_OK;
  1260. exitPoint:
  1261.         return(result);
  1262. }
  1263.  
  1264. static struct socket_cmd_ {
  1265.         char                *cmd;
  1266.         Tcl_CmdProc         *cmd_proc;
  1267.         ClientData          cmdData;
  1268.         Tcl_CmdDeleteProc   *cmdDelete;
  1269.         } socket_cmd[] = {
  1270.             "accept",           cmd_accept,         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1271.             "bind",             cmd_bind,           (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1272.             "connect",          cmd_connect,        (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1273.             "gethostbyname",    cmd_gethostby,      (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1274.             "gethostbyaddr",    cmd_gethostby,      (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1275.             "gethostname",      cmd_gethostname,    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1276.             "getpeername",      cmd_getnameinfo,    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1277.             "getprotobyname",   cmd_getprotobyname, (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1278.             "getservbyname",    cmd_getservbyname,  (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1279.             "getsockname",      cmd_getnameinfo,    (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1280.             "htonl",            cmd_htonl,          (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1281.             "htons",            cmd_htons,          (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1282.             "listen",           cmd_listen,         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1283.             "ntohl",            cmd_ntohl,          (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1284.             "ntohs",            cmd_ntohs,          (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1285.             "rexec",            cmd_rexecrcmd,      (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1286.             "rcmd",             cmd_rexecrcmd,      (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1287.             "shutdown",         cmd_shutdown,       (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1288.             "socket",           cmd_socket,         (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL,
  1289.             (char *)NULL,       (Tcl_CmdProc *)NULL,(ClientData)NULL, (Tcl_CmdDeleteProc *)NULL
  1290.         };
  1291.  
  1292. int Tcl_SocketCmd(ClientData clientData, Tcl_Interp *interp,
  1293.                   int argc, char *argv[])
  1294. {
  1295.     register struct socket_cmd_ *cmd;
  1296.     cmd = &socket_cmd[0];
  1297.  
  1298.     socketCmdName = argv[0];
  1299.     if (argc < 2)
  1300.         goto error_rtn;
  1301.     while (cmd->cmd != (char *)NULL) {
  1302.         if (STREQU(argv[1],cmd->cmd)) {
  1303.             return((*cmd->cmd_proc)(clientData,interp,(argc-1),&argv[1]));
  1304.         }
  1305.         cmd++;
  1306.     }
  1307. error_rtn:
  1308.     Tcl_AppendResult(interp, argv[0],
  1309.                 ": '", argv[1], "' not a valid command: valid commands are:",
  1310.                 (char *)NULL);
  1311.     cmd = &socket_cmd[0];
  1312.     while (cmd->cmd != (char *)NULL) {
  1313.         Tcl_AppendResult(interp, " ", cmd->cmd, (char *)NULL);
  1314.         cmd++;
  1315.     }
  1316.     return(TCL_ERROR);
  1317. }
  1318.  
  1319. void Tcl_SocketDelete(ClientData clientData)
  1320. {
  1321.     register struct socket_cmd_ *cmd;
  1322.     cmd = &socket_cmd[0];
  1323.  
  1324.     while (cmd->cmd != (char *)NULL) {
  1325.         if (cmd->cmdDelete != (Tcl_CmdDeleteProc *)NULL)
  1326.             (*cmd->cmdDelete)(clientData);
  1327.         cmd++;
  1328.     }
  1329. }
  1330.  
  1331. void Tcl_InitSocket(Tcl_Interp *iPtr)
  1332. {
  1333.     Tcl_CreateCommand(iPtr,"socket",Tcl_SocketCmd,(ClientData)NULL,Tcl_SocketDelete);
  1334. }
  1335.  
  1336.  
  1337.  
  1338.