home *** CD-ROM | disk | FTP | other *** search
/ Serving the Web / ServingTheWeb1995.disc1of1.iso / linux / slacksrce / tcl / tcl+tk+t / tclx7.3bl / tclx7 / tclX7.3b / src / tclXserver.c < prev    next >
Encoding:
C/C++ Source or Header  |  1994-07-16  |  11.2 KB  |  406 lines
  1. /*
  2.  * tclXserver.c --
  3.  *
  4.  * High level commands for connecting to TCP/IP based servers.
  5.  *---------------------------------------------------------------------------
  6.  * Copyright 1991-1994 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 INADDR_NONE
  29. #    define INADDR_NONE  ((long) -1)
  30. #endif
  31.  
  32. #ifndef HAVE_BCOPY
  33. #    define bcopy(from, to, length)    memmove((to), (from), (length))
  34. #endif
  35. #ifndef HAVE_BZERO
  36. #    define bzero(to, length)          memset((to), '\0', (length))
  37. #endif
  38.  
  39. extern int h_errno;
  40.  
  41. /*
  42.  * Prototypes of internal functions.
  43.  */
  44. static int
  45. ReturnGetHostError _ANSI_ARGS_((Tcl_Interp *interp,
  46.                                 char       *host));
  47.  
  48. static struct hostent *
  49. InfoGetHostByName _ANSI_ARGS_((Tcl_Interp *interp,
  50.                                int         argc,
  51.                                char      **argv));
  52.  
  53. /*
  54.  *-----------------------------------------------------------------------------
  55.  *
  56.  * ReturnGetHostError --
  57.  *
  58.  *   Return an error message when gethostbyname or gethostbyaddr fails.
  59.  *
  60.  * Parameters:
  61.  *   o interp (O) - The error message is returned in the result.
  62.  *   o host (I) - Host name or address that got the error.
  63.  * Globals:
  64.  *   o h_errno (I) - The list of file handles to parse, may be empty.
  65.  * Returns:
  66.  *   Always returns TCL_ERROR.
  67.  *-----------------------------------------------------------------------------
  68.  */
  69. static int
  70. ReturnGetHostError (interp, host)
  71.     Tcl_Interp *interp;
  72.     char       *host;
  73. {
  74.     char  *errorMsg;
  75.  
  76.     switch (h_errno) {
  77.       case HOST_NOT_FOUND:
  78.         errorMsg = "host not found";
  79.         break;
  80.       case TRY_AGAIN:
  81.         errorMsg = "try again";
  82.         break;
  83.       case NO_RECOVERY:
  84.         errorMsg = "unrecordable server error";
  85.         break;
  86.       case NO_DATA:
  87.         errorMsg = "no data";
  88.         break;
  89.     }
  90.     Tcl_AppendResult (interp, "host lookup failure: ",
  91.                       host, " (", errorMsg, ")",
  92.                       (char *) NULL);
  93.     return TCL_ERROR;
  94. }
  95.  
  96. /*
  97.  *-----------------------------------------------------------------------------
  98.  *
  99.  * Tcl_ServerOpenCmd --
  100.  *     Implements the TCL server_open command:
  101.  *
  102.  *        server_open ?option? host service
  103.  *
  104.  *  Opens a stream socket to the specified host (host name or IP address),
  105.  *  service name or port number.  Options maybe -buf or -nobuf.
  106.  *
  107.  * Results:
  108.  *   If successful, a pair Tcl fileids are returned for -buf or a single fileid
  109.  * is returned for -nobuf.
  110.  *-----------------------------------------------------------------------------
  111.  */
  112. int
  113. Tcl_ServerOpenCmd (clientData, interp, argc, argv)
  114.     ClientData  clientData;
  115.     Tcl_Interp *interp;
  116.     int         argc;
  117.     char      **argv;
  118. {
  119.     char               *host, *service;
  120.     int                 socketFD = -1, socketFD2 = -1, nextArg, buffered;
  121.     struct hostent     *hostEntry;
  122.     struct sockaddr_in  server;
  123.     FILE               *filePtr;
  124.  
  125.     /*
  126.      * Parse arguments.
  127.      */
  128.     if ((argc < 3) || (argc > 4)) {
  129.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  130.                           " ?option? host service|port", (char *) NULL);
  131.         return TCL_ERROR;
  132.     }
  133.  
  134.     if (argc == 4) {
  135.         if (STREQU ("-buf", argv [1])) {
  136.             buffered = TRUE;
  137.         } else if (STREQU ("-nobuf", argv [1])) {
  138.             buffered = FALSE;
  139.         } else {
  140.             Tcl_AppendResult (interp, "expected one of \"-buf\" or \"-nobuf\"",
  141.                               ", got \"", argv [1], "\"", (char *) NULL);
  142.             return TCL_ERROR;
  143.         }
  144.         nextArg = 2;
  145.     } else {
  146.         buffered = TRUE;
  147.         nextArg = 1;
  148.     }
  149.  
  150.     host = argv [nextArg];
  151.     service = argv [nextArg + 1];
  152.  
  153.     /*
  154.      * Convert service number or lookup the service name.
  155.      */
  156.     bzero (&server, sizeof (server));
  157.  
  158.     if (ISDIGIT (service [0])) {
  159.         int  port;
  160.         
  161.         if (Tcl_GetInt (interp, service, &port) != TCL_OK)
  162.             return TCL_ERROR;
  163.         server.sin_port = htons (port);
  164.     } else {
  165.         struct servent *servEntry;
  166.  
  167.         servEntry = getservbyname (service, NULL);
  168.         if (servEntry == NULL) {
  169.             Tcl_AppendResult (interp, "unknown service: ", service,
  170.                               (char *) NULL);
  171.             return TCL_ERROR;
  172.         }
  173.         server.sin_port = servEntry->s_port;
  174.     }
  175.  
  176.     /*
  177.      * Convert IP address or lookup host name.
  178.      */
  179.     server.sin_addr.s_addr = inet_addr (host);
  180.     if (server.sin_addr.s_addr != INADDR_NONE) {
  181.         server.sin_family = AF_INET;
  182.         hostEntry = NULL;
  183.     } else {
  184.         hostEntry = gethostbyname (host);
  185.         if (hostEntry == NULL)
  186.             return ReturnGetHostError (interp, host);
  187.  
  188.         server.sin_family = hostEntry->h_addrtype;
  189.         bcopy (hostEntry->h_addr_list [0], &server.sin_addr,
  190.                hostEntry->h_length);
  191.         hostEntry->h_addr_list++;
  192.     }
  193.  
  194.     /*
  195.      * Open a socket and connect to the server.  If the connect fails and
  196.      * other addresses are available, try them.
  197.      */
  198.     socketFD = socket (server.sin_family, SOCK_STREAM, 0);
  199.     if (socketFD < 0)
  200.         goto unixError;
  201.  
  202.     while (TRUE) {
  203.         if (connect (socketFD, (struct sockaddr *) &server,
  204.                      sizeof (server)) >= 0)
  205.             break;  /* Got it */
  206.  
  207.         if ((hostEntry == NULL) || (hostEntry->h_addr_list [0] == NULL))
  208.             goto unixError;
  209.  
  210.         /*
  211.          * Try next address.
  212.          */
  213.         bcopy (hostEntry->h_addr_list [0], &server.sin_addr,
  214.                hostEntry->h_length);
  215.         hostEntry->h_addr_list++;
  216.     }
  217.  
  218.     /*
  219.      * Set up stdio FILE structures.  If buffered, a pair (read/write) is 
  220.      * returned.  If not buffered, a single one is returned.
  221.      */
  222.     if (!buffered) {
  223.         filePtr = Tcl_SetupFileEntry (interp, socketFD,
  224.                                       TCL_FILE_READABLE | TCL_FILE_WRITABLE);
  225.         if (filePtr == NULL)
  226.             goto errorExit;
  227.  
  228.         setbuf (filePtr, NULL);
  229.         sprintf (interp->result, "file%d", socketFD);
  230.         return TCL_OK;
  231.     }
  232.  
  233.     if (Tcl_SetupFileEntry (interp, socketFD, TCL_FILE_READABLE) == NULL)
  234.         goto errorExit;
  235.  
  236.     socketFD2 = dup (socketFD);
  237.     if (socketFD2 < 0)
  238.         goto unixError;
  239.  
  240.     if (Tcl_SetupFileEntry (interp, socketFD2, TCL_FILE_WRITABLE) == NULL)
  241.         goto errorExit;
  242.  
  243.     sprintf (interp->result, "file%d file%d", socketFD, socketFD2);
  244.     return TCL_OK;
  245.  
  246.     /*
  247.      * Exit points for errors.
  248.      */
  249.   unixError:
  250.     interp->result = Tcl_PosixError (interp);
  251.  
  252.   errorExit:
  253.     if (socketFD >= 0)
  254.         Tcl_CloseForError (interp, socketFD);
  255.     if (socketFD2 >= 0)
  256.         Tcl_CloseForError (interp, socketFD2);
  257.     return TCL_ERROR;
  258. }
  259.  
  260. /*
  261.  *-----------------------------------------------------------------------------
  262.  *
  263.  * InfoGetHostByName --
  264.  *
  265.  *   Validate arguments and call gethostbyname for the server_info options
  266.  * that return info about a host name.
  267.  *
  268.  * Parameters:
  269.  *   o interp (O) - The error message is returned in the result.
  270.  *   o argc, argv (I) - Command argments.
  271.  * Returns:
  272.  *   Pointer to the host entry or NULL if an error occured.
  273.  *-----------------------------------------------------------------------------
  274.  */
  275. static struct hostent *
  276. InfoGetHostByName (interp, argc, argv)
  277.     Tcl_Interp *interp;
  278.     int         argc;
  279.     char      **argv;
  280. {
  281.     struct hostent *hostEntry;
  282.  
  283.     if (argc != 3) {
  284.         Tcl_AppendResult (interp, tclXWrongArgs, argv [0], " ", argv [1],
  285.                           " hostname", (char *) NULL);
  286.         return NULL;
  287.     }
  288.  
  289.     hostEntry = gethostbyname (argv [2]);
  290.     if (hostEntry == NULL) {
  291.         ReturnGetHostError (interp, argv [2]);
  292.         return NULL;
  293.     }
  294.     return hostEntry;
  295. }
  296.  
  297. /*
  298.  *-----------------------------------------------------------------------------
  299.  *
  300.  * Tcl_ServerInfoCmd --
  301.  *     Implements the TCL server_info command:
  302.  *
  303.  *        server_info addresses hostname
  304.  *        server_info addresses hostname
  305.  *
  306.  * Results:
  307.  *   For hostname, a list of address associated with the host.
  308.  *-----------------------------------------------------------------------------
  309.  */
  310. int
  311. Tcl_ServerInfoCmd (clientData, interp, argc, argv)
  312.     ClientData  clientData;
  313.     Tcl_Interp *interp;
  314.     int         argc;
  315.     char      **argv;
  316. {
  317.     struct hostent *hostEntry;
  318.     struct in_addr  inAddr;
  319.     int             idx;
  320.  
  321.     if (argc < 2) {
  322.         Tcl_AppendResult (interp, tclXWrongArgs, argv[0],
  323.                           " option ...", (char *) NULL);
  324.         return TCL_ERROR;
  325.     }
  326.  
  327.     if (STREQU (argv [1], "addresses")) {
  328.         hostEntry = InfoGetHostByName (interp, argc, argv);
  329.         if (hostEntry == NULL)
  330.             return TCL_ERROR;
  331.  
  332.         for (idx = 0; hostEntry->h_addr_list [idx] != NULL; idx++) {
  333.             bcopy (hostEntry->h_addr_list [idx], &inAddr,
  334.                    hostEntry->h_length);
  335.             Tcl_AppendElement (interp, inet_ntoa (inAddr));
  336.         }
  337.         return TCL_OK;
  338.     }
  339.  
  340.     if (STREQU (argv [1], "official_name")) {
  341.         hostEntry = InfoGetHostByName (interp, argc, argv);
  342.         if (hostEntry == NULL)
  343.             return TCL_ERROR;
  344.  
  345.         Tcl_SetResult (interp, hostEntry->h_name, TCL_STATIC);
  346.         return TCL_OK;
  347.     }
  348.  
  349.     if (STREQU (argv [1], "aliases")) {
  350.         hostEntry = InfoGetHostByName (interp, argc, argv);
  351.         if (hostEntry == NULL)
  352.             return TCL_ERROR;
  353.  
  354.         for (idx = 0; hostEntry->h_aliases [idx] != NULL; idx++) {
  355.             Tcl_AppendElement (interp, hostEntry->h_aliases [idx]);
  356.         }
  357.         return TCL_OK;
  358.     }
  359.  
  360.     Tcl_AppendResult (interp, "invalid option \"", argv [1],
  361.                       "\", expected on of \"addresses\", \"official_name\"",
  362.                       " or \"aliases\"", (char *) NULL);
  363.     return TCL_ERROR;
  364. }
  365. #else
  366.  
  367. /*
  368.  *-----------------------------------------------------------------------------
  369.  *
  370.  * Tcl_ServerOpenCmd --
  371.  *     Version of this command that return an error on systems that don't have
  372.  * sockets.
  373.  *-----------------------------------------------------------------------------
  374.  */
  375. int
  376. Tcl_ServerOpenCmd (clientData, interp, argc, argv)
  377.     ClientData  clientData;
  378.     Tcl_Interp *interp;
  379.     int         argc;
  380.     char      **argv;
  381. {
  382.     Tcl_AppendResult (interp, argv [0], " not available on this system",
  383.                       (char *) NULL);
  384.     return TCL_ERROR;
  385. }
  386.  
  387. /*
  388.  *-----------------------------------------------------------------------------
  389.  *
  390.  * Tcl_ServerInfoCmd --
  391.  *     Version of this command that return an error on systems that don't have
  392.  * sockets.
  393.  *-----------------------------------------------------------------------------
  394.  */
  395. int
  396. Tcl_ServerInfoCmd (clientData, interp, argc, argv)
  397.     ClientData  clientData;
  398.     Tcl_Interp *interp;
  399.     int         argc;
  400.     char      **argv;
  401. {
  402.     return Tcl_ServerOpenCmd (clientData, interp, argc, argv);
  403. }
  404.  
  405. #endif /* HAVE_GETHOSTBYNAME */
  406.