Tcl UDP

Check-in [c5dc314f6a]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Applied patch 1848365 to accept any boolean value for the -mcastloop option (plus tests).
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c5dc314f6a7d72a927539787154505d10cdec8dc
User & Date: patthoyts 2008-07-05 20:41:44
Context
2008-07-06
11:59
Applied patch #1838459 to properly handle appending to a shared list object in -mcastadd. Added tests. check-in: 9c80e94c12 user: patthoyts tags: trunk
2008-07-05
20:41
Applied patch 1848365 to accept any boolean value for the -mcastloop option (plus tests). check-in: c5dc314f6a user: patthoyts tags: trunk
2007-04-11
00:06
Updated manual page. check-in: fb1cd1f6ab user: patthoyts tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.






1
2
3
4
5
6
7




2007-04-10  Pat Thoyts  <[email protected]>

	* generic/udp_tcl.c: Applied patch 1693037 from Uwe Klein to
	enable setting the SO_REUSEADDR socket option when creating a new
	udp socket.
	Improved error reporting on Windows.

>
>
>
>
>







1
2
3
4
5
6
7
8
9
10
11
12
2008-07-05  Pat Thoyts  <[email protected]>

	* generic/udp_tcl.c: Applied patch 1848365 to accept any boolean
	value for the -mcastloop option (plus tests).

2007-04-10  Pat Thoyts  <[email protected]>

	* generic/udp_tcl.c: Applied patch 1693037 from Uwe Klein to
	enable setting the SO_REUSEADDR socket option when creating a new
	udp socket.
	Improved error reporting on Windows.

Changes to generic/udp_tcl.c.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
....
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
....
1471
1472
1473
1474
1475
1476
1477

1478
1479
1480
1481
1482
1483
1484
 *
 * Copyright (c) 1999-2000 by Columbia University; all rights reserved
 * Copyright (c) 2003-2005 Pat Thoyts <[email protected]>
 *
 * Written by Xiaotao Wu
 * Last modified: 11/03/2000
 *
 * $Id: udp_tcl.c,v 1.40 2007/04/10 23:49:38 patthoyts Exp $
 ******************************************************************************/

#if defined(_DEBUG) && !defined(DEBUG)
#define DEBUG
#endif

#include "udp_tcl.h"
................................................................................
            } else {
                Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
            }
        }
    } else if (!strcmp("-mcastloop", optionName)) {

        int tmp = 1;
        r = Tcl_GetInt(interp, newValue, &tmp);
        if (r == TCL_OK) {
	    unsigned char ctmp = (unsigned char)tmp;
            if (setsockopt(statePtr->sock, IPPROTO_IP, IP_MULTICAST_LOOP,
                           (const char *)&ctmp, sizeof(unsigned char))) {
                Tcl_SetObjResult(interp, ErrorToObj("error setting -mcastloop"));
                r = TCL_ERROR;
            } else {
................................................................................
static Tcl_Obj *
ErrorToObj(const char * prefix)
{
    Tcl_Obj *errObj;
#ifdef WIN32
    LPVOID sMsg;
    DWORD len = 0;

    len = FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER
                         | FORMAT_MESSAGE_FROM_SYSTEM
                         | FORMAT_MESSAGE_IGNORE_INSERTS,
                         NULL, GetLastError(),
                         MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
                         (LPWSTR)&sMsg, 0, NULL);
    errObj = Tcl_NewStringObj(prefix, -1);






|







 







|







 







>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
....
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
....
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
 *
 * Copyright (c) 1999-2000 by Columbia University; all rights reserved
 * Copyright (c) 2003-2005 Pat Thoyts <[email protected]>
 *
 * Written by Xiaotao Wu
 * Last modified: 11/03/2000
 *
 * $Id: udp_tcl.c,v 1.41 2008/07/05 20:41:44 patthoyts Exp $
 ******************************************************************************/

#if defined(_DEBUG) && !defined(DEBUG)
#define DEBUG
#endif

#include "udp_tcl.h"
................................................................................
            } else {
                Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
            }
        }
    } else if (!strcmp("-mcastloop", optionName)) {

        int tmp = 1;
        r = Tcl_GetBoolean(interp, newValue, &tmp);
        if (r == TCL_OK) {
	    unsigned char ctmp = (unsigned char)tmp;
            if (setsockopt(statePtr->sock, IPPROTO_IP, IP_MULTICAST_LOOP,
                           (const char *)&ctmp, sizeof(unsigned char))) {
                Tcl_SetObjResult(interp, ErrorToObj("error setting -mcastloop"));
                r = TCL_ERROR;
            } else {
................................................................................
static Tcl_Obj *
ErrorToObj(const char * prefix)
{
    Tcl_Obj *errObj;
#ifdef WIN32
    LPVOID sMsg;
    DWORD len = 0;

    len = FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER
                         | FORMAT_MESSAGE_FROM_SYSTEM
                         | FORMAT_MESSAGE_IGNORE_INSERTS,
                         NULL, GetLastError(),
                         MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
                         (LPWSTR)&sMsg, 0, NULL);
    errObj = Tcl_NewStringObj(prefix, -1);

Changes to tests/udp-srv.test.

4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
} err]} {
    puts "skipping [file tail [info script]]: these tests require tcltest 2.0"
    return
}

package require udp

# Some tests are marked as slow as they can take 30s to test a volume of packets.
# We generally just test for correctness and these do not significantly contribute
# in testing correctness.
::tcltest::testConstraint slow 1

# Enable printing timing information during some tests.
::tcltest::testConstraint timestamp 1

set scriptName [makeFile {} udptest2.tcl]
set script {
    # UDP Test Server






|
|
|
|







4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
} err]} {
    puts "skipping [file tail [info script]]: these tests require tcltest 2.0"
    return
}

package require udp

# Some tests are marked as slow as they can take 30s to test a volume
# of packets.  We generally just test for correctness and these do not
# significantly contribute in testing correctness.
::tcltest::testConstraint slow 0

# Enable printing timing information during some tests.
::tcltest::testConstraint timestamp 1

set scriptName [makeFile {} udptest2.tcl]
set script {
    # UDP Test Server

Changes to tests/udp.test.

5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
90
91
92
93
94
95
96


















97
98
99
100
101
102
103
104
105
106
107
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 by Pat Thoyts <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: udp.test,v 1.4 2003/03/12 00:21:17 patthoyts Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

package require udp
................................................................................
        set s [udp_open $port]
        set check [udp_conf $s -myport]
        close $s
        format 0x%04x $check
    } msg] $msg
} {0 0x007b}




















# -------------------------------------------------------------------------
# cleanup
catch {unset _udp}
::tcltest::cleanupTests
return

# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End:






|







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>











5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
..
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
# generates output for errors.  No output means no errors were found.
#
# Copyright (c) 2003 by Pat Thoyts <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: udp.test,v 1.5 2008/07/05 20:41:44 patthoyts Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import ::tcltest::*
}

package require udp
................................................................................
        set s [udp_open $port]
        set check [udp_conf $s -myport]
        close $s
        format 0x%04x $check
    } msg] $msg
} {0 0x007b}

test udp-3.8 {multicastloop can be set to true} \
    -body {
	set s [udp_open]
	fconfigure $s -mcastloop "true"
	fconfigure $s -mcastloop
    } -result {1} -cleanup {
	close $s
    }

test udp-3.9 {multicastloop can be set to false} \
    -body {
	set s [udp_open]
	fconfigure $s -mcastloop "true"
	fconfigure $s -mcastloop "no"
	fconfigure $s -mcastloop
    } -result {0} -cleanup {
	close $s
    }

# -------------------------------------------------------------------------
# cleanup
catch {unset _udp}
::tcltest::cleanupTests
return

# Local variables:
# mode: tcl
# indent-tabs-mode: nil
# End: