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