/* 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);
}

  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);
  }