1/*
2 * tclUnixSock.c --
3 *
4 *	This file contains Unix-specific socket related code.
5 *
6 * Copyright (c) 1995 Sun Microsystems, Inc.
7 *
8 * See the file "license.terms" for information on usage and redistribution of
9 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
10 *
11 * RCS: @(#) $Id: tclUnixSock.c,v 1.20 2007/12/13 15:28:42 dgp Exp $
12 */
13
14#include "tclInt.h"
15
16/*
17 * The following variable holds the network name of this host.
18 */
19
20static TclInitProcessGlobalValueProc InitializeHostName;
21static ProcessGlobalValue hostName =
22	{0, 0, NULL, NULL, InitializeHostName, NULL, NULL};
23
24
25/*
26 *----------------------------------------------------------------------
27 *
28 * InitializeHostName --
29 *
30 * 	This routine sets the process global value of the name of the local
31 * 	host on which the process is running.
32 *
33 * Results:
34 *	None.
35 *
36 *----------------------------------------------------------------------
37 */
38
39static void
40InitializeHostName(
41    char **valuePtr,
42    int *lengthPtr,
43    Tcl_Encoding *encodingPtr)
44{
45    CONST char *native = NULL;
46
47#ifndef NO_UNAME
48    struct utsname u;
49    struct hostent *hp;
50
51    memset(&u, (int) 0, sizeof(struct utsname));
52    if (uname(&u) > -1) {				/* INTL: Native. */
53        hp = TclpGetHostByName(u.nodename);		/* INTL: Native. */
54	if (hp == NULL) {
55	    /*
56	     * Sometimes the nodename is fully qualified, but gets truncated
57	     * as it exceeds SYS_NMLN. See if we can just get the immediate
58	     * nodename and get a proper answer that way.
59	     */
60
61	    char *dot = strchr(u.nodename, '.');
62
63	    if (dot != NULL) {
64		char *node = ckalloc((unsigned) (dot - u.nodename + 1));
65
66		memcpy(node, u.nodename, (size_t) (dot - u.nodename));
67		node[dot - u.nodename] = '\0';
68		hp = TclpGetHostByName(node);
69		ckfree(node);
70	    }
71	}
72        if (hp != NULL) {
73	    native = hp->h_name;
74        } else {
75	    native = u.nodename;
76        }
77    }
78    if (native == NULL) {
79	native = tclEmptyStringRep;
80    }
81#else
82    /*
83     * Uname doesn't exist; try gethostname instead.
84     *
85     * There is no portable macro for the maximum length of host names
86     * returned by gethostbyname(). We should only trust SYS_NMLN if it is at
87     * least 255 + 1 bytes to comply with DNS host name limits.
88     *
89     * Note: SYS_NMLN is a restriction on "uname" not on gethostbyname!
90     *
91     * For example HP-UX 10.20 has SYS_NMLN == 9, while gethostbyname() can
92     * return a fully qualified name from DNS of up to 255 bytes.
93     *
94     * Fix suggested by Viktor Dukhovni (viktor@esm.com)
95     */
96
97#    if defined(SYS_NMLN) && SYS_NMLEN >= 256
98    char buffer[SYS_NMLEN];
99#    else
100    char buffer[256];
101#    endif
102
103    if (gethostname(buffer, sizeof(buffer)) > -1) {	/* INTL: Native. */
104	native = buffer;
105    }
106#endif
107
108    *encodingPtr = Tcl_GetEncoding(NULL, NULL);
109    *lengthPtr = strlen(native);
110    *valuePtr = ckalloc((unsigned int) (*lengthPtr)+1);
111    memcpy(*valuePtr, (void *) native, (size_t)(*lengthPtr)+1);
112}
113
114/*
115 *----------------------------------------------------------------------
116 *
117 * Tcl_GetHostName --
118 *
119 *	Returns the name of the local host.
120 *
121 * Results:
122 *	A string containing the network name for this machine, or an empty
123 *	string if we can't figure out the name. The caller must not modify or
124 *	free this string.
125 *
126 * Side effects:
127 *	Caches the name to return for future calls.
128 *
129 *----------------------------------------------------------------------
130 */
131
132CONST char *
133Tcl_GetHostName(void)
134{
135    return Tcl_GetString(TclGetProcessGlobalValue(&hostName));
136}
137
138/*
139 *----------------------------------------------------------------------
140 *
141 * TclpHasSockets --
142 *
143 *	Detect if sockets are available on this platform.
144 *
145 * Results:
146 *	Returns TCL_OK.
147 *
148 * Side effects:
149 *	None.
150 *
151 *----------------------------------------------------------------------
152 */
153
154int
155TclpHasSockets(
156    Tcl_Interp *interp)		/* Not used. */
157{
158    return TCL_OK;
159}
160
161/*
162 *----------------------------------------------------------------------
163 *
164 * TclpFinalizeSockets --
165 *
166 *	Performs per-thread socket subsystem finalization.
167 *
168 * Results:
169 *	None.
170 *
171 * Side effects:
172 *	None.
173 *
174 *----------------------------------------------------------------------
175 */
176
177void
178TclpFinalizeSockets(void)
179{
180    return;
181}
182
183/*
184 * Local Variables:
185 * mode: c
186 * c-basic-offset: 4
187 * fill-column: 78
188 * End:
189 */
190