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	dashley	25	/* $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 */