Tcl UDP

Check-in [7f3b9d24cd]
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:Use winsock2 so that mingw-gcc can get the correct values for multicast.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 7f3b9d24cde922794c8a23577c305b5b81767581
User & Date: patthoyts 2007-04-10 23:36:14
Context
2007-04-10
23:49
Fixed dozy error on unix branch check-in: c0eb8e4d18 user: patthoyts tags: trunk
23:36
Use winsock2 so that mingw-gcc can get the correct values for multicast. check-in: 7f3b9d24cd user: patthoyts tags: trunk
12:25
* 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. check-in: 1a3e75af20 user: patthoyts tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to demos/chat.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
..
29
30
31
32
33
34
35

36
37
38
39
40
41
42
43
44
45

46
47
48
49
50
51
52
53
54
55
56

57
58
59
60



61
62

63
64
65





66
67
68
# chat.tcl - Copyright (C) 2004 Pat Thoyts <[email protected]>
#
# This is a sample application from TclUDP.
#
# This illustrates the use of multicast UDP messages to implement a primitive chat
# application.
#
# $Id: chat.tcl,v 1.1 2004/11/23 13:39:29 patthoyts Exp $

package require Tk  8.4
package require udp 1.0.6

variable Address  224.5.1.21
variable Port     7771

................................................................................
}

proc CreateGui {socket} {
    text .t -yscrollcommand {.s set}
    scrollbar .s -command {.t yview}
    frame .f -border 0
    entry .f.e -textvariable ::_msg

    button .f.ok -text Send -underline 0 -command "SendMessage $socket \$::_msg"
    button .f.ex -text Exit -underline 1 -command {destroy .}
    pack .f.ex .f.ok -side right
    pack .f.e -side left -expand 1 -fill x
    grid .t .s -sticky news
    grid .f -  -sticky ew
    grid columnconfigure . 0 -weight 1
    grid rowconfigure . 0 -weight 1
    bind .f.e <Return> {.f.ok invoke}
    .t tag configure CLNT -foreground red

}

proc SendMessage {sock msg} {
    puts -nonewline $sock $msg
}

proc AddMessage {client msg} {
    set msg [string map [list "\r\n" "" "\r" "" "\n" ""] $msg]
    set client [lindex $client 0]
    if {[string length $msg] > 0} {
        .t insert end "$client " CLNT "$msg\n" MSG

    }
}

if {!$tcl_interactive} {



    set sock [Start $Address $Port]    
    CreateGui $sock

    after idle [list SendMessage $sock "$::tcl_platform(user)@[info hostname] connected"]
    tkwait window .
    close $sock





    exit 0
}




|
|

|







 







>
|









>










|
>



|
>
>
>


>
|


>
>
>
>
>



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
..
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
# chat.tcl - Copyright (C) 2004 Pat Thoyts <[email protected]>
#
# This is a sample application from TclUDP.
#
# This illustrates the use of multicast UDP messages to implement a
# primitive chat application.
#
# $Id: chat.tcl,v 1.2 2007/04/10 23:36:14 patthoyts Exp $

package require Tk  8.4
package require udp 1.0.6

variable Address  224.5.1.21
variable Port     7771

................................................................................
}

proc CreateGui {socket} {
    text .t -yscrollcommand {.s set}
    scrollbar .s -command {.t yview}
    frame .f -border 0
    entry .f.e -textvariable ::_msg
    button .f.ok -text Send -underline 0 \
        -command "SendMessage $socket \$::_msg"
    button .f.ex -text Exit -underline 1 -command {destroy .}
    pack .f.ex .f.ok -side right
    pack .f.e -side left -expand 1 -fill x
    grid .t .s -sticky news
    grid .f -  -sticky ew
    grid columnconfigure . 0 -weight 1
    grid rowconfigure . 0 -weight 1
    bind .f.e <Return> {.f.ok invoke}
    .t tag configure CLNT -foreground red
    .t configure -tabs {90}
}

proc SendMessage {sock msg} {
    puts -nonewline $sock $msg
}

proc AddMessage {client msg} {
    set msg [string map [list "\r\n" "" "\r" "" "\n" ""] $msg]
    set client [lindex $client 0]
    if {[string length $msg] > 0} {
        .t insert end "$client\t" CLNT "$msg\n" MSG
        .t see end
    }
}

proc Main {} {
    variable Address
    variable Port
    variable sock
    set sock [Start $Address $Port]    
    CreateGui $sock
    after idle [list SendMessage $sock \
                    "$::tcl_platform(user)@[info hostname] connected"]
    tkwait window .
    close $sock
}

if {!$tcl_interactive} {
    set r [catch [linsert $argv 0 Main] err]
    if {$r} {puts $::errorInfo} else {puts $err}
    exit 0
}

Changes to generic/udp_tcl.c.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
....
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
 *
 * 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.38 2007/04/10 12:25:57 patthoyts Exp $
 ******************************************************************************/

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

#include "udp_tcl.h"
................................................................................
            WaitForSingleObject(waitForSock, INFINITE);
            /* synchronized */
            WaitForSingleObject(sockListLock, INFINITE);
        }
        
        /* set each socket for select */
        for (statePtr = sockList; statePtr != NULL; statePtr=statePtr->next) {
            FD_SET(statePtr->sock, &readfds);
            UDPTRACE("SET sock %d\n", statePtr->sock);
        }
        
        SetEvent(sockListLock);
        UDPTRACE("Wait for select\n");
        /* block here */
        found = select(0, &readfds, NULL, NULL, &timeout);
................................................................................
        }
        memcpy(&mreq.imr_multiaddr.s_addr, name->h_addr,
               sizeof(mreq.imr_multiaddr));
    }
    mreq.imr_interface.s_addr = INADDR_ANY;
    if (setsockopt(statePtr->sock, IPPROTO_IP, action,
                   (const char*)&mreq, sizeof(mreq)) < 0) {
       Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group"));
        return TCL_ERROR;
    }

    if (action == IP_ADD_MEMBERSHIP) {
	int ndx = LSearch(statePtr->groupsObj, grp);
	if (ndx == -1) {
	    statePtr->multicast++;






|







 







|







 







|







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
...
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
....
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
 *
 * 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.39 2007/04/10 23:36:14 patthoyts Exp $
 ******************************************************************************/

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

#include "udp_tcl.h"
................................................................................
            WaitForSingleObject(waitForSock, INFINITE);
            /* synchronized */
            WaitForSingleObject(sockListLock, INFINITE);
        }
        
        /* set each socket for select */
        for (statePtr = sockList; statePtr != NULL; statePtr=statePtr->next) {
            FD_SET((unsigned int)statePtr->sock, &readfds);
            UDPTRACE("SET sock %d\n", statePtr->sock);
        }
        
        SetEvent(sockListLock);
        UDPTRACE("Wait for select\n");
        /* block here */
        found = select(0, &readfds, NULL, NULL, &timeout);
................................................................................
        }
        memcpy(&mreq.imr_multiaddr.s_addr, name->h_addr,
               sizeof(mreq.imr_multiaddr));
    }
    mreq.imr_interface.s_addr = INADDR_ANY;
    if (setsockopt(statePtr->sock, IPPROTO_IP, action,
                   (const char*)&mreq, sizeof(mreq)) < 0) {
        Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group"));
        return TCL_ERROR;
    }

    if (action == IP_ADD_MEMBERSHIP) {
	int ndx = LSearch(statePtr->groupsObj, grp);
	if (ndx == -1) {
	    statePtr->multicast++;

Changes to generic/udp_tcl.h.

3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
23
24
25
26
27
28
29
30

31
32
33
34
35
36
37
 * UDP Extension for Tcl 8.4
 *
 * Copyright (c) 1999-2003 by Columbia University; all rights reserved
 * Copyright (c) 2003-2005 Pat Thoyts <[email protected]>
 *
 * Written by Xiaotao Wu
 * 
 * $Id: udp_tcl.h,v 1.10 2006/03/05 10:43:12 patthoyts Exp $
 *----------------------------------------------------------------------
 */

#ifndef UDP_TCL_H
#define UDP_TCL_H

#ifdef HAVE_CONFIG_H
................................................................................
#endif

#if defined(_WIN32) && !defined(WIN32)
#define WIN32
#endif

#ifdef WIN32
#  include <winsock.h>

#else
#  if HAVE_UNISTD_H
#    include <unistd.h>
#  endif
#  if HAVE_SYS_TIME_H
#    include <sys/time.h>
#  endif






|







 







|
>







3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
..
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 * UDP Extension for Tcl 8.4
 *
 * Copyright (c) 1999-2003 by Columbia University; all rights reserved
 * Copyright (c) 2003-2005 Pat Thoyts <[email protected]>
 *
 * Written by Xiaotao Wu
 * 
 * $Id: udp_tcl.h,v 1.11 2007/04/10 23:36:14 patthoyts Exp $
 *----------------------------------------------------------------------
 */

#ifndef UDP_TCL_H
#define UDP_TCL_H

#ifdef HAVE_CONFIG_H
................................................................................
#endif

#if defined(_WIN32) && !defined(WIN32)
#define WIN32
#endif

#ifdef WIN32
#  include <winsock2.h>
#  include <ws2tcpip.h>
#else
#  if HAVE_UNISTD_H
#    include <unistd.h>
#  endif
#  if HAVE_SYS_TIME_H
#    include <sys/time.h>
#  endif

Changes to win/makefile.vc.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
...
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001 ActiveState Corporation.
# Copyright (c) 2001-2002 David Gravereaux.
# Copyright (c) 2003 Pat Thoyts
#
#-------------------------------------------------------------------------
# RCS: @(#)$Id: makefile.vc,v 1.6 2007/04/10 12:25:57 patthoyts Exp $
#-------------------------------------------------------------------------

!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCToolkitInstallDir)
MSG = ^
You will need to run vcvars32.bat from Developer Studio, first, to setup^
the environment.  Jump to this line to read the new instructions.
!error $(MSG)
................................................................................
!if $(LOIMPACT)
lflags	= $(lflags) -ws:aggressive
!endif

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
baselibs   = $(TCLSTUBLIB) wsock32.lib

#---------------------------------------------------------------------
# TclTest flags
#---------------------------------------------------------------------

!IF "$(TESTPAT)" != ""
TESTFLAGS = -file $(TESTPAT)






|







 







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
...
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-2000 Ajuba Solutions.
# Copyright (c) 2001 ActiveState Corporation.
# Copyright (c) 2001-2002 David Gravereaux.
# Copyright (c) 2003 Pat Thoyts
#
#-------------------------------------------------------------------------
# RCS: @(#)$Id: makefile.vc,v 1.7 2007/04/10 23:36:14 patthoyts Exp $
#-------------------------------------------------------------------------

!if !defined(MSDEVDIR) && !defined(MSVCDIR) && !defined(VCToolkitInstallDir)
MSG = ^
You will need to run vcvars32.bat from Developer Studio, first, to setup^
the environment.  Jump to this line to read the new instructions.
!error $(MSG)
................................................................................
!if $(LOIMPACT)
lflags	= $(lflags) -ws:aggressive
!endif

dlllflags = $(lflags) -dll
conlflags = $(lflags) -subsystem:console
guilflags = $(lflags) -subsystem:windows
baselibs   = $(TCLSTUBLIB) ws2_32.lib

#---------------------------------------------------------------------
# TclTest flags
#---------------------------------------------------------------------

!IF "$(TESTPAT)" != ""
TESTFLAGS = -file $(TESTPAT)