1/* 2 * tclXsocket.c -- 3 * 4 * Socket utility functions and commands. 5 *--------------------------------------------------------------------------- 6 * Copyright 1991-1999 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 10x * 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 * $Id: tclXsocket.c,v 1.2 2004/05/24 23:11:52 hobbs Exp $ 16 *----------------------------------------------------------------------------- 17 */ 18 19#include "tclExtdInt.h" 20 21/* 22 * Prototypes of internal functions. 23 */ 24static int 25ReturnGetHostError _ANSI_ARGS_((Tcl_Interp *interp, 26 char *host)); 27 28static struct hostent * 29InfoGetHost _ANSI_ARGS_((Tcl_Interp *interp, 30 int objc, 31 Tcl_Obj *CONST objv[])); 32 33static int 34TclX_HostInfoObjCmd _ANSI_ARGS_((ClientData clientData, 35 Tcl_Interp *interp, 36 int objc, 37 Tcl_Obj *CONST objv[])); 38 39 40/*----------------------------------------------------------------------------- 41 * ReturnGetHostError -- 42 * 43 * Return an error message when gethostbyname or gethostbyaddr fails. 44 * 45 * Parameters: 46 * o interp (O) - The error message is returned in the result. 47 * o host (I) - Host name or address that got the error. 48 * Globals: 49 * o h_errno (I) - The list of file handles to parse, may be empty. 50 * Returns: 51 * Always returns TCL_ERROR. 52 *----------------------------------------------------------------------------- 53 */ 54static int 55ReturnGetHostError (interp, host) 56 Tcl_Interp *interp; 57 char *host; 58{ 59 char *errorMsg; 60 char *errorCode; 61 62 switch (h_errno) { 63 case HOST_NOT_FOUND: 64 errorCode = "HOST_NOT_FOUND"; 65 errorMsg = "host not found"; 66 break; 67 case TRY_AGAIN: 68 errorCode = "TRY_AGAIN"; 69 errorMsg = "try again"; 70 break; 71 case NO_RECOVERY: 72 errorCode = "NO_RECOVERY"; 73 errorMsg = "unrecordable server error"; 74 break; 75#ifdef NO_DATA 76 case NO_DATA: 77 errorCode = "NO_DATA"; 78 errorMsg = "no data"; 79 break; 80#endif 81 default: 82 errorCode = "UNKNOWN_ERROR"; 83 errorMsg = "unknown error"; 84 } 85 Tcl_SetErrorCode (interp, "INET", errorCode, errorMsg, (char *)NULL); 86 TclX_AppendObjResult (interp, "host lookup failure: ", 87 host, " (", errorMsg, ")", 88 (char *) NULL); 89 return TCL_ERROR; 90} 91 92/*----------------------------------------------------------------------------- 93 * TclXGetHostInfo -- 94 * Return a host address, name (if it can be obtained) and port number. 95 * Used by the fstat command. 96 * 97 * Parameters: 98 * o interp (O) - Error messages are returned in the result. 99 * o channel (I) - Channel associated with the socket. 100 * o remoteHost (I) - TRUE to get remote host information, FALSE to get 101 * local host info. 102 * Returns: 103 * An object with the list of information, or NULL if an error occured. 104 *----------------------------------------------------------------------------- 105 */ 106Tcl_Obj * 107TclXGetHostInfo (interp, channel, remoteHost) 108 Tcl_Interp *interp; 109 Tcl_Channel channel; 110 int remoteHost; 111{ 112 struct sockaddr_in sockaddr; 113 struct hostent *hostEntry; 114 CONST char *hostName; 115 Tcl_Obj *listObjv [3]; 116 117 if (remoteHost) { 118 if (TclXOSgetpeername (interp, channel, 119 &sockaddr, sizeof (sockaddr)) != TCL_OK) 120 return NULL; 121 } else { 122 if (TclXOSgetsockname (interp, channel, &sockaddr, 123 sizeof (sockaddr)) != TCL_OK) 124 return NULL; 125 } 126 127 hostEntry = gethostbyaddr ((char *) &(sockaddr.sin_addr), 128 sizeof (sockaddr.sin_addr), 129 AF_INET); 130 if (hostEntry != NULL) 131 hostName = hostEntry->h_name; 132 else 133 hostName = ""; 134 135 listObjv [0] = Tcl_NewStringObj (inet_ntoa (sockaddr.sin_addr), -1); 136 listObjv [1] = Tcl_NewStringObj ((char *) hostName, -1); 137 listObjv [2] = Tcl_NewIntObj (ntohs (sockaddr.sin_port)); 138 139 return Tcl_NewListObj (3, listObjv); 140} 141 142/*----------------------------------------------------------------------------- 143 * InfoGetHost -- 144 * 145 * Validate arguments and call gethostbyaddr for the host_info options 146 * that return info about a host. This looks up host information either by 147 * name or address. 148 * 149 * Parameters: 150 * o interp (O) - The error message is returned in the result. 151 * o objc, objv (I) - Command argments as Tcl objects. Host name or IP 152 * address is expected in objv [2]. 153 * Returns: 154 * Pointer to the host entry or NULL if an error occured. 155 *----------------------------------------------------------------------------- 156 */ 157static struct hostent * 158InfoGetHost (interp, objc, objv) 159 Tcl_Interp *interp; 160 int objc; 161 Tcl_Obj *CONST objv[]; 162{ 163 struct hostent *hostEntry; 164 struct in_addr address; 165 166 char *command = Tcl_GetStringFromObj (objv [0], NULL); 167 char *subCommand = Tcl_GetStringFromObj (objv [1], NULL); 168 char *host; 169 170 if (objc != 3) { 171 TclX_AppendObjResult (interp, tclXWrongArgs, command, " ", 172 subCommand, " host", (char *) NULL); 173 return NULL; 174 } 175 host = Tcl_GetStringFromObj(objv [2], NULL); 176 177 if (TclXOSInetAtoN (NULL, host, &address) == TCL_OK) { 178 hostEntry = gethostbyaddr((char *) &address, sizeof(address), AF_INET); 179 } else { 180 hostEntry = gethostbyname(host); 181 } 182 if (hostEntry == NULL) { 183 ReturnGetHostError (interp, host); 184 return NULL; 185 } 186 return hostEntry; 187} 188 189/*----------------------------------------------------------------------------- 190 * TclX_HostInfoObjCmd -- 191 * Implements the TCL host_info command: 192 * 193 * host_info addresses host 194 * host_info official_name host 195 * host_info aliases host 196 * 197 * Results: 198 * For hostname, a list of address associated with the host. 199 *----------------------------------------------------------------------------- 200 */ 201static int 202TclX_HostInfoObjCmd (clientData, interp, objc, objv) 203 ClientData clientData; 204 Tcl_Interp *interp; 205 int objc; 206 Tcl_Obj *CONST objv[]; 207{ 208 struct hostent *hostEntry; 209 struct in_addr inAddr; 210 int idx; 211 char *subCommand; 212 Tcl_Obj *listObj; 213 Tcl_Obj *resultPtr; 214 215 if (objc < 2) 216 return TclX_WrongArgs (interp, objv [0], "option ..."); 217 218 resultPtr = Tcl_GetObjResult (interp); 219 subCommand = Tcl_GetStringFromObj (objv [1], NULL); 220 221 if (STREQU (subCommand, "addresses")) { 222 hostEntry = InfoGetHost (interp, objc, objv); 223 if (hostEntry == NULL) 224 return TCL_ERROR; 225 226 for (idx = 0; hostEntry->h_addr_list [idx] != NULL; idx++) { 227 bcopy ((VOID *) hostEntry->h_addr_list [idx], 228 (VOID *) &inAddr, 229 hostEntry->h_length); 230 231 listObj = Tcl_NewStringObj (inet_ntoa (inAddr), -1); 232 Tcl_ListObjAppendElement (interp, resultPtr, listObj); 233 } 234 return TCL_OK; 235 } 236 237 if (STREQU (subCommand, "address_name")) { 238 hostEntry = InfoGetHost (interp, objc, objv); 239 if (hostEntry == NULL) 240 return TCL_ERROR; 241 242 for (idx = 0; hostEntry->h_addr_list [idx] != NULL; idx++) { 243 bcopy ((VOID *) hostEntry->h_addr_list [idx], 244 (VOID *) &inAddr, 245 hostEntry->h_length); 246 listObj = Tcl_NewStringObj ((char *) hostEntry->h_name, -1); 247 Tcl_ListObjAppendElement (interp, resultPtr, listObj); 248 } 249 return TCL_OK; 250 } 251 252 if (STREQU (subCommand, "official_name")) { 253 hostEntry = InfoGetHost (interp, objc, objv); 254 if (hostEntry == NULL) 255 return TCL_ERROR; 256 257 Tcl_SetStringObj (resultPtr, (char *) hostEntry->h_name, -1); 258 return TCL_OK; 259 } 260 261 if (STREQU (subCommand, "aliases")) { 262 hostEntry = InfoGetHost (interp, objc, objv); 263 if (hostEntry == NULL) 264 return TCL_ERROR; 265 266 for (idx = 0; hostEntry->h_aliases [idx] != NULL; idx++) { 267 listObj = Tcl_NewStringObj (hostEntry->h_aliases [idx], -1); 268 Tcl_ListObjAppendElement (interp, resultPtr, listObj); 269 } 270 return TCL_OK; 271 } 272 273 TclX_AppendObjResult (interp, "invalid option \"", subCommand, 274 "\", expected one of \"addresses\", ", 275 "\"official_name\", or \"aliases\"", (char *) NULL); 276 return TCL_ERROR; 277} 278 279 280/*----------------------------------------------------------------------------- 281 * TclX_SocketInit -- 282 * Initialize the host_info command. 283 *----------------------------------------------------------------------------- 284 */ 285void 286TclX_SocketInit (interp) 287 Tcl_Interp *interp; 288{ 289 Tcl_CreateObjCommand (interp, 290 "host_info", 291 TclX_HostInfoObjCmd, 292 (ClientData) NULL, 293 (Tcl_CmdDeleteProc*) NULL); 294 295} 296 297