/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tcliosock.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tcliosock.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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