gethostbyname as Windows DLL

Richard Suchenwirth 2005-11-30 - As colleagues wanted the Windows gethostbyname() function exposed as a Tcl command, I hacked up the following code, starting from Building Tcl DLL's for Windows and some pasted samples from MSDN. Building it is a single call to the VisualC compiler cl as documented in a comment. Code review welcome! (I'm not sure about tclstubs84.lib - had to explicitly specify tcl84.lib to make the build succeed...)

/* gethost.c -- DLL to expose the gethostbyname() function 
  as Tcl command [gethost $name]
  Returns a list of IP numbers ({} if not found)
  
  build with (adjust paths as needed):
  cl gethost.c /Id:/usr/local/include /LD
      /link /NODEFAULTLIB:MSVCRT d:/usr/local/lib/tclstub84.lib ws2_32.lib   
  
  test with (e.g.):
  echo "load gethost.dll;puts [gethost siemens.de]" | tclsh   
*/
#include <Winsock2.h>
#include <tcl.h>

#ifndef DECLSPEC_EXPORT
#define DECLSPEC_EXPORT __declspec(dllexport)
#endif /* DECLSPEC_EXPORT */

BOOL APIENTRY DllMain(HANDLE hModule, DWORD dwReason, LPVOID lpReserved) {
  return TRUE;
}
/*--------------------------------------------------------------------------*/
static int gethostCmd(ClientData clientdata, Tcl_Interp *interp,
               int objc, Tcl_Obj *CONST objv[]) {
 const char* host_name;
 unsigned int addr;
 char FAR FAR *cp;
 int i;
 int wsaError;
 char* errorText = "none";
 WORD    wVersionRequested;
 WSADATA wsaData;
 int err;
 char s[18];
 
 struct hostent* remoteHost = NULL;
 Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
 
 if(objc != 2) {
   Tcl_WrongNumArgs(interp, 2, objv, "");
   return TCL_ERROR;
 }
 wVersionRequested = MAKEWORD( 2, 2 );
 err = WSAStartup( wVersionRequested, &wsaData );
 if ( err != 0 ) {
   Tcl_SetStringObj(resultPtr, "found no usable WinSock DLL", -1);
   return TCL_ERROR;
 }
 if ( LOBYTE( wsaData.wVersion ) != 2 ||
      HIBYTE( wsaData.wVersion ) != 2 ) {
   Tcl_SetStringObj(resultPtr, "found no usable 2.2 WinSock DLL", -1);
   WSACleanup();
   return TCL_ERROR; 
 }
 host_name = Tcl_GetStringFromObj(objv[1], NULL);
 
 if (isalpha(host_name[0])) {   /* host address is a name */
   remoteHost = gethostbyname(host_name);
 } else { 
   Tcl_SetStringObj(resultPtr, "must be alpha host name", -1);
   return TCL_ERROR;
 }
 wsaError = WSAGetLastError();
 if(wsaError == WSAHOST_NOT_FOUND || wsaError == WSANO_DATA) {
   return TCL_OK;
 }
 if(wsaError != 0 || remoteHost == NULL) {
   switch (wsaError) {
   case WSANOTINITIALISED: errorText = "Not initialized"; break; 
   case WSAENETDOWN:       errorText = "Error: Net down"; break; 
   case WSATRY_AGAIN:      errorText = "Try again"; break; 
   case WSANO_RECOVERY:    errorText = "no recovery"; break; 
   case WSAEINPROGRESS:    errorText = "Error: in progress"; break; 
   case WSAEFAULT:         errorText = "Error: invalid name"; break; 
   case WSAEINTR:          errorText = "blocking call interrupted"; break;
   default:                errorText = "unknown failure"; break;
   }
   Tcl_SetStringObj(resultPtr, errorText, -1);
   return TCL_ERROR;
 }
 if(NULL != (cp=remoteHost->h_addr_list[0])) {
   sprintf(s,"%d.%d.%d.%d", cp[0]&255, cp[1]&255, cp[2]&255, cp[3]&255);
   Tcl_AppendElement(interp, s);
 }
 return TCL_OK;
}
/* ------------------------------------------------------------------------*/
EXTERN_C int DECLSPEC_EXPORT Gethost_Init(Tcl_Interp* interp) {
 int r;
#ifdef USE_TCL_STUBS
 Tcl_InitStubs(interp, "8.3", 0);
#endif
  Tcl_Obj *version = Tcl_SetVar2Ex(interp, "gethost_version", NULL,
                            Tcl_NewDoubleObj(0.1), TCL_LEAVE_ERR_MSG);
 if (version == NULL)
   return TCL_ERROR;
 r = Tcl_PkgProvide(interp, "gethost", Tcl_GetString(version));
 
 Tcl_CreateObjCommand(interp, "gethost", (Tcl_ObjCmdProc *)gethostCmd,
                (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);  
 return r;
}

EXTERN_C int DECLSPEC_EXPORT Gethost_SafeInit(Tcl_Interp* interp) {
  /* We don't need to be specially safe so... */
  return Gethost_Init(interp);
}

Build and test log:

 SuchRich@KSTBWP74[/Tcl]535:cl gethost.c /Id:/usr/local/include /LD /link d:/usr/local/lib/tcl84.lib ws2_32.lib
 Microsoft (R) 32-bit C/C++ Optimizing Compiler Version 12.00.8804 for 80x86
 Copyright (C) Microsoft Corp 1984-1998. All rights reserved.

 gethost.c
 Microsoft (R) Incremental Linker Version 6.00.8447
 Copyright (C) Microsoft Corp 1992-1998. All rights reserved.

 /out:gethost.dll
 /dll
 /implib:gethost.lib
 d:/usr/local/lib/tcl84.lib
 ws2_32.lib
 gethost.obj
   Creating library gethost.lib and object gethost.exp
 SuchRich@KSTBWP74[/Tcl]536:echo 'load gethost.dll;foreach i {siemens.de google.com nix tcl.tk} {puts "$i -> [gethost $i]"}' | tclsh
 siemens.de -> 192.138.228.1
 google.com -> 72.14.207.99 64.233.187.99
 nix ->
 tcl.tk -> 209.17.179.230

gethostbyname will block your GUI (See The DNS blocking problem), unless you do something like this: bgexec resolver.exe

The source for resolver.exe (from browsex (brx)):

  int main(int argc, char *argv[]) {
    char buf[1024];
    struct hostent *he;
  #ifdef __WIN32__
  #define WSA_VERSION_REQD MAKEWORD(1,1)
    WSADATA wsaData;
    WSAStartup(WSA_VERSION_REQD, &wsaData);
  #endif
    if (argc>1) {
      he = gethostbyname(argv[1]);
      buf[0]=0;
      if (he) {
        int i; unsigned char* cp;
        cp=he->h_addr;
        printf("%d.%d.%d.%d\n", cp[0],cp[1],cp[2],cp[3]);
      }
    }
    exit(0);
  }

--Ro, having run into a lot of problems before, 2005-11-30 - RS: I tested the timing: the worst case seems to be a non-existing name, which takes about 2.3 sec to return. Bad enough, but I've seen other Windows GUI hang for longer time... and my requirement was to wrap gethostbyname() into a Tcl command, which is what I did :)


PT 2005-Nov-30: To avoid the blocking issues I have a non-blocking equivalent that runs the name query on a secondary thread so it can keep events running. See http://www.patthoyts.tk/tclresolver/ Also note that getaddrinfo is the modern API.

APN 2006-Jun-22: TWAPI V0.9 can do non-blocking name resolution using the hostname_to_address and address_to_hostname -async options. Underlying Win32 API is getnameinfo and getaddrinfo.


RS 2006-02-02: fixed build instruction, removed loop over remote hosts (crashed sometimes; now does only the first, which should suffice and is more robust).


Arts and crafts of Tcl-Tk programming