/* 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.230gethostbyname will block your GUI (See The DNS blocking problem), unless you do something like this: bgexec resolver.exeThe 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
