shared_source/c_tcl_base_7_5_w_mods/tcliosock.c

/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tcliosock.c,v 1.1.1.1 2001/06/13 04:42:17 dtashley Exp $ */

/* 
 * tclIOSock.c --
 *
 *      Common routines used by all socket based channel types.
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 *
 * RCS: @(#) $Id: tcliosock.c,v 1.1.1.1 2001/06/13 04:42:17 dtashley Exp $
 */

#include "tclInt.h"
#include "tclPort.h"

/*
 *---------------------------------------------------------------------------
 *
 * TclSockGetPort --
 *
 *      Maps from a string, which could be a service name, to a port.
 *      Used by socket creation code to get port numbers and resolve
 *      registered service names to port numbers.
 *
 * Results:
 *      A standard Tcl result.  On success, the port number is returned
 *      in portPtr. On failure, an error message is left in the interp's
 *      result.
 *
 * Side effects:
 *      None.
 *
 *---------------------------------------------------------------------------
 */

int
TclSockGetPort(interp, string, proto, portPtr)
    Tcl_Interp *interp;
    char *string;               /* Integer or service name */
    char *proto;                /* "tcp" or "udp", typically */
    int *portPtr;               /* Return port number */
{
    struct servent *sp;         /* Protocol info for named services */
    Tcl_DString ds;
    char *native;

    if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
        /*
         * Don't bother translating 'proto' to native.
         */
         
        native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
        sp = getservbyname(native, proto);              /* INTL: Native. */
        Tcl_DStringFree(&ds);
        if (sp != NULL) {
            *portPtr = ntohs((unsigned short) sp->s_port);
            return TCL_OK;
        }
    }
    if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
        return TCL_ERROR;
    }
    if (*portPtr > 0xFFFF) {
        Tcl_AppendResult(interp, "couldn't open socket: port number too high",
                (char *) NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclSockMinimumBuffers --
 *
 *      Ensure minimum buffer sizes (non zero).
 *
 * Results:
 *      A standard Tcl result.
 *
 * Side effects:
 *      Sets SO_SNDBUF and SO_RCVBUF sizes.
 *
 *----------------------------------------------------------------------
 */

int
TclSockMinimumBuffers(sock, size)
    int sock;                   /* Socket file descriptor */
    int size;                   /* Minimum buffer size */
{
    int current;
    /*
     * Should be socklen_t, but HP10.20 (g)cc chokes
     */
    size_t len;

    len = sizeof(int);
    getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
    if (current < size) {
        len = sizeof(int);
        setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
    }
    len = sizeof(int);
    getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
    if (current < size) {
        len = sizeof(int);
        setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
    }
    return TCL_OK;
}


/* $History: tcliosock.c $
 * 
 * *****************  Version 1  *****************
 * User: Dtashley     Date: 1/02/01    Time: 1:33a
 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
 * Initial check-in.
 */ 

/* End of TCLIOSOCK.C */
1	/* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tcliosock.c,v 1.1.1.1 2001/06/13 04:42:17 dtashley Exp $ */
2
3	/*
4	* tclIOSock.c --
5	*
6	* Common routines used by all socket based channel types.
7	*
8	* Copyright (c) 1995-1997 Sun Microsystems, Inc.
9	*
10	* See the file "license.terms" for information on usage and redistribution
11	* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12	*
13	* RCS: @(#) $Id: tcliosock.c,v 1.1.1.1 2001/06/13 04:42:17 dtashley Exp $
14	*/
15
16	#include "tclInt.h"
17	#include "tclPort.h"
18
19	/*
20	*---------------------------------------------------------------------------
21	*
22	* TclSockGetPort --
23	*
24	* Maps from a string, which could be a service name, to a port.
25	* Used by socket creation code to get port numbers and resolve
26	* registered service names to port numbers.
27	*
28	* Results:
29	* A standard Tcl result. On success, the port number is returned
30	* in portPtr. On failure, an error message is left in the interp's
31	* result.
32	*
33	* Side effects:
34	* None.
35	*
36	*---------------------------------------------------------------------------
37	*/
38
39	int
40	TclSockGetPort(interp, string, proto, portPtr)
41	Tcl_Interp *interp;
42	char string; / Integer or service name */
43	char proto; / "tcp" or "udp", typically */
44	int portPtr; / Return port number */
45	{
46	struct servent sp; / Protocol info for named services */
47	Tcl_DString ds;
48	char *native;
49
50	if (Tcl_GetInt(NULL, string, portPtr) != TCL_OK) {
51	/*
52	* Don't bother translating 'proto' to native.
53	*/
54
55	native = Tcl_UtfToExternalDString(NULL, string, -1, &ds);
56	sp = getservbyname(native, proto); /* INTL: Native. */
57	Tcl_DStringFree(&ds);
58	if (sp != NULL) {
59	*portPtr = ntohs((unsigned short) sp->s_port);
60	return TCL_OK;
61	}
62	}
63	if (Tcl_GetInt(interp, string, portPtr) != TCL_OK) {
64	return TCL_ERROR;
65	}
66	if (*portPtr > 0xFFFF) {
67	Tcl_AppendResult(interp, "couldn't open socket: port number too high",
68	(char *) NULL);
69	return TCL_ERROR;
70	}
71	return TCL_OK;
72	}
73
74	/*
75	*----------------------------------------------------------------------
76	*
77	* TclSockMinimumBuffers --
78	*
79	* Ensure minimum buffer sizes (non zero).
80	*
81	* Results:
82	* A standard Tcl result.
83	*
84	* Side effects:
85	* Sets SO_SNDBUF and SO_RCVBUF sizes.
86	*
87	*----------------------------------------------------------------------
88	*/
89
90	int
91	TclSockMinimumBuffers(sock, size)
92	int sock; /* Socket file descriptor */
93	int size; /* Minimum buffer size */
94	{
95	int current;
96	/*
97	* Should be socklen_t, but HP10.20 (g)cc chokes
98	*/
99	size_t len;
100
101	len = sizeof(int);
102	getsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
103	if (current < size) {
104	len = sizeof(int);
105	setsockopt(sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
106	}
107	len = sizeof(int);
108	getsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
109	if (current < size) {
110	len = sizeof(int);
111	setsockopt(sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
112	}
113	return TCL_OK;
114	}
115
116
117	/* $History: tcliosock.c $
118	*
119	* *************** Version 1 ***************
120	* User: Dtashley Date: 1/02/01 Time: 1:33a
121	* Created in $/IjuScripter, IjuConsole/Source/Tcl Base
122	* Initial check-in.
123	*/
124
125	/* End of TCLIOSOCK.C */