home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / extend / src.unused / tclXserver.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-26  |  6.0 KB  |  217 lines  |  [TEXT/MPS ]
  1. /*
  2.  * tclXserver.c --
  3.  *
  4.  * High level commands for connecting to TCP/IP based servers.
  5.  *---------------------------------------------------------------------------
  6.  * Copyright 1991-1993 Karl Lehenbauer and Mark Diekhans.
  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.  Karl Lehenbauer and
  11.  * Mark Diekhans make no representations about the suitability of this
  12.  * software for any purpose.  It is provided "as is" without express or
  13.  * implied warranty.
  14.  */
  15.  
  16. #include "tclExtdInt.h"
  17.  
  18. #ifndef NO_SYS_SOCKET_H
  19.  
  20. #include <sys/types.h>
  21. #include <sys/socket.h>
  22. #include <netdb.h>
  23. #include <netinet/in.h>
  24. #include <arpa/inet.h>
  25.  
  26. extern int h_errno;
  27.  
  28.  
  29. /*
  30.  *-----------------------------------------------------------------------------
  31.  *
  32.  * Tcl_ServerOpen --
  33.  *     Implements the TCL server_open command:
  34.  *
  35.  *        server_open ?option? host service
  36.  *
  37.  *  Opens a stream socket to the specified host (host name or IP address),
  38.  *  service name or port number.  Options maybe -buf or -nobuf.
  39.  *
  40.  * Results:
  41.  *   If successful, a pair Tcl fileids are returned for -buf or a single fileid
  42.  * is returned for -nobuf.
  43.  *-----------------------------------------------------------------------------
  44.  */
  45. int
  46. Tcl_ServerOpenCmd (clientData, interp, argc, argv)
  47.     ClientData  clientData;
  48.     Tcl_Interp *interp;
  49.     int         argc;
  50.     char      **argv;
  51. {
  52.     char               *host, *service;
  53.     int                 socketFD = -1, socketFD2 = -1, nextArg, buffered;
  54.     struct sockaddr_in  server;
  55.     FILE               *filePtr;
  56.  
  57.     /*
  58.      * Parse arguments.
  59.      */
  60.     if ((argc < 3) || (argc > 4)) {
  61.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  62.                           " ?option? host service|port", (char *) NULL);
  63.         return TCL_ERROR;
  64.     }
  65.  
  66.     if (argc == 4) {
  67.         if (STREQU ("-buf", argv [1])) {
  68.             buffered = TRUE;
  69.         } else if (STREQU ("-nobuf", argv [1])) {
  70.             buffered = FALSE;
  71.         } else {
  72.             Tcl_AppendResult (interp, "expected one of \"-buf\" or \"-nobuf\"",
  73.                               ", got \"", argv [1], "\"", (char *) NULL);
  74.             return TCL_ERROR;
  75.         }
  76.         nextArg = 2;
  77.     } else {
  78.         buffered = TRUE;
  79.         nextArg = 1;
  80.     }
  81.  
  82.     host = argv [nextArg];
  83.     service = argv [nextArg + 1];
  84.  
  85.     /*
  86.      * Convert service number or lookup the service name.
  87.      */
  88.     bzero (&server, sizeof (server));
  89.     server.sin_family = AF_INET;
  90.  
  91.     if (ISDIGIT (*service)) {
  92.         int  port;
  93.         
  94.         if (Tcl_GetInt (interp, service, &port) != TCL_OK)
  95.             return TCL_ERROR;
  96.         server.sin_port = htons (port);
  97.     } else {
  98.         struct servent *servEntry;
  99.  
  100.         servEntry = getservbyname (service, NULL);
  101.         if (servEntry == NULL) {
  102.             Tcl_AppendResult (interp, "unknown service: ", service,
  103.                               (char *) NULL);
  104.             return TCL_ERROR;
  105.         }
  106.         server.sin_port = servEntry->s_port;
  107.     }
  108.  
  109.     /*
  110.      * Convert IP address or lookup host name.
  111.      */
  112.     if (ISDIGIT (*host)) {
  113.         server.sin_addr.s_addr = inet_addr (host);
  114.     } else {
  115.         struct hostent *hostEntry;
  116.  
  117.         hostEntry = gethostbyname (host);
  118.         if (hostEntry == NULL) {
  119.             char  *errorMsg;
  120.  
  121.             switch (h_errno) {
  122.               case HOST_NOT_FOUND:
  123.                 errorMsg = "host not found";
  124.                 break;
  125.               case TRY_AGAIN:
  126.                 errorMsg = "try again";
  127.                 break;
  128.               case NO_RECOVERY:
  129.                 errorMsg = "unrecordable server error";
  130.                 break;
  131.               case NO_DATA:
  132.                 errorMsg = "no data";
  133.                 break;
  134.             }
  135.             Tcl_AppendResult (interp, "host name lookup failure: ",
  136.                               host, " (", errorMsg, ")",
  137.                               (char *) NULL);
  138.             return TCL_ERROR;
  139.         }
  140.         bcopy (hostEntry->h_addr, &server.sin_addr, hostEntry->h_length);
  141.     }
  142.  
  143.     /*
  144.      * Open a socket and connect to the server.
  145.      */
  146.     socketFD = socket (AF_INET, SOCK_STREAM, 0);
  147.     if (socketFD < 0)
  148.         goto unixError;
  149.  
  150.     if (connect (socketFD, &server, sizeof (server)) < 0)
  151.         goto unixError;
  152.  
  153.     /*
  154.      * Set up stdio FILE structures.  If buffered, a pair (read/write) is 
  155.      * returned.  If not buffered, a single one is returned.
  156.      */
  157.     if (!buffered) {
  158.         filePtr = Tcl_SetupFileEntry (interp, socketFD,
  159.                                       TCL_FILE_READABLE | TCL_FILE_WRITABLE);
  160.         if (filePtr == NULL)
  161.             goto errorExit;
  162.  
  163.         setbuf (filePtr, NULL);
  164.         sprintf (interp->result, "file%d", socketFD);
  165.         return TCL_OK;
  166.     }
  167.  
  168.     if (Tcl_SetupFileEntry (interp, socketFD, TCL_FILE_READABLE) == NULL)
  169.         goto errorExit;
  170.  
  171.     socketFD2 = dup (socketFD);
  172.     if (socketFD2 < 0)
  173.         goto unixError;
  174.  
  175.     if (Tcl_SetupFileEntry (interp, socketFD2, TCL_FILE_WRITABLE) == NULL)
  176.         goto errorExit;
  177.  
  178.     sprintf (interp->result, "file%d file%d", socketFD, socketFD2);
  179.     return TCL_OK;
  180.  
  181.     /*
  182.      * Exit points for errors.
  183.      */
  184.   unixError:
  185.     interp->result = Tcl_PosixError (interp);
  186.  
  187.   errorExit:
  188.     if (socketFD >= 0)
  189.         Tcl_CloseForError (interp, socketFD);
  190.     if (socketFD2 >= 0)
  191.         Tcl_CloseForError (interp, socketFD2);
  192.     return TCL_ERROR;
  193. }
  194. #else
  195.  
  196. /*
  197.  *-----------------------------------------------------------------------------
  198.  *
  199.  * Tcl_ServerOpen --
  200.  *     Version of this command that return an error on systems that don't have
  201.  * sockets.
  202.  *-----------------------------------------------------------------------------
  203.  */
  204. int
  205. Tcl_ServerOpenCmd (clientData, interp, argc, argv)
  206.     ClientData  clientData;
  207.     Tcl_Interp *interp;
  208.     int         argc;
  209.     char      **argv;
  210. {
  211.     Tcl_AppendResult (interp, argv [2], " not available on this system",
  212.                       (char *) NULL);
  213.     return TCL_ERROR;
  214. }
  215.  
  216. #endif /* TCL_NO_SOCKETS */
  217.