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