Tcl UDP

about how to build the extension under Windows. We suggest using
the Msys + Mingw build process since it is significantly easier
than building with VC++ or Cygwin.

This package includes a Visual Studio project file to help in building
with VC++.

The package has been built using both VC++6 and Msys + Mingw.








FEEDBACK
========

If you have any problem with this extension, please contact Xiaotao Wu

Name  : Xiaotao Wu
Email : [email protected], [email protected]
URL   : http://www.cs.columbia.edu/~xiaotaow
Phone : (212)939-7020, (212)939-7133,  Fax: (801)751-0217
SIP   : sip:[email protected]

about how to build the extension under Windows. We suggest using
the Msys + Mingw build process since it is significantly easier
than building with VC++ or Cygwin.

This package includes a Visual Studio project file to help in building
with VC++.

The package has been built using both VC++6 and Msys + Mingw. 

Microsoft Platform SDK 2003 is required for building. The following minimal
example will install the extension in the C:\Tcl\lib directory.

	$ cd tcludp/win
	$ nmake -f makefile.vc realclean all 
	$ nmake -f makefile.vc install INSTALLDIR=C:\Tcl\lib

FEEDBACK
========

If you have any problem with this extension, please contact Xiaotao Wu

Name  : Xiaotao Wu
Email : [email protected], [email protected]
URL   : http://www.cs.columbia.edu/~xiaotaow
Phone : (212)939-7020, (212)939-7133,  Fax: (801)751-0217
SIP   : sip:[email protected]

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.59 for udp 1.0.9.
#
# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##
................................................................................
# This variable seems obsolete.  It should probably be removed, and
# only ac_max_sed_lines should be used.
: ${ac_max_here_lines=38}

# Identity of this package.
PACKAGE_NAME='udp'
PACKAGE_TARNAME='udp'
PACKAGE_VERSION='1.0.9'
PACKAGE_STRING='udp 1.0.9'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#if HAVE_SYS_TYPES_H
# include <sys/types.h>
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures udp 1.0.9 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of udp 1.0.9:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-threads        build with threads
................................................................................
    cd $ac_popdir
  done
fi

test -n "$ac_init_help" && exit 0
if $ac_init_version; then
  cat <<\_ACEOF
udp configure 1.0.9
generated by GNU Autoconf 2.59

Copyright (C) 2003 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit 0
fi
exec 5>config.log
cat >&5 <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by udp $as_me 1.0.9, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ $0 [email protected]

_ACEOF
{
cat <<_ASUNAME
................................................................................
# file during the install process.  Don't run the TCLSH_PROG through
# ${CYGPATH} because it's being used directly by make.
# Require that we use a tclsh shell version 8.2 or later since earlier
# versions have bugs in the pkg_mkIndex routine.
# Add WISH as well if this is a Tk extension.
#--------------------------------------------------------------------


    echo "$as_me:$LINENO: checking for tclsh" >&5
echo $ECHO_N "checking for tclsh... $ECHO_C" >&6
    if test -f "${TCL_BIN_DIR}/Makefile" ; then
        # tclConfig.sh is in Tcl build directory
        if test "${TEA_PLATFORM}" = "windows"; then
            TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}"
        else
            TCLSH_PROG="${TCL_BIN_DIR}/tclsh"
        fi
    else
        # tclConfig.sh is in install location
        if test "${TEA_PLATFORM}" = "windows"; then
            TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}"
        else
            TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_DBGX}"
        fi
        list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \
              `ls -d ${TCL_BIN_DIR}/..     2>/dev/null` \
................................................................................
        for i in $list ; do
            if test -f "$i/${TCLSH_PROG}" ; then
                REAL_TCL_BIN_DIR="`cd "$i"; pwd`"
                break
            fi
        done
        TCLSH_PROG="${REAL_TCL_BIN_DIR}/${TCLSH_PROG}"




    fi
    echo "$as_me:$LINENO: result: ${TCLSH_PROG}" >&5
echo "${ECHO_T}${TCLSH_PROG}" >&6



# -------------------------------------------------------------------
................................................................................
  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
} >&5
cat >&5 <<_CSEOF

This file was extended by udp $as_me 1.0.9, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 [email protected]
................................................................................
$config_files

Report bugs to <[email protected]>."
_ACEOF

cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
udp config.status 1.0.9
configured by $0, generated by GNU Autoconf 2.59,
  with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=$srcdir

#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.59 for udp 1.0.10.
#
# Copyright (C) 2003 Free Software Foundation, Inc.
# This configure script is free software; the Free Software Foundation
# gives unlimited permission to copy, distribute and modify it.
## --------------------- ##
## M4sh Initialization.  ##
## --------------------- ##
................................................................................
# This variable seems obsolete.  It should probably be removed, and
# only ac_max_sed_lines should be used.
: ${ac_max_here_lines=38}

# Identity of this package.
PACKAGE_NAME='udp'
PACKAGE_TARNAME='udp'
PACKAGE_VERSION='1.0.10'
PACKAGE_STRING='udp 1.0.10'
PACKAGE_BUGREPORT=''

# Factoring default headers for most tests.
ac_includes_default="\
#include <stdio.h>
#if HAVE_SYS_TYPES_H
# include <sys/types.h>
................................................................................
#
# Report the --help message.
#
if test "$ac_init_help" = "long"; then
  # Omit some internal or obsolete options to make the list less imposing.
  # This message is too long to be a string in the A/UX 3.1 sh.
  cat <<_ACEOF
\`configure' configures udp 1.0.10 to adapt to many kinds of systems.

Usage: $0 [OPTION]... [VAR=VALUE]...

To assign environment variables (e.g., CC, CFLAGS...), specify them as
VAR=VALUE.  See below for descriptions of some of the useful variables.

Defaults for the options are specified in brackets.
................................................................................

  cat <<\_ACEOF
_ACEOF
fi

if test -n "$ac_init_help"; then
  case $ac_init_help in
     short | recursive ) echo "Configuration of udp 1.0.10:";;
   esac
  cat <<\_ACEOF

Optional Features:
  --disable-FEATURE       do not include FEATURE (same as --enable-FEATURE=no)
  --enable-FEATURE[=ARG]  include FEATURE [ARG=yes]
  --enable-threads        build with threads
................................................................................
    cd $ac_popdir
  done
fi

test -n "$ac_init_help" && exit 0
if $ac_init_version; then
  cat <<\_ACEOF
udp configure 1.0.10
generated by GNU Autoconf 2.59

Copyright (C) 2003 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
  exit 0
fi
exec 5>config.log
cat >&5 <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.

It was created by udp $as_me 1.0.10, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  $ $0 [email protected]

_ACEOF
{
cat <<_ASUNAME
................................................................................
# file during the install process.  Don't run the TCLSH_PROG through
# ${CYGPATH} because it's being used directly by make.
# Require that we use a tclsh shell version 8.2 or later since earlier
# versions have bugs in the pkg_mkIndex routine.
# Add WISH as well if this is a Tk extension.
#--------------------------------------------------------------------


    echo "$as_me:$LINENO: checking for tclsh" >&5
echo $ECHO_N "checking for tclsh... $ECHO_C" >&6
    if test -f "${TCL_BIN_DIR}/Makefile" ; then
        # tclConfig.sh is in Tcl build directory
        if test "${TEA_PLATFORM}" = "windows"; then
            TCLSH_PROG="${TCL_BIN_DIR}/tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}"
        else
            TCLSH_PROG="${TCL_BIN_DIR}/tclsh"
        fi
    else
         # tclConfig.sh is in install location
        if test "${TEA_PLATFORM}" = "windows"; then
            TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}${TCL_MINOR_VERSION}${TCL_DBGX}${EXEEXT}"
        else
            TCLSH_PROG="tclsh${TCL_MAJOR_VERSION}.${TCL_MINOR_VERSION}${TCL_DBGX}"
        fi
        list="`ls -d ${TCL_BIN_DIR}/../bin 2>/dev/null` \
              `ls -d ${TCL_BIN_DIR}/..     2>/dev/null` \
................................................................................
        for i in $list ; do
            if test -f "$i/${TCLSH_PROG}" ; then
                REAL_TCL_BIN_DIR="`cd "$i"; pwd`"
                break
            fi
        done
        TCLSH_PROG="${REAL_TCL_BIN_DIR}/${TCLSH_PROG}"
        
		if test "`uname -s`" = "Darwin"; then
        TCLSH_PROG="/usr/bin/tclsh"
		fi
    fi
    echo "$as_me:$LINENO: result: ${TCLSH_PROG}" >&5
echo "${ECHO_T}${TCLSH_PROG}" >&6



# -------------------------------------------------------------------
................................................................................
  echo
  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX
## Running $as_me. ##
_ASBOX
} >&5
cat >&5 <<_CSEOF

This file was extended by udp $as_me 1.0.10, which was
generated by GNU Autoconf 2.59.  Invocation command line was

  CONFIG_FILES    = $CONFIG_FILES
  CONFIG_HEADERS  = $CONFIG_HEADERS
  CONFIG_LINKS    = $CONFIG_LINKS
  CONFIG_COMMANDS = $CONFIG_COMMANDS
  $ $0 [email protected]
................................................................................
$config_files

Report bugs to <[email protected]>."
_ACEOF

cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
udp config.status 1.0.10
configured by $0, generated by GNU Autoconf 2.59,
  with options \\"`echo "$ac_configure_args" | sed 's/[\\""\`\$]/\\\\&/g'`\\"

Copyright (C) 2003 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
srcdir=$srcdir

[comment {-*- tcl -*- doctools manpage}]
[comment {To convert this to another documentation format use the mpexpand
          script from tcllib: dtplite -o udp.n nroff udp.man
                              dtplite -o udp.html html udp.man
}]
[manpage_begin udp n 1.0.9]
[copyright {1999-2000 Columbia University; all rights reserved}]
[moddesc {Tcl UDP extension}]
[titledesc {Create UDP sockets in Tcl}]
[require Tcl 8.2]
[require udp 1.0]
[description]

................................................................................
[cmd udp_conf] should be considered depreciated in favour of the standard
Tcl command [cmd fconfigure].

[section "COMMANDS"]

[list_begin definitions]

[call [cmd "udp_open"] [opt "[arg port]"] [opt "[arg keywordlist]"]]

[cmd udp_open] will open a UDP socket. If [arg port] is specified the UDP
socket will be opened on that port. Otherwise the system will choose a port
and the user can use the [cmd udp_conf] command to obtain the port number
if required.
[nl]
From version 1.0.9 a second argument may be provided. The only valid value is
'reuse' although others may be added in the future. The reuse keyword sets the
SO_REUSEADDR socket option and permits multiple sockets to be bound to the same

address/port combination.

[call [cmd "udp_conf"] [arg "sock"] [arg "host"] [arg "port"]]

[emph Deprecated] in favour of the standard Tcl [cmd fconfigure] command.
[nl]
[cmd udp_conf] in this configuration is used to specify the remote destination
for packets written to this [arg "sock"]. You must call this command before
writing data to the UDP socket.

[call [cmd "udp_conf"] [arg "sock"] [arg [opt -myport]] [arg [opt -remote]] [arg [opt -peer]] [arg [opt "-broadcast bool"]] [arg [opt "-ttl count"]]]



[emph Deprecated] in favour of the standard Tcl [cmd fconfigure] command.
[nl]
In addition to being used to configure the remote host, the [cmd "udp_conf"]
command is used to obtain information about the UDP socket. NOTE all these options
are now available using the standard Tcl [cmd fconfigure] command.

................................................................................
Returns the remote hostname and port number for the packet most recently
received by this socket.

[lst_item "[arg -broadcast\ [opt boolean]]"]
UDP packets can listen and send on the broadcast address. For some systems 
a flag must be set on the socket to use broadcast. 
With no argument this option will return the broadcast setting. With a 
boolean argument the setting can be modified.


[lst_item "[arg -ttl\ [opt count]]"]

The time-to-live is given as the number of router hops the packet may do. For
multicast packets this is important in specifying the distribution of the
packet. The system default for multicast is 1 which restricts the packet 
to the local subnet. To permit packets to pass routers, you must increase the
ttl. A value of 31 should keep it within a site, while 255 is global.

[lst_item "[arg -mcastadd] groupaddr"]

[lst_item "[arg -mcastdrop] groupaddr"]

[lst_item "[arg -mcastgroups]"]

[package tcludp] sockets can support IPv4 multicast operations. To receive
multicast packets the application has to notify the operating system that
it should join a particular multicast group. These are specified as addresses
in the range 224.0.0.0 to 239.255.255.255.






[nl]
To view the current set of multicast groups for a channel use [arg -mcastgroups]

[lst_item "[arg -mcastloop\ [opt boolean]]"]

With multicast udp the system can choose to receive packets that it has sent
or it can drop them. This is known as multicast loopback and can be controlled
................................................................................
using this option. By default the value is true and your application will receive
its own transmissions.

[list_end]

[call [cmd "udp_peek"] [arg "sock"] [opt [arg "buffersize"]]]

Examine a packet without removing it from the buffer.


This function is not available on windows.

[list_end]

[section EXAMPLES]
[para]
[example {
................................................................................
the socket. In addition, it provides more configuration ability.

[para]

Enhancements to support binary data and to setup the package for the Tcl
Extension Architecture by Pat Thoyts.




[see_also socket(n)]
[keywords udp socket networking]
[manpage_end]

[comment {-*- tcl -*- doctools manpage}]
[comment {To convert this to another documentation format use the mpexpand
          script from tcllib: dtplite -o udp.n nroff udp.man
                              dtplite -o udp.html html udp.man
}]
[manpage_begin udp n 1.0.10]
[copyright {1999-2000 Columbia University; all rights reserved}]
[moddesc {Tcl UDP extension}]
[titledesc {Create UDP sockets in Tcl}]
[require Tcl 8.2]
[require udp 1.0]
[description]

................................................................................
[cmd udp_conf] should be considered depreciated in favour of the standard
Tcl command [cmd fconfigure].

[section "COMMANDS"]

[list_begin definitions]

[call [cmd "udp_open"] [opt "[arg port]"] [opt "[arg reuse]"] [opt "[arg ipv6]"]]

[cmd udp_open] will open a UDP socket. If [arg port] is specified the UDP
socket will be opened on that port. Otherwise the system will choose a port
and the user can use the [cmd udp_conf] command to obtain the port number
if required.
[nl]
Additional argument may be provided. If [arg reuse] is specified the 

SO_REUSEADDR socket option is set which permits multiple sockets to 
be bound to the same address/port combination. By default a IPv4 socket is created. When [arg ipv6] is specified an IPv6
socket is created. 

[call [cmd "udp_conf"] [arg "sock"] [arg "host"] [arg "port"]]

[emph Deprecated] in favour of the standard Tcl [cmd fconfigure] command.
[nl]
[cmd udp_conf] in this configuration is used to specify the remote destination
for packets written to this [arg "sock"]. You must call this command before
writing data to the UDP socket.

[call [cmd "udp_conf"] [arg "sock"] [arg [opt -myport]] [arg [opt -remote]] [arg [opt -peer]] [arg [opt "-broadcast bool"]] \
	[arg [opt "-ttl count"]] [arg [opt "-mcastadd \"groupaddr [opt netwif]\""]] [arg [opt "-mcastdrop \"groupaddr [opt netwif]\""]]\
	[arg [opt -mcastgroups]] [arg [opt "-mcastloop bool"]]]

[emph Deprecated] in favour of the standard Tcl [cmd fconfigure] command.
[nl]
In addition to being used to configure the remote host, the [cmd "udp_conf"]
command is used to obtain information about the UDP socket. NOTE all these options
are now available using the standard Tcl [cmd fconfigure] command.

................................................................................
Returns the remote hostname and port number for the packet most recently
received by this socket.

[lst_item "[arg -broadcast\ [opt boolean]]"]
UDP packets can listen and send on the broadcast address. For some systems 
a flag must be set on the socket to use broadcast. 
With no argument this option will return the broadcast setting. With a 
boolean argument the setting can be modified. This option is not permitted when
using IPv6.

[lst_item "[arg -ttl\ [opt count]]"]

The time-to-live is given as the number of router hops the packet may do. For
multicast packets this is important in specifying the distribution of the
packet. The system default for multicast is 1 which restricts the packet 
to the local subnet. To permit packets to pass routers, you must increase the
ttl. A value of 31 should keep it within a site, while 255 is global.

[lst_item "[arg -mcastadd] groupaddr"]
[lst_item "[arg -mcastadd] \"groupaddr netwif\""]
[lst_item "[arg -mcastdrop] groupaddr"]
[lst_item "[arg -mcastdrop] \"groupaddr netwif\""]
[lst_item "[arg -mcastgroups]"]

[package tcludp] sockets can support IPv4 and IPv6 multicast operations. To receive
multicast packets the application has to notify the operating system that
it should join a particular multicast group. For IPv4 these are specified as addresses
in the range 224.0.0.0 to 239.255.255.255.
[nl]
When specifying only the [arg groupaddr] the system will determine the network interface to use. 
Specifying the [arg netwif] will join a multicast group on a specific network interface.
This is useful on a multihomed system with multiple network interfaces.
On windows you must specify the network interface index. For other platforms the network
interface (e.g. 'eth0') name can be specified. 
[nl]
To view the current set of multicast groups for a channel use [arg -mcastgroups]

[lst_item "[arg -mcastloop\ [opt boolean]]"]

With multicast udp the system can choose to receive packets that it has sent
or it can drop them. This is known as multicast loopback and can be controlled
................................................................................
using this option. By default the value is true and your application will receive
its own transmissions.

[list_end]

[call [cmd "udp_peek"] [arg "sock"] [opt [arg "buffersize"]]]

Examine a packet without removing it from the buffer. Option [arg buffersize] specifies the 
maximum buffer size. Value must be between 0 and 16.
[nl]
This function is not available on windows.

[list_end]

[section EXAMPLES]
[para]
[example {
................................................................................
the socket. In addition, it provides more configuration ability.

[para]

Enhancements to support binary data and to setup the package for the Tcl
Extension Architecture by Pat Thoyts.

[para]
Support for IPv6 and allowing a multicast join on a specific network interface is added by Huub Eikens.

[see_also socket(n)]
[keywords udp socket networking]
[manpage_end]

 *
 * 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.44 2008/07/06 12:39:09 patthoyts Exp $
 ******************************************************************************/

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

#include "udp_tcl.h"
................................................................................
 * but we need it and TEA causes this macro to be defined.
 */

struct ip_mreq {
    struct in_addr imr_multiaddr; /* IP multicast address of group */
    struct in_addr imr_interface; /* local IP address of interface */
};






#endif /* _XOPEN_SOURCE_EXTENDED */

/* define some Win32isms for Unix */
#ifndef WIN32
#define SOCKET int
#define INVALID_SOCKET -1
#define closesocket close
................................................................................
int udpOpen(ClientData , Tcl_Interp *, int , CONST84 char * []);
int udpConf(ClientData , Tcl_Interp *, int , CONST84 char * []);
int udpPeek(ClientData , Tcl_Interp *, int , CONST84 char * []);

/*
 * internal functions
 */
static int UdpMulticast(ClientData, Tcl_Interp *, const char *, int);
static int UdpSockGetPort(Tcl_Interp *interp, const char *s,
                          const char *proto, int *portPtr);
static void udpTrace(const char *format, ...);
static int  udpGetService(Tcl_Interp *interp, const char *service,
                          unsigned short *servicePort);
static Tcl_Obj *ErrorToObj(const char * prefix);












/*
 * Windows specific functions
 */
#ifdef WIN32

int  UdpEventProc(Tcl_Event *evPtr, int flags);
................................................................................

#endif /* ! WIN32 */

/*
 * This structure describes the channel type for accessing UDP.
 */
static Tcl_ChannelType Udp_ChannelType = {
#ifdef SIPC_IPV6
    "udp6",                /* Type name.                                    */
#else 
    "udp",                 /* Type name.                                    */
#endif 
    NULL,                  /* Set blocking/nonblocking behaviour. NULL'able */
    udpClose,              /* Close channel, clean instance data            */
    udpInput,              /* Handle read request                           */
    udpOutput,             /* Handle write request                          */
    NULL,                  /* Move location of access point.      NULL'able */
    udpSetOption,          /* Set options.                        NULL'able */
    udpGetOption,          /* Get options.                        NULL'able */
................................................................................
    Tcl_InitStubs(interp, "8.1", 0);
#endif

#ifdef WIN32
    if (Udp_WinHasSockets(interp) != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_CreateEventSource(UDP_SetupProc, UDP_CheckProc, NULL);
#endif

    Tcl_CreateCommand(interp, "udp_open", udpOpen , 
                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "udp_conf", udpConf , 
                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
................................................................................
/*
 * Probably we should provide an equivalent to the C API for TCP.
 *
 * Tcl_Channel Tcl_OpenUdpClient(interp, port, host, myaddr, myport, async);
 * Tcl_Channel Tcl_OpenUdpServer(interp, port, myaddr, proc, clientData);
 * Tcl_Channel Tcl_MakeUdpClientChannel(sock);
 */






















/*
 * ----------------------------------------------------------------------
 * udpOpen --
 *
 *  opens a UDP socket and addds the file descriptor to the tcl
 *  interpreter
................................................................................
        int argc, CONST84 char * argv[]) 
{
    int sock;
    char channelName[20];
    UdpState *statePtr;
    uint16_t localport = 0;
    int reuse = 0;
#ifdef SIPC_IPV6
    struct sockaddr_in6  addr, sockaddr;
#else
    struct sockaddr_in  addr, sockaddr;
#endif

    unsigned long status = 1;
    socklen_t len;



    
    if (argc >= 2) {
        if ((argc >= 3) && (0 == strncmp("reuse", argv[2], 6))) {
            fprintf(stderr,"sock reuse!\n");
            reuse = 1;

        }







        if (udpGetService(interp, argv[1], &localport) != TCL_OK)

            return TCL_ERROR;
    }
    

    memset(channelName, 0, sizeof(channelName));
    
#ifdef SIPC_IPV6
    sock = socket(AF_INET6, SOCK_DGRAM, 0);
#else
    sock = socket(AF_INET, SOCK_DGRAM, 0);
#endif
    if (sock < 0) {
        snprintf(errBuf, 255, "failed to create socket");
        errBuf[255] = 0;
        UDPTRACE("%s\n", errBuf);
        Tcl_AppendResult(interp, errBuf, (char *)NULL);
        return TCL_ERROR;
    } 
................................................................................
    if (SetHandleInformation((HANDLE)sock, HANDLE_FLAG_INHERIT, 0) == 0) {
        Tcl_AppendResult(interp, "failed to set close-on-exec bit", NULL);
        return TCL_ERROR;
    }
#endif /* WIN32 */
#endif /* HAVE_FLAG_FD_CLOEXEC */

    memset(&addr, 0, sizeof(addr));
#ifdef SIPC_IPV6
    addr.sin6_family = AF_INET6;
    addr.sin6_port = localport;
#else
    addr.sin_family = AF_INET;
    addr.sin_addr.s_addr = 0;
    addr.sin_port = localport;
#endif
    if (reuse) {
        int one = 1;




        if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
                       (const char *)&one, sizeof(one)) < 0) {

            Tcl_SetObjResult(interp, 
                             ErrorToObj("error setting socket option"));
            closesocket(sock);
            return TCL_ERROR;
        }
    }











    if (bind(sock,(struct sockaddr *)&addr, sizeof(addr)) < 0) {
        Tcl_SetObjResult(interp, 
                         ErrorToObj("failed to bind socket to port"));

        closesocket(sock);
        return TCL_ERROR;
    }

    ioctlsocket(sock, FIONBIO, &status);

    if (localport == 0) {
        len = sizeof(sockaddr);
        getsockname(sock, (struct sockaddr *)&sockaddr, &len);
#ifdef SIPC_IPV6
        localport = sockaddr.sin6_port;
#else
        localport = sockaddr.sin_port;
#endif

    }
    
    UDPTRACE("Open socket %d. Bind socket to port %d\n", 
             sock, ntohs(localport));

    statePtr = (UdpState *) ckalloc((unsigned) sizeof(UdpState));
    memset(statePtr, 0, sizeof(UdpState));
................................................................................
                                          (ClientData) statePtr,
                                          (TCL_READABLE | TCL_WRITABLE | TCL_MODE_NONBLOCKING));
    statePtr->doread = 1;
    statePtr->multicast = 0;
    statePtr->groupsObj = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(statePtr->groupsObj);
    statePtr->localport = localport;

    Tcl_RegisterChannel(interp, statePtr->channel);
#ifdef WIN32
    statePtr->threadId = Tcl_GetCurrentThread();    
    statePtr->packetNum = 0;
    statePtr->next = NULL;
    statePtr->packets = NULL;
    statePtr->packetsTail = NULL;
................................................................................
    SetEvent(sockListLock);
    SetEvent(waitForSock);
#endif
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 * udpConf --
 * ----------------------------------------------------------------------
 */
int
udpConf(ClientData clientData, Tcl_Interp *interp,
        int argc, CONST84 char * argv[]) 
{
    Tcl_Channel chan;

    UdpState *statePtr;
    char *result;
    char buf[128];
    int sock;
    int r = TCL_OK;
    Tcl_DString ds;
    char errmsg[] = 
      "udpConf fileId [-mcastadd] [-mcastdrop] groupaddr | "





      "udpConf fileId remotehost remoteport | "
      "udpConf fileId [-myport] [-remote] [-peer] [-broadcast] [-ttl]";
    
    if (argc != 4 && argc != 3) {
        Tcl_SetResult (interp, errmsg, NULL);
        return TCL_ERROR;
    }
    chan = Tcl_GetChannel(interp, (char *)argv[1], NULL);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    statePtr = (UdpState *) Tcl_GetChannelInstanceData(chan);
    sock = statePtr->sock;
    
    if (argc == 3) {
        if (!strcmp(argv[2], "-myport")) {
            sprintf(buf, "%d", ntohs(statePtr->localport));
            Tcl_AppendResult(interp, buf, (char *)NULL);
        } else if (!strcmp(argv[2], "-remote")) {
            if (statePtr->remotehost && *statePtr->remotehost) {
                sprintf(buf, "%s", statePtr->remotehost);
                Tcl_AppendResult(interp, buf, (char *)NULL);
                sprintf(buf, "%d", ntohs(statePtr->remoteport));
                Tcl_AppendElement(interp, buf);
            }
        } else if (!strcmp(argv[2], "-peer")) {
            if (statePtr->peerhost && *statePtr->peerhost) {
                sprintf(buf, "%s", statePtr->peerhost);
                Tcl_AppendResult(interp, buf, (char *)NULL);
                sprintf(buf, "%d", statePtr->peerport);
                Tcl_AppendElement(interp, buf);
            }
        } else if (strcmp(argv[2], "-broadcast") == 0 
	    || strcmp(argv[2], "-ttl") == 0) {
	    

	    Tcl_DStringInit(&ds);
	    r = Tcl_GetChannelOption(interp, statePtr->channel, argv[2], &ds);
	    if (r == TCL_OK) {
		Tcl_DStringResult(interp, &ds);
	    }
	    Tcl_DStringFree(&ds);	    
	}
    } else if (argc == 4) {
        if (!strcmp(argv[2], "-mcastadd")) {

	    r = UdpMulticast((ClientData)statePtr, interp, argv[3], IP_ADD_MEMBERSHIP);

        } else if (!strcmp(argv[2], "-mcastdrop")) {

            r = UdpMulticast((ClientData)statePtr, interp, argv[3], IP_DROP_MEMBERSHIP);

        } else if (!strcmp(argv[2], "-broadcast")) {







	    r = Tcl_SetChannelOption(interp, statePtr->channel,
		"-broadcast", argv[3]);
	    
        } else if (!strcmp(argv[2], "-ttl")) {



	    r = Tcl_SetChannelOption(interp, statePtr->channel,
		"-ttl", argv[3]);

        } else {
            if (strlen(argv[2]) >= sizeof(statePtr->remotehost)) {
                result = "hostname too long";
                Tcl_SetResult (interp, result, NULL);
                r = TCL_ERROR;
            } else {
                strcpy(statePtr->remotehost, argv[2]);
                r = udpGetService(interp, argv[3], &(statePtr->remoteport));
	    }
        }
    } else {

        Tcl_SetResult (interp, errmsg, NULL);
        r = TCL_ERROR;
    }
    return r;
}

/*
 * ----------------------------------------------------------------------
 * udpPeek --
 *  peek some data and set the peer information
 * ----------------------------------------------------------------------
................................................................................
udpPeek(ClientData clientData, Tcl_Interp *interp,
        int argc, CONST84 char * argv[])
{
#ifndef WIN32
    int buffer_size = 16;
    int actual_size;
    socklen_t socksize;
    int sock;
    char message[17];
    /*struct hostent *name;*/
#ifdef SIPC_IPV6
    char *remotehost;
    struct sockaddr_in6 recvaddr;
#else
    struct sockaddr_in recvaddr;
#endif

    Tcl_Channel chan;
    UdpState *statePtr;
    
    if (argc < 2) {
	Tcl_WrongNumArgs(interp, 0, NULL, "udp_peek sock ?buffersize?");
        return TCL_ERROR;
    }
    chan = Tcl_GetChannel(interp, (char *)argv[1], NULL);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    statePtr = (UdpState *) Tcl_GetChannelInstanceData(chan);
    sock = Tcl_GetChannelHandle (chan, (TCL_READABLE | TCL_WRITABLE), NULL);
    
    if (argc > 2) {
        buffer_size = atoi(argv[2]);
        if (buffer_size > 16) buffer_size = 16;
    }
    actual_size = recvfrom(sock, message, buffer_size, MSG_PEEK,
                           (struct sockaddr *)&recvaddr, &socksize);
    
    if (actual_size < 0) {
        sprintf(errBuf, "udppeek error");
        Tcl_AppendResult(interp, errBuf, (char *)NULL);
        return TCL_ERROR;
    }
#ifdef SIPC_IPV6
    remotehost = (char *)inet_ntop(AF_INET6, &recvaddr.sin_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
    statePtr->peerport = ntohs(recvaddr.sin_port);
#else
    strcpy(statePtr->peerhost, (char *)inet_ntoa(recvaddr.sin_addr));
    statePtr->peerport = ntohs(recvaddr.sin_port);
#endif
    message[16]='\0';
    

    Tcl_AppendResult(interp, message, (char *)NULL);
    return TCL_OK;
#else /* WIN32 */
    Tcl_SetResult(interp, "udp_peek not implemented for this platform",
                  TCL_STATIC);
    return TCL_ERROR;
#endif /* ! WIN32 */
................................................................................
{
    UdpState *statePtr;
    UdpEvent *evPtr;
    int actual_size;
    socklen_t socksize;
    int buffer_size = MAXBUFFERSIZE;
    char *message;
#ifdef SIPC_IPV6
    char number[128], *remotehost;
    struct sockaddr_in6 recvaddr;
#else
    char number[32];
    struct sockaddr_in recvaddr;
#endif
    PacketList *p;
    


    /* UDPTRACE("checkProc\n"); */
    
    /* synchronized */
    WaitForSingleObject(sockListLock, INFINITE);
    
    for (statePtr = sockList; statePtr != NULL; statePtr=statePtr->next) {
        if (statePtr->packetNum > 0) {
            UDPTRACE("UDP_CheckProc\n");
            /* Read the data from socket and put it into statePtr */
            socksize = sizeof(recvaddr);
#ifdef SIPC_IPV6
            memset(number, 0, 128);
#else
            memset(number, 0, 32);
#endif
            memset(&recvaddr, 0, socksize);
            
            message = (char *)ckalloc(MAXBUFFERSIZE);
            if (message == NULL) {
                UDPTRACE("ckalloc error\n");
                exit(1);
            }
            memset(message, 0, MAXBUFFERSIZE);
            
................................................................................
            if (actual_size < 0) {
                UDPTRACE("UDP error - recvfrom %d\n", statePtr->sock);
                ckfree(message);
            } else {
                p = (PacketList *)ckalloc(sizeof(struct PacketList));
                p->message = message;
                p->actual_size = actual_size;
#ifdef SIPC_IPV6
                remotehost = (char *)inet_ntoa(AF_INET6, &recvaddr.sin6_addr, p->r_host, sizeof(p->r_host));

                p->r_port = ntohs(recvaddr.sin6_port);
#else













                strcpy(p->r_host, (char *)inet_ntoa(recvaddr.sin_addr));
                p->r_port = ntohs(recvaddr.sin_port);
#endif
                p->next = NULL;
                
#ifdef SIPC_IPV6


                remotehost = (char *)inet_ntoa(AF_INET6, &recvaddr.sin6_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );


                statePtr->peerport = ntohs(recvaddr.sin6_port);
#else
                strcpy(statePtr->peerhost, (char *)inet_ntoa(recvaddr.sin_addr));



                statePtr->peerport = ntohs(recvaddr.sin_port);

#endif
                


                if (statePtr->packets == NULL) {
                    statePtr->packets = p;
                    statePtr->packetsTail = p;
                } else {
                    statePtr->packetsTail->next = p;
                    statePtr->packetsTail = p;
                }
................................................................................
        
        WaitForSingleObject(sockListLock, INFINITE);
        sockset = 0;
        for (statePtr = sockList; statePtr != NULL; statePtr=statePtr->next) {
            if (FD_ISSET(statePtr->sock, &readfds)) {
                statePtr->packetNum++;
                sockset++;
                UDPTRACE("sock %d is set\n", statePtr->sock);
                break;
            }
        }
        SetEvent(sockListLock);
        
        /* wait for the socket data was read */
        if (sockset > 0) {
................................................................................
#ifdef WIN32
    UdpState *tmp, *p;
    
    WaitForSingleObject(sockListLock, INFINITE);
#endif /* ! WIN32 */
    
    sock = statePtr->sock;

#ifdef WIN32

    /* remove the statePtr from the list */
    for (tmp = p = sockList; p != NULL; tmp = p, p = p->next) {
	if (p->sock == sock) {
            UDPTRACE("Remove %d from the list\n", p->sock);
	    if (p == sockList) {
		sockList = sockList->next;
	    } else {
		tmp->next = p->next;
	    }
	}
    }

#endif /* ! WIN32 */

    /*
     * If there are multicast groups added they should be dropped.
     */
    if (statePtr->groupsObj) {
	int n = 0;
	Tcl_Obj *dupGroupList = Tcl_DuplicateObj(statePtr->groupsObj);
	Tcl_IncrRefCount(dupGroupList);
	Tcl_ListObjGetElements(interp, dupGroupList, &objc, &objv);
	for (n = 0; n < objc; n++) {

	    UdpMulticast((ClientData)statePtr, interp, 
		Tcl_GetString(objv[n]), IP_DROP_MEMBERSHIP);



	}

	Tcl_DecrRefCount(dupGroupList);
	Tcl_DecrRefCount(statePtr->groupsObj);
    }
    
    /* No - doing this causes a infinite recursion. Let Tcl handle this.
     *   Tcl_UnregisterChannel(interp, statePtr->channel);
     */
    if (closesocket(sock) < 0) {
        errorCode = errno;
    }
    ckfree((char *) statePtr);
    if (errorCode != 0) {
#ifndef WIN32
        sprintf(errBuf, "udpClose: %d, error: %d\n", sock, errorCode);
#else
        sprintf(errBuf, "udpClose: %d, error: %d\n", sock, WSAGetLastError());
#endif
        UDPTRACE("UDP error - close %d", sock);
    } else {
        UDPTRACE("Close socket %d\n", sock);
    }
    
#ifdef WIN32
    SetEvent(sockListLock);
#endif
    
    return errorCode;
}
 
/*
 * ----------------------------------------------------------------------
 * udpWatch --
 * ----------------------------------------------------------------------
 */
static void 
udpWatch(ClientData instanceData, int mask)
................................................................................
 * ----------------------------------------------------------------------
 * udpOutput--
 * ----------------------------------------------------------------------
 */
static int
udpOutput(ClientData instanceData, CONST84 char *buf, int toWrite, int *errorCode)
{
    UdpState *statePtr = (UdpState *) instanceData;
    int written;
    int socksize;
    struct hostent *name;
#ifdef SIPC_IPV6
    struct sockaddr_in6 sendaddr;
    int n, errnum;
#else
    struct sockaddr_in sendaddr;
#endif

    
    *errorCode = 0;
    errno = 0;
    
    if (toWrite > MAXBUFFERSIZE) {
        UDPTRACE("UDP error - MAXBUFFERSIZE");
        return -1;
    }


    socksize = sizeof(sendaddr);
    memset(&sendaddr, 0, socksize);




    
#ifdef SIPC_IPV6
    n = inet_pton(AF_INET6, statePtr->remotehost, &sendaddr.sin6_addr);
    if (n <= 0) {
        name = getipnodebyname(statePtr->remotehost, AF_INET6,



                               AI_DEFAULT, &errnum);






#else


        sendaddr.sin_addr.s_addr = inet_addr(statePtr->remotehost);

        if (sendaddr.sin_addr.s_addr == -1) {
            name = gethostbyname(statePtr->remotehost);
#endif
            if (name == NULL) {
                UDPTRACE("UDP error - gethostbyname");
                return -1;
            }
#ifdef SIPC_IPV6
            memcpy(&sendaddr.sin6_addr, name->h_addr, sizeof(sendaddr.sin6_addr));
        }
        sendaddr.sin6_family = AF_INET6;
        sendaddr.sin6_port = statePtr->remoteport;
#else
        memcpy(&sendaddr.sin_addr, name->h_addr, sizeof(sendaddr.sin_addr));
    }
    sendaddr.sin_family = AF_INET;
    sendaddr.sin_port = statePtr->remoteport;
#endif

    written = sendto(statePtr->sock, buf, toWrite, 0,
                     (struct sockaddr *)&sendaddr, socksize);


    if (written < 0) {
        UDPTRACE("UDP error - sendto");
        return -1;
    }
    
    UDPTRACE("Send %d to %s:%d through %d\n", written, statePtr->remotehost,
             ntohs(statePtr->remoteport), statePtr->sock);
    
    return written;
}

/*
 * ----------------------------------------------------------------------
 * udpInput
 * ----------------------------------------------------------------------
................................................................................
    UdpState *statePtr = (UdpState *) instanceData;
    int bytesRead;

#ifdef WIN32
    PacketList *packets;
#else /* ! WIN32 */
    socklen_t socksize;
    int port;
    int buffer_size = MAXBUFFERSIZE;
    char *remotehost;
    int sock = statePtr->sock;
#ifdef SIPC_IPV6
    char number[128];
    struct sockaddr_in6 recvaddr;
#else /* ! SIPC_IPV6 */
    char number[32];
    struct sockaddr_in recvaddr;
#endif /* ! SIPC_IPV6 */
#endif /* ! WIN32 */
    
    UDPTRACE("In udpInput\n");
    
    /*
     * The caller of this function is looking for a stream oriented
     * system, so it keeps calling the function until no bytes are
................................................................................
    strcpy(statePtr->peerhost, packets->r_host);
    statePtr->peerport = packets->r_port;
    statePtr->packets = packets->next;
    ckfree((char *) packets);
    bytesRead = bufSize;
#else /* ! WIN32 */
    socksize = sizeof(recvaddr);
#ifdef SIPC_IPV6
    memset(number, 0, 128);
#else
    memset(number, 0, 32);
#endif
    memset(&recvaddr, 0, socksize);
    
    bytesRead = recvfrom(sock, buf, buffer_size, 0,
                         (struct sockaddr *)&recvaddr, &socksize);
    if (bytesRead < 0) {
        UDPTRACE("UDP error - recvfrom %d\n", sock);
        *errorCode = errno;
        return -1;
    }
    
#ifdef SIPC_IPV6
    remotehost = (char *)inet_ntop(AF_INET6,
                                   &recvaddr.sin6_addr, statePtr->peerhost,
                                   sizeof(statePtr->peerhost));
    port = ntohs(recvaddr.sin6_port);
#else
    remotehost = (char *)inet_ntoa(recvaddr.sin_addr);
    port = ntohs(recvaddr.sin_port);
    strcpy(statePtr->peerhost, remotehost);
#endif


    

    UDPTRACE("remotehost: %s:%d\n", remotehost, port);
    statePtr->peerport = port;
#endif /* ! WIN32 */
    
    /* we don't want to return anything next time */
    if (bytesRead > 0) {
        buf[bytesRead] = '\0';
        statePtr->doread = 0;
    }
................................................................................
}
 
/*
 * ----------------------------------------------------------------------
 *
 * UdpMulticast --
 *
 *	Action should be IP_ADD_MEMBERSHIP | IP_DROP_MEMBERSHIP

 *
 */

static int
UdpMulticast(ClientData instanceData, Tcl_Interp *interp, 
    const char *grp, int action)
{
    UdpState *statePtr = (UdpState *)instanceData;





















































    struct ip_mreq mreq;
    struct hostent *name;
    
    memset(&mreq, 0, sizeof(mreq));
    
    mreq.imr_multiaddr.s_addr = inet_addr(grp);
    if (mreq.imr_multiaddr.s_addr == -1) {
        name = gethostbyname(grp);
        if (name == NULL) {
	    if (interp != NULL) {
		Tcl_SetResult(interp, "invalid group name", TCL_STATIC);
	    }
            return TCL_ERROR;
        }
        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) {
	    if (interp != NULL) {
		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) {
	    Tcl_Obj *newPtr;
	    statePtr->multicast++;
	    if (Tcl_IsShared(statePtr->groupsObj)) {
		newPtr = Tcl_DuplicateObj(statePtr->groupsObj);
		Tcl_DecrRefCount(statePtr->groupsObj);
		Tcl_IncrRefCount(newPtr);
		statePtr->groupsObj = newPtr;
	    }
	    Tcl_ListObjAppendElement(interp, statePtr->groupsObj,
				     Tcl_NewStringObj(grp,-1));
	}
    } else {
	int ndx = LSearch(statePtr->groupsObj, grp);
	if (ndx != -1) {
	    Tcl_Obj *old, *ptr;
            int dup = 0;
	    old = ptr = statePtr->groupsObj;
	    statePtr->multicast--;
	    if ((dup = Tcl_IsShared(ptr))) {
		ptr = Tcl_DuplicateObj(ptr);
	    }
	    Tcl_ListObjReplace(interp, ptr, ndx, 1, 0, NULL);
            if (dup) {
	        statePtr->groupsObj = ptr;
	        Tcl_IncrRefCount(ptr);
	        Tcl_DecrRefCount(old);
            }
	}
    }
    if (interp != NULL)
        Tcl_SetObjResult(interp, statePtr->groupsObj);
    return TCL_OK;
}
 
/*
 * ----------------------------------------------------------------------
 * udpGetOption --
 * ----------------------------------------------------------------------
 */
static int 
udpGetOption(ClientData instanceData, Tcl_Interp *interp,
             CONST84 char *optionName, Tcl_DString *optionValue)
{
    UdpState *statePtr = (UdpState *)instanceData;
    CONST84 char * options[] = { "myport", "remote", "peer", "mcastgroups", "mcastloop", "broadcast", "ttl", NULL};
    int r = TCL_OK;

    if (optionName == NULL) {
	Tcl_DString ds;
	const char **p;
	
	Tcl_DStringInit(&ds);
	for (p = options; *p != NULL; p++) {
	    char op[16];
	    sprintf(op, "-%s", *p);
	    Tcl_DStringSetLength(&ds, 0);
	    udpGetOption(instanceData, interp, op, &ds);
	    Tcl_DStringAppend(optionValue, " ", 1);
	    Tcl_DStringAppend(optionValue, op, -1);
	    Tcl_DStringAppend(optionValue, " ", 1);
	    Tcl_DStringAppendElement(optionValue, Tcl_DStringValue(&ds));
	}

    } else {

        Tcl_DString ds, dsInt;
        Tcl_DStringInit(&ds);
        Tcl_DStringInit(&dsInt);

        if (!strcmp("-myport", optionName)) {

            Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
            sprintf(Tcl_DStringValue(&ds), "%u", ntohs(statePtr->localport));

        } else if (!strcmp("-remote", optionName)) {


            Tcl_DStringSetLength(&dsInt, TCL_INTEGER_SPACE);
            sprintf(Tcl_DStringValue(&dsInt), "%u", 
                    ntohs(statePtr->remoteport));
            Tcl_DStringAppendElement(&ds, statePtr->remotehost);
            Tcl_DStringAppendElement(&ds, Tcl_DStringValue(&dsInt));


        } else if (!strcmp("-peer", optionName)) {


            Tcl_DStringSetLength(&dsInt, TCL_INTEGER_SPACE);
            sprintf(Tcl_DStringValue(&dsInt), "%u", statePtr->peerport);
            Tcl_DStringAppendElement(&ds, statePtr->peerhost);
            Tcl_DStringAppendElement(&ds, Tcl_DStringValue(&dsInt));


        } else if (!strcmp("-mcastgroups", optionName)) {

            int objc, n;
	    Tcl_Obj **objv;
	    Tcl_ListObjGetElements(interp, statePtr->groupsObj, &objc, &objv);
	    for (n = 0; n < objc; n++) {
		Tcl_DStringAppendElement(&ds, Tcl_GetString(objv[n]));
	    }
	    
        } else if (!strcmp("-broadcast", optionName)) {

            int tmp = 1;
            socklen_t optlen = sizeof(int);
            if (getsockopt(statePtr->sock, SOL_SOCKET, SO_BROADCAST, 
                           (char *)&tmp, &optlen)) {
		Tcl_SetObjResult(interp, ErrorToObj("error reading -broadcast"));
                r = TCL_ERROR;
            } else {
                Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
                sprintf(Tcl_DStringValue(&ds), "%d", tmp);
            }

	} else if (!strcmp("-mcastloop", optionName)) {

            unsigned char tmp = 0;
            socklen_t optlen = sizeof(unsigned char);
            if (getsockopt(statePtr->sock, IPPROTO_IP, IP_MULTICAST_LOOP, 
                           (char *)&tmp, &optlen)) {
		Tcl_SetObjResult(interp, ErrorToObj("error reading -mcastloop"));
                r = TCL_ERROR;
            } else {


                Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
                sprintf(Tcl_DStringValue(&ds), "%d", (int)tmp);
            }

        } else if (!strcmp("-ttl", optionName)) {
          
            unsigned int tmp = 0;
            socklen_t optlen = sizeof(unsigned int);
	    int cmd = IP_TTL;
	    if (statePtr->multicast > 0)
		cmd = IP_MULTICAST_TTL;
            if (getsockopt(statePtr->sock, IPPROTO_IP, cmd,
		(char *)&tmp, &optlen)) {
		Tcl_SetObjResult(interp, ErrorToObj("error reading -ttl"));
                r = TCL_ERROR;
            } else {


                Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
                sprintf(Tcl_DStringValue(&ds), "%u", tmp);
            }
	    
        } else {
	    CONST84 char **p;
	    Tcl_DString tmp;
	    Tcl_DStringInit(&tmp);
	    for (p = options; *p != NULL; p++)
		Tcl_DStringAppendElement(&tmp, *p);
            r = Tcl_BadChannelOption(interp, optionName, Tcl_DStringValue(&tmp));
	    Tcl_DStringFree(&tmp);
        }
        
        if (r == TCL_OK) {
            Tcl_DStringAppend(optionValue, Tcl_DStringValue(&ds), -1);
        }
        Tcl_DStringFree(&dsInt);
        Tcl_DStringFree(&ds);
    }

    return r;
}

/*
 * ----------------------------------------------------------------------
 * udpSetOption --
 *
 *  Handle channel configuration requests from the generic layer.
................................................................................
static int
udpSetOption(ClientData instanceData, Tcl_Interp *interp,
             CONST84 char *optionName, CONST84 char *newValue)
{
    UdpState *statePtr = (UdpState *)instanceData;
    CONST84 char * options = "remote mcastadd mcastdrop mcastloop broadcast ttl";
    int r = TCL_OK;

    if (!strcmp("-remote", optionName)) {















        Tcl_Obj *valPtr;
        int len;

        valPtr = Tcl_NewStringObj(newValue, -1);
        r = Tcl_ListObjLength(interp, valPtr, &len);
        if (r == TCL_OK) {
            if (len < 1 || len > 2) {
                Tcl_SetResult(interp, "wrong # args", TCL_STATIC);














                r = TCL_ERROR;






            } else {
                Tcl_Obj *hostPtr, *portPtr;

                
                Tcl_ListObjIndex(interp, valPtr, 0, &hostPtr);
                strcpy(statePtr->remotehost, Tcl_GetString(hostPtr));
                
                if (len == 2) {
                    Tcl_ListObjIndex(interp, valPtr, 1, &portPtr);            
                    r = udpGetService(interp, Tcl_GetString(portPtr),


                                      &(statePtr->remoteport));



                }

            }
        }



    } else if (!strcmp("-mcastadd", optionName)) {


	r = UdpMulticast(instanceData, interp, 
	    (const char *)newValue, IP_ADD_MEMBERSHIP);

    } else if (!strcmp("-mcastdrop", optionName)) {




	r = UdpMulticast(instanceData, interp, 
	    (const char *)newValue, IP_DROP_MEMBERSHIP);


    } else if (!strcmp("-broadcast", optionName)) {






        int tmp = 1;

        r = Tcl_GetInt(interp, newValue, &tmp);







        if (r == TCL_OK) {
            if (setsockopt(statePtr->sock, SOL_SOCKET, SO_BROADCAST, 
                           (const char *)&tmp, sizeof(int))) {















                Tcl_SetObjResult(interp, ErrorToObj("error setting -broadcast"));















                r = TCL_ERROR;



            } 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 {
                Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
            }
        }

    } else if (!strcmp("-ttl", optionName)) {








































        unsigned int tmp = 0;
	int cmd = IP_TTL;

	if (statePtr->multicast > 0)
	    cmd = IP_MULTICAST_TTL;




        r = Tcl_GetInt(interp, newValue, &tmp);
        if (r == TCL_OK) {
            if (setsockopt(statePtr->sock, IPPROTO_IP, cmd,
                           (const char *)&tmp, sizeof(unsigned int))) {
                Tcl_SetObjResult(interp, ErrorToObj("error setting -ttl"));
                r = TCL_ERROR;
            } else {
                Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
            }
        }


























    } else {


        r = Tcl_BadChannelOption(interp, optionName, options);







    }









    return r;
}




















































static Tcl_Obj *
ErrorToObj(const char * prefix)
{
    Tcl_Obj *errObj;
#ifdef WIN32
    LPVOID sMsg;

 *
 * 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.45 2014/02/13 20:49:57 huubeikens Exp $
 ******************************************************************************/

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

#include "udp_tcl.h"
................................................................................
 * but we need it and TEA causes this macro to be defined.
 */

struct ip_mreq {
    struct in_addr imr_multiaddr; /* IP multicast address of group */
    struct in_addr imr_interface; /* local IP address of interface */
};

struct ipv6_mreq {
    struct in6_addr ipv6mr_multiaddr; /* IPv6 multicast addr */
    unsigned int    ipv6mr_interface; /* interface index */
};

#endif /* _XOPEN_SOURCE_EXTENDED */

/* define some Win32isms for Unix */
#ifndef WIN32
#define SOCKET int
#define INVALID_SOCKET -1
#define closesocket close
................................................................................
int udpOpen(ClientData , Tcl_Interp *, int , CONST84 char * []);
int udpConf(ClientData , Tcl_Interp *, int , CONST84 char * []);
int udpPeek(ClientData , Tcl_Interp *, int , CONST84 char * []);

/*
 * internal functions
 */
static int UdpMulticast(UdpState *statePtr, Tcl_Interp *, const char *, int);
static int UdpSockGetPort(Tcl_Interp *interp, const char *s,
                          const char *proto, int *portPtr);
static void udpTrace(const char *format, ...);
static int  udpGetService(Tcl_Interp *interp, const char *service,
                          unsigned short *servicePort);
static Tcl_Obj *ErrorToObj(const char * prefix);

static int hasOption(int argc, CONST84 char * argv[],const char* option );
static int udpSetRemoteOption(UdpState* statePtr, Tcl_Interp *interp, CONST84 char *newValue);
static int udpSetMulticastAddOption(UdpState* statePtr, Tcl_Interp *interp, CONST84 char *newValue);
static int udpSetMulticastDropOption(UdpState* statePtr, Tcl_Interp *interp, CONST84 char *newValue);
static int udpSetBroadcastOption(UdpState* statePtr, Tcl_Interp *interp, CONST84 char *newValue);
static int udpGetBroadcastOption(UdpState* statePtr, Tcl_Interp *interp, int* value);
static int udpSetMcastloopOption(UdpState* statePtr, Tcl_Interp *interp, CONST84 char *newValue);
static int udpGetMcastloopOption(UdpState *statePtr, Tcl_Interp *interp, unsigned char * value);
static int udpSetTtlOption(UdpState* statePtr, Tcl_Interp *interp, CONST84 char *newValue);
static int udpGetTtlOption(UdpState *statePtr, Tcl_Interp *interp,unsigned int *value);

/*
 * Windows specific functions
 */
#ifdef WIN32

int  UdpEventProc(Tcl_Event *evPtr, int flags);
................................................................................

#endif /* ! WIN32 */

/*
 * This structure describes the channel type for accessing UDP.
 */
static Tcl_ChannelType Udp_ChannelType = {



    "udp",                 /* Type name.                                    */

    NULL,                  /* Set blocking/nonblocking behaviour. NULL'able */
    udpClose,              /* Close channel, clean instance data            */
    udpInput,              /* Handle read request                           */
    udpOutput,             /* Handle write request                          */
    NULL,                  /* Move location of access point.      NULL'able */
    udpSetOption,          /* Set options.                        NULL'able */
    udpGetOption,          /* Get options.                        NULL'able */
................................................................................
    Tcl_InitStubs(interp, "8.1", 0);
#endif

#ifdef WIN32
    if (Udp_WinHasSockets(interp) != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_CreateEventSource(UDP_SetupProc, UDP_CheckProc, NULL);
#endif

    Tcl_CreateCommand(interp, "udp_open", udpOpen , 
                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
    Tcl_CreateCommand(interp, "udp_conf", udpConf , 
                      (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
................................................................................
/*
 * Probably we should provide an equivalent to the C API for TCP.
 *
 * Tcl_Channel Tcl_OpenUdpClient(interp, port, host, myaddr, myport, async);
 * Tcl_Channel Tcl_OpenUdpServer(interp, port, myaddr, proc, clientData);
 * Tcl_Channel Tcl_MakeUdpClientChannel(sock);
 */

/*
 * ----------------------------------------------------------------------
 * checkOption --
 *
 *  Checks if the specified option is part of the specified command line options.
 *  Returns 1 if option is present, otherwise 0.
 * ----------------------------------------------------------------------
 */
static int
hasOption(int argc, CONST84 char * argv[],const char* option ) 
{
	int i;
	for (i=0;i<argc;i++) {
		if (strcmp(option, argv[i])==0) {
			/* Option found. */
			return 1;
		}
	}
	return 0;
}

/*
 * ----------------------------------------------------------------------
 * udpOpen --
 *
 *  opens a UDP socket and addds the file descriptor to the tcl
 *  interpreter
................................................................................
        int argc, CONST84 char * argv[]) 
{
    int sock;
    char channelName[20];
    UdpState *statePtr;
    uint16_t localport = 0;
    int reuse = 0;



	struct sockaddr_storage addr,sockaddr;

	socklen_t addr_len;
    unsigned long status = 1;
    socklen_t len;
	short ss_family = AF_INET; /* Default ipv4 */ 
	char errmsg[] = "upd_open [remoteport] [ipv6] [reuse]";
	int remaining_options = argc;
	
    if (argc >= 2) {		
		if (hasOption(argc,argv,"reuse")) {

           reuse = 1;
           remaining_options--;
 		}

		if (hasOption(argc,argv,"ipv6")) {
 			ss_family = AF_INET6;
 			remaining_options--;			
 		}
		/* The remaining option must be the port (if specified) */
		if (remaining_options == 2) {
		   if (udpGetService(interp, argv[1], &localport) != TCL_OK) {
				Tcl_SetResult (interp, errmsg, NULL);
				return TCL_ERROR;
		   }
		}
    } 
    memset(channelName, 0, sizeof(channelName));
    

	sock = socket(ss_family, SOCK_DGRAM, 0);



    if (sock < 0) {
        snprintf(errBuf, 255, "failed to create socket");
        errBuf[255] = 0;
        UDPTRACE("%s\n", errBuf);
        Tcl_AppendResult(interp, errBuf, (char *)NULL);
        return TCL_ERROR;
    } 
................................................................................
    if (SetHandleInformation((HANDLE)sock, HANDLE_FLAG_INHERIT, 0) == 0) {
        Tcl_AppendResult(interp, "failed to set close-on-exec bit", NULL);
        return TCL_ERROR;
    }
#endif /* WIN32 */
#endif /* HAVE_FLAG_FD_CLOEXEC */










    if (reuse) {
        int one = 1;
#ifdef SO_REUSEPORT
        if (setsockopt(sock, SOL_SOCKET, SO_REUSEPORT,
                       (const char *)&one, sizeof(one)) < 0) {
#else
        if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
                       (const char *)&one, sizeof(one)) < 0) {
#endif
             Tcl_SetObjResult(interp, 
                             ErrorToObj("error setting socket option"));
            closesocket(sock);
            return TCL_ERROR;
        }
    }
     
	memset(&addr, 0, sizeof(addr));
	if (ss_family == AF_INET6) {
		((struct sockaddr_in6 *) &addr)->sin6_family = AF_INET6;
		((struct sockaddr_in6 *) &addr)->sin6_port = localport;
		addr_len = sizeof(struct sockaddr_in6);
	} else {
		((struct sockaddr_in *) &addr)->sin_family = AF_INET;
		((struct sockaddr_in *) &addr)->sin_port = localport;
		addr_len = sizeof(struct sockaddr_in);
	}
	if ( bind(sock,(struct sockaddr *)&addr, addr_len) < 0) {
        Tcl_SetObjResult(interp, 
                         ErrorToObj("failed to bind socket to port"));

        closesocket(sock);
        return TCL_ERROR;
    }

    ioctlsocket(sock, FIONBIO, &status);

    if (localport == 0) {
        len = sizeof(sockaddr);
		getsockname(sock, (struct sockaddr *)&sockaddr, &len);
 		if (ss_family == AF_INET6) {
			localport = ((struct sockaddr_in6 *) &sockaddr)->sin6_port;
		} else {
			localport = ((struct sockaddr_in *) &sockaddr)->sin_port;

		}
    }
    
    UDPTRACE("Open socket %d. Bind socket to port %d\n", 
             sock, ntohs(localport));

    statePtr = (UdpState *) ckalloc((unsigned) sizeof(UdpState));
    memset(statePtr, 0, sizeof(UdpState));
................................................................................
                                          (ClientData) statePtr,
                                          (TCL_READABLE | TCL_WRITABLE | TCL_MODE_NONBLOCKING));
    statePtr->doread = 1;
    statePtr->multicast = 0;
    statePtr->groupsObj = Tcl_NewListObj(0, NULL);
    Tcl_IncrRefCount(statePtr->groupsObj);
    statePtr->localport = localport;
	statePtr->ss_family = ss_family;
    Tcl_RegisterChannel(interp, statePtr->channel);
#ifdef WIN32
    statePtr->threadId = Tcl_GetCurrentThread();    
    statePtr->packetNum = 0;
    statePtr->next = NULL;
    statePtr->packets = NULL;
    statePtr->packetsTail = NULL;
................................................................................
    SetEvent(sockListLock);
    SetEvent(waitForSock);
#endif
    return TCL_OK;
}

/*
* ----------------------------------------------------------------------
* udpConf --
* ----------------------------------------------------------------------
*/
int
udpConf(ClientData clientData, Tcl_Interp *interp,
		int argc, CONST84 char * argv[]) 
{
	Tcl_Channel chan;
	char remoteOptions[255];
	UdpState *statePtr = NULL;



	int r = TCL_ERROR;
	Tcl_DString ds;
	char errmsg[] = 
		"udp_conf fileId [-mcastadd] [-mcastdrop] groupaddr | "
#ifdef WIN32
		"udp_conf fileId [-mcastadd] [-mcastdrop] \"groupaddr netwif_index\" | "
#else
		"udp_conf fileId [-mcastadd] [-mcastdrop] \"groupaddr netwif\" | "
#endif
		"udp_conf fileId remotehost remoteport | "
		"udp_conf fileId [-myport] [-remote] [-peer] [-mcastgroups] [-mcastloop] [-broadcast] [-ttl]";
	
	if (argc >= 2) {



		chan = Tcl_GetChannel(interp, (char *)argv[1], NULL);
		if (chan != (Tcl_Channel) NULL) {


			statePtr = (UdpState *) Tcl_GetChannelInstanceData(chan);

		}










	}






	



	if (argc == 3 && statePtr != NULL) {
		Tcl_DStringInit(&ds);
		r = Tcl_GetChannelOption(interp, statePtr->channel, argv[2], &ds);
		if (r == TCL_OK) {
			Tcl_DStringResult(interp, &ds);
		}
		Tcl_DStringFree(&ds);	     
	}


	








	if (argc == 4 && statePtr != NULL) {
		if (hasOption(argc,argv,"-mcastloop") ||
			hasOption(argc,argv,"-broadcast") ||
			hasOption(argc,argv,"-mcastadd") ||
			hasOption(argc,argv,"-mcastdrop") ||
			hasOption(argc,argv,"-ttl")) { 
			r = Tcl_SetChannelOption(interp, statePtr->channel, argv[2], argv[3]);




		} else {
			sprintf(remoteOptions, "%s %s",argv[2],argv[3] );
			r = Tcl_SetChannelOption(interp, statePtr->channel, "-remote", remoteOptions);

		}








	}
	

	if (r != TCL_OK) {
		Tcl_SetResult (interp, errmsg, NULL);

	}
	return r;
}

/*
 * ----------------------------------------------------------------------
 * udpPeek --
 *  peek some data and set the peer information
 * ----------------------------------------------------------------------
................................................................................
udpPeek(ClientData clientData, Tcl_Interp *interp,
        int argc, CONST84 char * argv[])
{
#ifndef WIN32
    int buffer_size = 16;
    int actual_size;
    socklen_t socksize;

    char message[17];





	struct sockaddr_storage recvaddr;


    Tcl_Channel chan;
    UdpState *statePtr;
    
    if (argc < 2) {
	Tcl_WrongNumArgs(interp, 0, NULL, "udp_peek sock ?buffersize?");
        return TCL_ERROR;
    }
    chan = Tcl_GetChannel(interp, (char *)argv[1], NULL);
    if (chan == (Tcl_Channel) NULL) {
        return TCL_ERROR;
    }
    statePtr = (UdpState *) Tcl_GetChannelInstanceData(chan);

    
    if (argc > 2) {
        buffer_size = atoi(argv[2]);
        if (buffer_size > 16) buffer_size = 16;
    }
    
    memset(message, 0 , sizeof(message));
    actual_size = recvfrom(statePtr->sock, message, buffer_size, MSG_PEEK,
                           (struct sockaddr *)&recvaddr, &socksize);
    
    if (actual_size < 0 && errno != EAGAIN && errno != EWOULDBLOCK) {
        Tcl_SetObjResult(interp,  ErrorToObj("udppeek error"));
        return TCL_ERROR;
    }
    
	if (statePtr->ss_family == AF_INET6) {
		inet_ntop(AF_INET6, &((struct sockaddr_in6*)&recvaddr)->sin6_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
		statePtr->peerport = ntohs(((struct sockaddr_in6*)&recvaddr)->sin6_port);
	} else {
		inet_ntop(AF_INET, &((struct sockaddr_in*)&recvaddr)->sin_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
		statePtr->peerport = ntohs(((struct sockaddr_in*)&recvaddr)->sin_port);
	}

    Tcl_AppendResult(interp, message, (char *)NULL);
    return TCL_OK;
#else /* WIN32 */
    Tcl_SetResult(interp, "udp_peek not implemented for this platform",
                  TCL_STATIC);
    return TCL_ERROR;
#endif /* ! WIN32 */
................................................................................
{
    UdpState *statePtr;
    UdpEvent *evPtr;
    int actual_size;
    socklen_t socksize;
    int buffer_size = MAXBUFFERSIZE;
    char *message;
    struct sockaddr_storage recvaddr;
    PacketList *p;
#ifdef WIN32
	char hostaddr[256];
	char* portaddr;
	char remoteaddr[256];
  	int remoteaddrlen = sizeof(remoteaddr);
	memset(hostaddr, 0 , sizeof(hostaddr));
	memset(remoteaddr,0,sizeof(remoteaddr));
#endif /*  WIN32 */
	
    /* UDPTRACE("checkProc\n"); */
    
    /* synchronized */
    WaitForSingleObject(sockListLock, INFINITE);
    
    for (statePtr = sockList; statePtr != NULL; statePtr=statePtr->next) {
        if (statePtr->packetNum > 0) {
            UDPTRACE("UDP_CheckProc\n");
            /* Read the data from socket and put it into statePtr */
            socksize = sizeof(recvaddr);





            memset(&recvaddr, 0, socksize);
              
            message = (char *)ckalloc(MAXBUFFERSIZE);
            if (message == NULL) {
                UDPTRACE("ckalloc error\n");
                exit(1);
            }
            memset(message, 0, MAXBUFFERSIZE);
            
................................................................................
            if (actual_size < 0) {
                UDPTRACE("UDP error - recvfrom %d\n", statePtr->sock);
                ckfree(message);
            } else {
                p = (PacketList *)ckalloc(sizeof(struct PacketList));
                p->message = message;
                p->actual_size = actual_size;
#ifdef WIN32

				/* 
				 * In windows, do not use getnameinfo() since this function does
				 * not work correctly in case of multithreaded. Also inet_ntop() is
				 * not available in older windows versions.
				 */
				if (WSAAddressToString((struct sockaddr *)&recvaddr,socksize,
					NULL,remoteaddr,&remoteaddrlen)==0) {
					/* 
					 * We now have an address in the format of <ip address>:<port> 
					 * Search backwards for the last ':'
					 */
					portaddr = strrchr(remoteaddr,':') + 1;
					strncpy(hostaddr,remoteaddr,strlen(remoteaddr)-strlen(portaddr)-1);
					statePtr->peerport = atoi(portaddr);
					p->r_port = statePtr->peerport;
					strcpy(statePtr->peerhost,hostaddr);
					strcpy(p->r_host,hostaddr);



				}

#else
				if (statePtr->ss_family == AF_INET ) {
					inet_ntop(AF_INET, ((struct sockaddr_in*)&recvaddr)->sin_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
					inet_ntop(AF_INET, ((struct sockaddr_in*)&recvaddr)->sin_addr, p->r_host, sizeof(p->r_host) );
	               	p->r_port = ntohs(((struct sockaddr_in*)&recvaddr)->sin_port);
                	statePtr->peerport = ntohs(((struct sockaddr_in*)&recvaddr)->sin_port);                					
				} else {					

					inet_ntop(AF_INET6, ((struct sockaddr_in6*)&recvaddr)->sin6_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
					inet_ntop(AF_INET6, ((struct sockaddr_in6*)&recvaddr)->sin6_addr, p->r_host, sizeof(p->r_host) );
  				    p->r_port = ntohs(((struct sockaddr_in6*)&recvaddr)->sin6_port);
				    statePtr->peerport = ntohs(((struct sockaddr_in6*)&recvaddr)->sin6_port);
				}
#endif /*  WIN32 */

                p->next = NULL;
                 
                if (statePtr->packets == NULL) {
                    statePtr->packets = p;
                    statePtr->packetsTail = p;
                } else {
                    statePtr->packetsTail->next = p;
                    statePtr->packetsTail = p;
                }
................................................................................
        
        WaitForSingleObject(sockListLock, INFINITE);
        sockset = 0;
        for (statePtr = sockList; statePtr != NULL; statePtr=statePtr->next) {
            if (FD_ISSET(statePtr->sock, &readfds)) {
                statePtr->packetNum++;
                sockset++;
                UDPTRACE("sock %d is set\n", statePtr->sock); 
                break;
            }
        }
        SetEvent(sockListLock);
        
        /* wait for the socket data was read */
        if (sockset > 0) {
................................................................................
#ifdef WIN32
    UdpState *tmp, *p;
    
    WaitForSingleObject(sockListLock, INFINITE);
#endif /* ! WIN32 */
    
    sock = statePtr->sock;
	
#ifdef WIN32
	
    /* remove the statePtr from the list */
    for (tmp = p = sockList; p != NULL; tmp = p, p = p->next) {
		if (p->sock == sock) {
            UDPTRACE("Remove %d from the list\n", p->sock);
			if (p == sockList) {
				sockList = sockList->next;
			} else {
				tmp->next = p->next;
			}
		}
    }
	
#endif /* ! WIN32 */
	
    /*
	* If there are multicast groups added they should be dropped.
	*/
    if (statePtr->groupsObj) {
		int n = 0;
		Tcl_Obj *dupGroupList = Tcl_DuplicateObj(statePtr->groupsObj);
		Tcl_IncrRefCount(dupGroupList);
		Tcl_ListObjGetElements(interp, dupGroupList, &objc, &objv);
		for (n = 0; n < objc; n++) {
			if (statePtr->ss_family==AF_INET) {
				UdpMulticast(statePtr, interp, 
					Tcl_GetString(objv[n]), IP_DROP_MEMBERSHIP);
			} else {
				UdpMulticast(statePtr, interp, 
					Tcl_GetString(objv[n]), IPV6_LEAVE_GROUP);
			}
		}
		Tcl_DecrRefCount(dupGroupList);
		Tcl_DecrRefCount(statePtr->groupsObj);
    }
    
    /* No - doing this causes a infinite recursion. Let Tcl handle this.
	*   Tcl_UnregisterChannel(interp, statePtr->channel);
	*/
    if (closesocket(sock) < 0) {
        errorCode = errno;
    }
    ckfree((char *) statePtr);
    if (errorCode != 0) {
#ifndef WIN32
        sprintf(errBuf, "udp_close: %d, error: %d\n", sock, errorCode);
#else
        sprintf(errBuf, "udp_cose: %d, error: %d\n", sock, WSAGetLastError());
#endif
        UDPTRACE("UDP error - close %d", sock);
    } else {
        UDPTRACE("Close socket %d\n", sock);
    }
    
#ifdef WIN32
    SetEvent(sockListLock);
#endif
    
    return errorCode;
}

/*
 * ----------------------------------------------------------------------
 * udpWatch --
 * ----------------------------------------------------------------------
 */
static void 
udpWatch(ClientData instanceData, int mask)
................................................................................
 * ----------------------------------------------------------------------
 * udpOutput--
 * ----------------------------------------------------------------------
 */
static int
udpOutput(ClientData instanceData, CONST84 char *buf, int toWrite, int *errorCode)
{
	UdpState *statePtr = (UdpState *) instanceData;
    int written;
    int socksize;
    struct hostent *name;

    struct sockaddr_in sendaddrv4;


    struct sockaddr_in6 sendaddrv6;

	struct addrinfo hints, *result;




    if (toWrite > MAXBUFFERSIZE) {
        UDPTRACE("UDP error - MAXBUFFERSIZE");
        return -1;
    }
 
 	if (statePtr->ss_family == AF_INET6) {
		socksize = sizeof(sendaddrv6);
		memset(&sendaddrv6, 0, socksize);
		memset(&hints, 0, sizeof(struct addrinfo));
		hints.ai_family = AF_INET6;
		hints.ai_socktype = SOCK_DGRAM;
		hints.ai_protocol = IPPROTO_UDP;




		if (getaddrinfo(statePtr->remotehost, NULL, &hints, &result) != 0) {
				UDPTRACE("UDP error - getaddrinfo failed");
				return -1;
		}
		memcpy (&sendaddrv6, result->ai_addr, result->ai_addrlen);
		freeaddrinfo(result);

		sendaddrv6.sin6_family = AF_INET6;
		sendaddrv6.sin6_port = statePtr->remoteport;

		written = sendto(statePtr->sock, buf, toWrite, 0, (struct sockaddr *)&sendaddrv6, socksize);
	} else {
		socksize = sizeof(sendaddrv4);
		memset(&sendaddrv4, 0, socksize);
        sendaddrv4.sin_addr.s_addr = inet_addr(statePtr->remotehost);

        if (sendaddrv4.sin_addr.s_addr == -1) {
            name = gethostbyname(statePtr->remotehost);

			if (name == NULL) {
				UDPTRACE("UDP error - gethostbyname");
				return -1;
			}

			memcpy(&sendaddrv4.sin_addr, name->h_addr, sizeof(sendaddrv4.sin_addr));
		}





		sendaddrv4.sin_family = AF_INET;
		sendaddrv4.sin_port = statePtr->remoteport;


		written = sendto(statePtr->sock, buf, toWrite, 0, (struct sockaddr *)&sendaddrv4, socksize);

	}

	if (written < 0) {
		UDPTRACE("UDP error - sendto");
		return -1;
	}

	UDPTRACE("Send %d to %s:%d through %d\n", written, statePtr->remotehost,
			 ntohs(statePtr->remoteport), statePtr->sock);

    return written;
}

/*
 * ----------------------------------------------------------------------
 * udpInput
 * ----------------------------------------------------------------------
................................................................................
    UdpState *statePtr = (UdpState *) instanceData;
    int bytesRead;

#ifdef WIN32
    PacketList *packets;
#else /* ! WIN32 */
    socklen_t socksize;

    int buffer_size = MAXBUFFERSIZE;

    int sock = statePtr->sock;





	struct sockaddr_storage recvaddr;

#endif /* ! WIN32 */
    
    UDPTRACE("In udpInput\n");
    
    /*
     * The caller of this function is looking for a stream oriented
     * system, so it keeps calling the function until no bytes are
................................................................................
    strcpy(statePtr->peerhost, packets->r_host);
    statePtr->peerport = packets->r_port;
    statePtr->packets = packets->next;
    ckfree((char *) packets);
    bytesRead = bufSize;
#else /* ! WIN32 */
    socksize = sizeof(recvaddr);





    memset(&recvaddr, 0, socksize);
   
    bytesRead = recvfrom(sock, buf, buffer_size, 0,
                         (struct sockaddr *)&recvaddr, &socksize);
    if (bytesRead < 0) {
        UDPTRACE("UDP error - recvfrom %d\n", sock);
        *errorCode = errno;
        return -1;
    }
    
	if (statePtr->ss_family == AF_INET6) {
		inet_ntop(AF_INET6, &((struct sockaddr_in6*)&recvaddr)->sin6_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
		statePtr->peerport = ntohs(((struct sockaddr_in6*)&recvaddr)->sin6_port);


	} else {




		inet_ntop(AF_INET, &((struct sockaddr_in*)&recvaddr)->sin_addr, statePtr->peerhost, sizeof(statePtr->peerhost) );
		statePtr->peerport = ntohs(((struct sockaddr_in*)&recvaddr)->sin_port);
	}
 	    
    UDPTRACE("remotehost: %s:%d\n", statePtr->peerhost, statePtr->peerport);

#endif /* ! WIN32 */
    
    /* we don't want to return anything next time */
    if (bytesRead > 0) {
        buf[bytesRead] = '\0';
        statePtr->doread = 0;
    }
................................................................................
}
 
/*
 * ----------------------------------------------------------------------
 *
 * UdpMulticast --
 *
 *	Action should be IP_ADD_MEMBERSHIP | IPV6_JOIN_GROUP 
 *  or IP_DROP_MEMBERSHIP | IPV6_LEAVE_GROUP
 *
 */

static int
UdpMulticast(UdpState *statePtr, Tcl_Interp *interp, 
    const char *grp, int action)
{
	int r;
	Tcl_Obj *tcllist , *multicastgrp , *nw_interface;
	int len,result;
	int nwinterface_index =-1;
#ifndef WIN32
	struct ifreq ifreq;
#endif /* ! WIN32 */

	/* 
	 * Parameter 'grp' can be:
	 *  Windows: <multicast group> or {<multicast group> <network interface index>} 
	 *  Not Windows: <multicast group> or {<multicast group> <network interface name>} 
	 */ 
	tcllist = Tcl_NewStringObj(grp, -1);
	result = Tcl_ListObjLength(interp, tcllist, &len);
	if (result == TCL_OK) {
		if (len==2) {
			Tcl_ListObjIndex(interp, tcllist, 0, &multicastgrp);
			Tcl_ListObjIndex(interp, tcllist, 1, &nw_interface);
#ifdef WIN32
			if ( Tcl_GetIntFromObj(interp,nw_interface,&nwinterface_index) == TCL_ERROR && nwinterface_index < 1) {
				Tcl_SetResult(interp, "not a valid network interface index; should start with 1", TCL_STATIC);
				return TCL_ERROR;
			}
#else
			int lenPtr = -1;
			if (nw_interface->length > IFNAMSIZ ) {
				Tcl_SetResult(interp, "unknown network interface", TCL_STATIC);
				return TCL_ERROR;
			}
			
			if (statePtr->ss_family == AF_INET) {
				/* For IPv4, we need the network interface address. */
				strcpy(ifreq.ifr_name,Tcl_GetStringFromObj(nw_interface,&lenPtr));
				if (ioctl(statePtr->sock, SIOCGIFADDR, &ifreq) < 0 ) {
					Tcl_SetResult(interp, "unknown network interface", TCL_STATIC);
					return TCL_ERROR;
				}
			} 
			nwinterface_index = if_nametoindex(Tcl_GetStringFromObj(nw_interface,&lenPtr));
			if (nwinterface_index == 0 ) {
				Tcl_SetResult(interp, "unknown network interface", TCL_STATIC);
				return TCL_ERROR;
			}
#endif /* ! WIN32 */
		} else if (len==1) {
			Tcl_ListObjIndex(interp, tcllist, 0, &multicastgrp);
		} else {
			Tcl_SetResult(interp, "multicast group and/or local network interface not specified", TCL_STATIC);
			return TCL_ERROR;
		}
	}

	if (statePtr->ss_family == AF_INET) {
		struct ip_mreq mreq;
		struct hostent *name;
		
		memset(&mreq, 0, sizeof(mreq));
		
		mreq.imr_multiaddr.s_addr = inet_addr(Tcl_GetString(multicastgrp));
		if (mreq.imr_multiaddr.s_addr == -1) {
			name = gethostbyname(Tcl_GetString(multicastgrp));
			if (name == NULL) {
				if (interp != NULL) {
					Tcl_SetResult(interp, "invalid group name", TCL_STATIC);
				}
				return TCL_ERROR;
			}
			memcpy(&mreq.imr_multiaddr.s_addr, name->h_addr, sizeof(mreq.imr_multiaddr));

		}
		
		if (nwinterface_index==-1) {
			/* No interface index specified. Let the system use the default interface. */
			mreq.imr_interface.s_addr = INADDR_ANY;
		} else {
#ifdef WIN32
			/* Using an interface index of x is indicated by 0.0.0.x */
			mreq.imr_interface.s_addr = htonl(nwinterface_index);
#else
			memcpy(&mreq.imr_interface, &((struct sockaddr_in *) &ifreq.ifr_addr)->sin_addr, sizeof(struct in_addr));
#endif
		}
		
		if (setsockopt(statePtr->sock, IPPROTO_IP, action, (const char*)&mreq, sizeof(mreq)) < 0) {

			if (interp != NULL) {
				Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group"));
			}
			return TCL_ERROR;
		}
	} else {
		struct ipv6_mreq mreq6;
		struct addrinfo hints;
		struct addrinfo *result = NULL;

		memset(&hints, 0, sizeof(hints));

		hints.ai_family = statePtr->ss_family;
		hints.ai_socktype = SOCK_DGRAM;
		hints.ai_protocol = IPPROTO_UDP;
		
		r = getaddrinfo(Tcl_GetString(multicastgrp), NULL, &hints, &result);
		memcpy(&mreq6.ipv6mr_multiaddr, &((struct sockaddr_in6*)(result->ai_addr))->sin6_addr,sizeof(mreq6.ipv6mr_multiaddr));
		freeaddrinfo(result);

		if (r != 0 ) {
			Tcl_SetResult(interp, "invalid group name", TCL_STATIC);	
			return TCL_ERROR;
		}

		if (nwinterface_index == -1) {
			/* Let the system choose the default multicast network interface. */
			mreq6.ipv6mr_interface = 0;
 		} else {
			/* Use the specified network interface. */
 			mreq6.ipv6mr_interface = nwinterface_index;
		}

		if (setsockopt(statePtr->sock, IPPROTO_IPV6, action, (const char*)&mreq6, sizeof(mreq6)) < 0) {
			if (interp != NULL) {
				Tcl_SetObjResult(interp, ErrorToObj("error changing multicast group"));
			}
			return TCL_ERROR;
		}	
	}

    if (action == IP_ADD_MEMBERSHIP || action == IPV6_JOIN_GROUP) {
		int ndx = LSearch(statePtr->groupsObj, grp);
		if (ndx == -1) {
			Tcl_Obj *newPtr;
			statePtr->multicast++;
			if (Tcl_IsShared(statePtr->groupsObj)) {
				newPtr = Tcl_DuplicateObj(statePtr->groupsObj);
				Tcl_DecrRefCount(statePtr->groupsObj);
				Tcl_IncrRefCount(newPtr);
				statePtr->groupsObj = newPtr;
			}
			Tcl_ListObjAppendElement(interp, statePtr->groupsObj,
				Tcl_NewStringObj(grp,-1));
		}
    } else {
		int ndx = LSearch(statePtr->groupsObj, grp);
		if (ndx != -1) {
			Tcl_Obj *old, *ptr;
            int dup = 0;
			old = ptr = statePtr->groupsObj;
			statePtr->multicast--;
			if ((dup = Tcl_IsShared(ptr))) {
				ptr = Tcl_DuplicateObj(ptr);
			}
			Tcl_ListObjReplace(interp, ptr, ndx, 1, 0, NULL);
            if (dup) {
				statePtr->groupsObj = ptr;
				Tcl_IncrRefCount(ptr);
				Tcl_DecrRefCount(old);
            }
		}
    }
    if (interp != NULL)
        Tcl_SetObjResult(interp, statePtr->groupsObj);
    return TCL_OK;
}
 
/*
* ----------------------------------------------------------------------
* udpGetOption --
* ----------------------------------------------------------------------
*/
static int 
udpGetOption(ClientData instanceData, Tcl_Interp *interp,
			 CONST84 char *optionName, Tcl_DString *optionValue)
{
	UdpState *statePtr = (UdpState *)instanceData;
	CONST84 char * options[] = { "myport", "remote", "peer", "mcastgroups", "mcastloop", "broadcast", "ttl", NULL};
	int r = TCL_OK;
	
	if (optionName == NULL) {
		Tcl_DString ds;
		const char **p;
		
		Tcl_DStringInit(&ds);
		for (p = options; *p != NULL; p++) {
			char op[16];
			sprintf(op, "-%s", *p);
			Tcl_DStringSetLength(&ds, 0);
			udpGetOption(instanceData, interp, op, &ds);
			Tcl_DStringAppend(optionValue, " ", 1);
			Tcl_DStringAppend(optionValue, op, -1);
			Tcl_DStringAppend(optionValue, " ", 1);
			Tcl_DStringAppendElement(optionValue, Tcl_DStringValue(&ds));
		}
		
	} else {
		
		Tcl_DString ds, dsInt;
		Tcl_DStringInit(&ds);
		Tcl_DStringInit(&dsInt);
		
		if (!strcmp("-myport", optionName)) {
			
			Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
			sprintf(Tcl_DStringValue(&ds), "%u", ntohs(statePtr->localport));
			
		} else if (!strcmp("-remote", optionName)) {

            if (statePtr->remotehost && *statePtr->remotehost) {
				Tcl_DStringSetLength(&dsInt, TCL_INTEGER_SPACE);
				sprintf(Tcl_DStringValue(&dsInt), "%u", 
					ntohs(statePtr->remoteport));
				Tcl_DStringAppendElement(&ds, statePtr->remotehost);
				Tcl_DStringAppendElement(&ds, Tcl_DStringValue(&dsInt));
			}
			
		} else if (!strcmp("-peer", optionName)) {
			
           if (statePtr->peerhost && *statePtr->peerhost) {
 				Tcl_DStringSetLength(&dsInt, TCL_INTEGER_SPACE);
				sprintf(Tcl_DStringValue(&dsInt), "%u", statePtr->peerport);
				Tcl_DStringAppendElement(&ds, statePtr->peerhost);
				Tcl_DStringAppendElement(&ds, Tcl_DStringValue(&dsInt));
		   }
			
		} else if (!strcmp("-mcastgroups", optionName)) {
			
			int objc, n;
			Tcl_Obj **objv;
			Tcl_ListObjGetElements(interp, statePtr->groupsObj, &objc, &objv);
			for (n = 0; n < objc; n++) {
				Tcl_DStringAppendElement(&ds, Tcl_GetString(objv[n]));
			}
			
		} else if (!strcmp("-broadcast", optionName)) {

			int tmp =1;


			r = udpGetBroadcastOption(statePtr,interp,&tmp);
			if (r==TCL_OK) {


				Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
				sprintf(Tcl_DStringValue(&ds), "%d", tmp);
			}			 

		} else if (!strcmp("-mcastloop", optionName)) {

			unsigned char tmp = 0;			 






			r = udpGetMcastloopOption(statePtr, interp,&tmp);
			if (r==TCL_OK) {
				Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
				sprintf(Tcl_DStringValue(&ds), "%d", (int)tmp);
			}			 			 

		} else if (!strcmp("-ttl", optionName)) {
			
			unsigned int tmp = 0;









			r = udpGetTtlOption(statePtr,interp,&tmp);
			if (r==TCL_OK) {
				Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
				sprintf(Tcl_DStringValue(&ds), "%u", tmp);
			}			 

		} else {
			CONST84 char **p;
			Tcl_DString tmp;
			Tcl_DStringInit(&tmp);
			for (p = options; *p != NULL; p++)
				Tcl_DStringAppendElement(&tmp, *p);
			r = Tcl_BadChannelOption(interp, optionName, Tcl_DStringValue(&tmp));
			Tcl_DStringFree(&tmp);
		}
		
		if (r == TCL_OK) {
			Tcl_DStringAppend(optionValue, Tcl_DStringValue(&ds), -1);
		}
		Tcl_DStringFree(&dsInt);
		Tcl_DStringFree(&ds);
	}
	
	return r;
}

/*
 * ----------------------------------------------------------------------
 * udpSetOption --
 *
 *  Handle channel configuration requests from the generic layer.
................................................................................
static int
udpSetOption(ClientData instanceData, Tcl_Interp *interp,
             CONST84 char *optionName, CONST84 char *newValue)
{
    UdpState *statePtr = (UdpState *)instanceData;
    CONST84 char * options = "remote mcastadd mcastdrop mcastloop broadcast ttl";
    int r = TCL_OK;
	
    if (!strcmp("-remote", optionName)) {
		r = udpSetRemoteOption(statePtr,interp,(const char *)newValue);
    } else if (!strcmp("-mcastadd", optionName)) {
		r = udpSetMulticastAddOption(statePtr, interp, (const char *)newValue);		
    } else if (!strcmp("-mcastdrop", optionName)) {
		r = udpSetMulticastDropOption(statePtr, interp, (const char *)newValue);				
    } else if (!strcmp("-broadcast", optionName)) {
		r = udpSetBroadcastOption(statePtr, interp, (const char*) newValue);		
     } else if (!strcmp("-mcastloop", optionName)) {
		r = udpSetMcastloopOption(statePtr, interp, (const char*) newValue);
	 } else if (!strcmp("-ttl", optionName)) {
		r = udpSetTtlOption(statePtr, interp, (const char*) newValue);		
    } else {
        Tcl_BadChannelOption(interp, optionName, options);
		r=TCL_ERROR;
    }








    return r;
}

/*
 * ----------------------------------------------------------------------
 * udpGetTtlOption --
 *
 *  Handle ttl configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpGetTtlOption(UdpState *statePtr, Tcl_Interp *interp,unsigned int *value)
{
	int result = TCL_ERROR;
	int cmd;
	socklen_t optlen = sizeof(unsigned int);

	if (statePtr->ss_family==AF_INET) {
		if (statePtr->multicast > 0) {
			cmd = IP_MULTICAST_TTL;
		} else {

			cmd = IP_TTL;
		}






		result = getsockopt(statePtr->sock, IPPROTO_IP, cmd, (char*)value, &optlen);
	} else {
		if (statePtr->multicast > 0) {
			cmd = IPV6_MULTICAST_HOPS;
		} else {
			cmd = IPV6_UNICAST_HOPS;
		}
		result = getsockopt(statePtr->sock, IPPROTO_IPV6, cmd, (char*)value, &optlen);
	}

	if (result==TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error getting -ttl",-1));
	} 

	return result;
}




/*
 * ----------------------------------------------------------------------
 * udpSetTtlOption --
 *


 *  Handle ttl configuration requests.
 *

 * ----------------------------------------------------------------------
 */
static int
udpSetTtlOption(UdpState *statePtr, Tcl_Interp *interp,CONST84 char *newValue)
{
	int result = TCL_ERROR;
	int tmp = 0;
	int cmd;
	result = Tcl_GetInt(interp, newValue, &tmp);
	
	if (statePtr->ss_family==AF_INET) {
		if (statePtr->multicast > 0) {
			cmd = IP_MULTICAST_TTL;
		} else {
			cmd = IP_TTL;
		}
		if (result == TCL_OK) {

			result = setsockopt(statePtr->sock, IPPROTO_IP, cmd,(const char *)&tmp, sizeof(unsigned int));
		}
	} else {
		if (statePtr->multicast > 0) {
			cmd = IPV6_MULTICAST_HOPS;
		} else {
			cmd = IPV6_UNICAST_HOPS;
		}
		if (result == TCL_OK) {
			result = setsockopt(statePtr->sock, IPPROTO_IPV6, cmd,(const char *)&tmp, sizeof(unsigned int));
		}
	}

	if (result==TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error setting -ttl",-1));
	} else {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
	}
	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpGetMcastloopOption --
 *
 *  Handle multicast loop configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpGetMcastloopOption(UdpState *statePtr, Tcl_Interp *interp, unsigned char * value)
{
	int result = TCL_ERROR;
	socklen_t optlen=sizeof(int);
	if (statePtr->ss_family == AF_INET) {
		result = getsockopt(statePtr->sock, IPPROTO_IP, IP_MULTICAST_LOOP,value, &optlen);
	} else {
		result = getsockopt(statePtr->sock, IPPROTO_IPV6, IPV6_MULTICAST_LOOP,value, &optlen);
	}
	
	if (result == TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error getting -mcastloop",-1));
	} 
	

	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpSetMcastloopOption --
 *
 *  Handle multicast loop configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpSetMcastloopOption(UdpState *statePtr, Tcl_Interp *interp,CONST84 char *newValue)
{
	int result = TCL_ERROR;
	int tmp = 1;
	if (Tcl_GetBoolean(interp, newValue, &tmp)==TCL_OK) {


		if (statePtr->ss_family == AF_INET) {
			result = setsockopt(statePtr->sock, IPPROTO_IP, IP_MULTICAST_LOOP,
			(const char *)&tmp, sizeof(tmp));

		} else {
			result = setsockopt(statePtr->sock, IPPROTO_IPV6, IPV6_MULTICAST_LOOP,
			(const char *)&tmp, sizeof(tmp));
		}
	}

	if (result == TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error setting -mcastloop",-1));
	} else {
		Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
	}
	
	

	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpGetBroadcastOption --
 *
 *  Handle broadcast configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpGetBroadcastOption(UdpState *statePtr, Tcl_Interp *interp, int* value)
{
	int result = TCL_OK;
	socklen_t optlen = sizeof(int);
	if (statePtr->ss_family == AF_INET6 ) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("broadcast not supported under ipv6",-1));
		return TCL_ERROR;
	}
	if (getsockopt(statePtr->sock, SOL_SOCKET, SO_BROADCAST, (char*)value, &optlen)) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error getting -broadcast",-1));
		result = TCL_ERROR;
	} 
	
	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpSetBroadcastOption --
 *
 *  Handle broadcast configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpSetBroadcastOption(UdpState *statePtr, Tcl_Interp *interp,CONST84 char *newValue)
{
	int result;
	int tmp = 1;


	if (statePtr->ss_family == AF_INET6 ) {

			Tcl_SetObjResult(interp, ErrorToObj("broadcast not supported under ipv6"));
			return TCL_ERROR;
	}

	result = Tcl_GetInt(interp, newValue, &tmp);
	if (result == TCL_OK ) {
		if (setsockopt(statePtr->sock, SOL_SOCKET, SO_BROADCAST, 
			(const char *)&tmp, sizeof(int))) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj("error setting -broadcast",-1));
			result = TCL_ERROR;
		} else {
			Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
		}
	}
	
	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpSetRemoteOption --
 *
 *  Handle remote port/host configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpSetRemoteOption(UdpState *statePtr, Tcl_Interp *interp,CONST84 char *newValue)
{
	int result;
	
	Tcl_Obj *valPtr;
	int len;
	
	valPtr = Tcl_NewStringObj(newValue, -1);
	result = Tcl_ListObjLength(interp, valPtr, &len);
	if (result == TCL_OK) {
		if (len < 1 || len > 2) {
			Tcl_SetResult(interp, "wrong # args", TCL_STATIC);
			result = TCL_ERROR;
		} else {
			Tcl_Obj *hostPtr, *portPtr;
			

			Tcl_ListObjIndex(interp, valPtr, 0, &hostPtr);
			strcpy(statePtr->remotehost, Tcl_GetString(hostPtr));
			
			if (len == 2) {
				Tcl_ListObjIndex(interp, valPtr, 1, &portPtr);            
				result = udpGetService(interp, Tcl_GetString(portPtr),
					&(statePtr->remoteport));
			}
		}
	}

	if (result==TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error setting -remote",-1));
	} else {
		Tcl_SetObjResult(interp, Tcl_NewStringObj(newValue,-1));
	}

	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpSetMulticastAddOption --
 *
 *  Handle multicast add configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpSetMulticastAddOption(UdpState *statePtr, Tcl_Interp *interp,CONST84 char *newValue)
{
 	int result;

	if (statePtr->ss_family == AF_INET) {
		result = UdpMulticast(statePtr, interp, 
				(const char *)newValue, IP_ADD_MEMBERSHIP);		
	} else {
		result = UdpMulticast(statePtr, interp, 
				(const char *)newValue, IPV6_JOIN_GROUP);		
	}
	return result;
}

/*
 * ----------------------------------------------------------------------
 * udpSetMulticastDropOption --
 *
 *  Handle multicast drop configuration requests.
 *
 * ----------------------------------------------------------------------
 */
static int
udpSetMulticastDropOption(UdpState *statePtr, Tcl_Interp *interp,CONST84 char *newValue)
{
 	int result;

	if (statePtr->ss_family == AF_INET) {
		result = UdpMulticast(statePtr, interp, 
				(const char *)newValue, IP_DROP_MEMBERSHIP);		
	} else {
		result = UdpMulticast(statePtr, interp, 
				(const char *)newValue, IPV6_LEAVE_GROUP);		
	}

	if (result==TCL_ERROR) {
		Tcl_SetObjResult(interp, Tcl_NewStringObj("error setting -mcastdrop",-1));
	} 

	return result;
}

static Tcl_Obj *
ErrorToObj(const char * prefix)
{
    Tcl_Obj *errObj;
#ifdef WIN32
    LPVOID sMsg;

 * 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
................................................................................
#  if HAVE_STDINT_H
#    include <stdint.h>
#  endif
#  include <sys/socket.h>
#  include <netinet/in.h>
#  include <arpa/inet.h>
#  include <netdb.h>

#endif /* WIN32 */

#include <stdio.h>
#include <string.h>
#include <limits.h>
#include <errno.h>
#include <sys/types.h>
................................................................................
  HWND              hwnd;
  PacketList        *packets;
  PacketList        *packetsTail;
  int               packetNum;
  struct UdpState   *next;
  Tcl_ThreadId      threadId;        /* for Tcl_ThreadAlert */
#endif

  int               multicast;       /* indicator set for multicast add */
  Tcl_Obj          *groupsObj;       /* list of the mcast groups */
} UdpState;


EXTERN int Udp_Init(Tcl_Interp *interp);
EXTERN int Udp_SafeInit(Tcl_Interp *interp);

#endif

 * 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.12 2014/02/13 20:49:57 huubeikens Exp $
 *----------------------------------------------------------------------
 */

#ifndef UDP_TCL_H
#define UDP_TCL_H

#ifdef HAVE_CONFIG_H
................................................................................
#  if HAVE_STDINT_H
#    include <stdint.h>
#  endif
#  include <sys/socket.h>
#  include <netinet/in.h>
#  include <arpa/inet.h>
#  include <netdb.h>
#  include <net/if.h>
#endif /* WIN32 */

#include <stdio.h>
#include <string.h>
#include <limits.h>
#include <errno.h>
#include <sys/types.h>
................................................................................
  HWND              hwnd;
  PacketList        *packets;
  PacketList        *packetsTail;
  int               packetNum;
  struct UdpState   *next;
  Tcl_ThreadId      threadId;        /* for Tcl_ThreadAlert */
#endif
  short				ss_family;		 /* indicator set for ipv4 or ipv6 usage */
  int               multicast;       /* indicator set for multicast add */
  Tcl_Obj          *groupsObj;       /* list of the mcast groups */
} UdpState;


EXTERN int Udp_Init(Tcl_Interp *interp);
EXTERN int Udp_SafeInit(Tcl_Interp *interp);

#endif

            set ::done 1
        }
    }
    
    set timeout [after %TIMEOUT ::DoTimeout]
    fconfigure stdout -buffering line
    fconfigure stdin -buffering line
    set socket [udp_open]
    fconfigure $socket -buffering none -encoding binary -translation binary
    fileevent $socket readable [list ReadSock $socket]
    fileevent stdin readable [list ReadControl stdin]
    Wait 100
    puts ready
    puts [fconfigure $socket -myport]
    vwait ::done
................................................................................

proc Wait {n} {
    set ::forever 0
    after $n {set ::forever 1}
    vwait ::forever
}

proc createChildProcess {filename {timeout 5000}} {
    file delete -force $filename
    set f [open $filename w]
    puts $f [string map [list %TIMEOUT $timeout] $::script]
    close $f
    set p [open |[list [interpreter] $filename] r+]
    fconfigure $p -buffering line
    gets $p line
    return $p
}

................................................................................
        default {
            return -code error "invalid command \"$cmd\": must be one of start or display"
        }
    }
    return
}


test udp-srv-1 {basic server operation (ascii)} -constraints {stdio} -setup {
    set child [createChildProcess $::scriptName]
    gets $child port
} -body {
    set u [udp_open]
    fconfigure $u -remote [list localhost $port]
    puts -nonewline $u "abcdefgh"
    close $u
    Wait 100
    gets $child r
    lindex $r 1
} -cleanup {

    closeChildProcess $child

} -result {8}

test udp-srv-2 {basic server operation (binary)} -constraints {stdio} -setup {
    set child [createChildProcess $::scriptName]
    gets $child port
} -body {
    set u [udp_open]
    fconfigure $u -remote [list localhost $port]
    puts -nonewline $u "\0\1\2\3\4\5\6\7"
................................................................................
        incr r
    }
    set r
} -cleanup {
    timestamp display 6.3 $t
    closeChildProcess $child
} -result {10000}


# -------------------------------------------------------------------------
file delete -force $::scriptName
::tcltest::cleanupTests
return

# Local variables:
# mode: tcl
# End:

            set ::done 1
        }
    }
    
    set timeout [after %TIMEOUT ::DoTimeout]
    fconfigure stdout -buffering line
    fconfigure stdin -buffering line
    set socket [udp_open %OPTIONS]
    fconfigure $socket -buffering none -encoding binary -translation binary
    fileevent $socket readable [list ReadSock $socket]
    fileevent stdin readable [list ReadControl stdin]
    Wait 100
    puts ready
    puts [fconfigure $socket -myport]
    vwait ::done
................................................................................

proc Wait {n} {
    set ::forever 0
    after $n {set ::forever 1}
    vwait ::forever
}

proc createChildProcess {filename {timeout 5000} {udp_open_options {}}} {
    file delete -force $filename
    set f [open $filename w]
    puts $f [string map [list %TIMEOUT $timeout %OPTIONS $udp_open_options] $::script]
    close $f
    set p [open |[list [interpreter] $filename] r+]
    fconfigure $p -buffering line
    gets $p line
    return $p
}

................................................................................
        default {
            return -code error "invalid command \"$cmd\": must be one of start or display"
        }
    }
    return
}


test udp-srv-1 {basic server operation (ascii)} -constraints {stdio} -setup {
    set child [createChildProcess $::scriptName 10000]
    gets $child port
} -body {
    set u [udp_open]
    fconfigure $u -remote [list localhost $port]
    puts -nonewline $u "abcdefgh"
    close $u
    Wait 100
    gets $child r
    lindex $r 1
} -cleanup {
	puts "closing child process $child"
    closeChildProcess $child
	puts "closed..."
} -result {8}
	
test udp-srv-2 {basic server operation (binary)} -constraints {stdio} -setup {
    set child [createChildProcess $::scriptName]
    gets $child port
} -body {
    set u [udp_open]
    fconfigure $u -remote [list localhost $port]
    puts -nonewline $u "\0\1\2\3\4\5\6\7"
................................................................................
        incr r
    }
    set r
} -cleanup {
    timestamp display 6.3 $t
    closeChildProcess $child
} -result {10000}


# -------------------------------------------------------------------------
file delete -force $::scriptName
::tcltest::cleanupTests
return

# Local variables:
# mode: tcl
# End:

# 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.8 2008/07/06 12:39:09 patthoyts Exp $

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

package require udp
................................................................................

test udp-3.7 {-mcastloop invalid option} -setup {
    set s [udp_open]
} -body {
    fconfigure $s -mcastloop stupid
} -cleanup {
    close $s
} -returnCodes error -match glob -result {expected boolean value *}

test udp-3.8 {-mcastloop is boolean - 1/0} -setup {
    set s [udp_open]
} -body {
    set a [list [fconfigure $s -mcastloop 1]]
    lappend a [fconfigure $s -mcastloop 0]
    set a
................................................................................
    set s [udp_open]
} -body {
    set a [list [fconfigure $s -mcastloop on]]
    lappend a [fconfigure $s -mcastloop off]
} -cleanup {
    close $s
} -result {1 0}















































test udp-4.0 {udp_peek} -constraints unix -setup {
    set s [udp_open]
} -body {
    udp_peek $s
} -cleanup {
    close $s
} -result {FIX ME on a unix box}

test udp-4.1 {udp_peek} -constraints unix -setup {
    set s [udp_open]


} -body {

    udp_peek $s
} -cleanup {
    close $s
} -result {FIX ME on a unix box}

test udp-4.2 "udp_peek: bug #1828920 - args" -constraints unix -setup {
    set s [udp_open]
} -body {
    udp_peek
} -cleanup {
    close $s
} -returnCodes error -match glob -result {wrong num args: *}






















test udp-10.1 "bug #1838467 - crash on exit" -setup {
    set s [udp_open]
} -body {
    # Note: this test actually causes a crash on process exit when it
    # fails. The socket needs to be left open ...
    fconfigure $s -mcastadd 224.0.10.10

# 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.9 2014/02/13 20:49:57 huubeikens Exp $

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

package require udp
................................................................................

test udp-3.7 {-mcastloop invalid option} -setup {
    set s [udp_open]
} -body {
    fconfigure $s -mcastloop stupid
} -cleanup {
    close $s
} -returnCodes error -match glob -result {error setting -mcastloop*}

test udp-3.8 {-mcastloop is boolean - 1/0} -setup {
    set s [udp_open]
} -body {
    set a [list [fconfigure $s -mcastloop 1]]
    lappend a [fconfigure $s -mcastloop 0]
    set a
................................................................................
    set s [udp_open]
} -body {
    set a [list [fconfigure $s -mcastloop on]]
    lappend a [fconfigure $s -mcastloop off]
} -cleanup {
    close $s
} -result {1 0}

test udp-3.12 {test -mcastadd with network interface} -constraints win -setup {
    set s [udp_open]
} -body {
    set a [fconfigure $s -mcastadd {224.0.10.10 1}]
    set a [fconfigure $s -mcastadd {224.0.10.11 1}]
} -cleanup {
    close $s
} -result {{224.0.10.10 1} {224.0.10.11 1}}

test udp-3.13 {test -mcastadd with invalid network interface}  -constraints win -setup {
    set s [udp_open]
} -body {
    set a [fconfigure $s -mcastadd {224.0.10.11 notanumber}]
} -cleanup {
    close $s
} -returnCodes error -match glob -result {*}

test udp-3.14 {test -mcastadd with network interface} -constraints unix -setup {
    set s [udp_open]
} -body {
	set error 0
	# loopback interface is either lo (linux) or lo0 (mac)
    if {[catch {fconfigure $s -mcastadd {224.0.10.10 lo}}] ^ 
        [catch {fconfigure $s -mcastadd {224.0.10.10 lo0}}]} {
    	set error 1
    }
} -cleanup {
    close $s
} -result {1}

test udp-3.15 {test -mcastadd with invalid network interface} -constraints unix -setup {
    set s [udp_open]
} -body {
    set a [fconfigure $s -mcastadd {224.0.10.11 averylongwronginterface}]
} -cleanup {
    close $s
} -returnCodes error -match glob -result {*}

test udp-3.16 {test -mcastadd with invalid network interface} -constraints unix -setup {
    set s [udp_open]
} -body {
    set a [fconfigure $s -mcastadd {224.0.10.11 wrongif}]
} -cleanup {
    close $s
} -returnCodes error -match glob -result {*}

test udp-4.0 {udp_peek} -constraints unix -setup {
    set s [udp_open]
} -body {
    udp_peek $s
} -cleanup {
    close $s
} -result {}

test udp-4.1 {udp_peek} -constraints unix -setup {
    set s [udp_open 9009]
    fconfigure $s -mcastadd 224.0.10.10 -remote [list 224.0.10.10 9009]
	fconfigure $s -buffering none -blocking 0
} -body {
	puts $s "message"
    udp_peek $s
} -cleanup {
    close $s
} -result {message}

test udp-4.2 "udp_peek: bug #1828920 - args" -constraints unix -setup {
    set s [udp_open]
} -body {
    udp_peek
} -cleanup {
    close $s
} -returnCodes error -match glob -result {wrong * args: *}

test udp-5.0 {udp_open with reused port} -body {
    set s [udp_open 9001 reuse]
    set u [udp_open 9001 reuse]
} -cleanup {
    close $s
} -match regexp -result {sock\d+}

test udp-5.0 {udp_open with no port reuse option} -body {
    set s [udp_open 9001 reuse]
    catch {set u [udp_open 9001]} error
} -cleanup {
    close $s
    close $u
} -match glob -result {1}

test udp-6.0 {udp_open with ipv6} -body {
    set s [udp_open 9001 ipv6]
} -cleanup {
    close $s
} -match regexp -result {sock\d+}

test udp-10.1 "bug #1838467 - crash on exit" -setup {
    set s [udp_open]
} -body {
    # Note: this test actually causes a crash on process exit when it
    # fails. The socket needs to be left open ...
    fconfigure $s -mcastadd 224.0.10.10

# 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)
................................................................................
# binary here.
#
#-------------------------------------------------------------------------

PROJECT = udp
!include "rules.vc"

DOTVERSION      = 1.0.9
VERSION         = $(DOTVERSION:.=)
STUBPREFIX      = $(PROJECT)stub

DLLOBJS = \
	$(TMP_DIR)\udp_tcl.obj \
	$(TMP_DIR)\tcludp.res

................................................................................
!if $(DEBUG)
ldebug	= -debug:full -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3
!endif

### Declarations common to all linker options
lflags	= -nologo -machine:$(MACHINE) $(ldebug)

!if $(PROFILE)
lflags	= $(lflags) -profile
!endif

!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
### Align sections for PE size savings.

# 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.8 2014/02/13 20:49:57 huubeikens 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)
................................................................................
# binary here.
#
#-------------------------------------------------------------------------

PROJECT = udp
!include "rules.vc"

DOTVERSION      = 1.0.10
VERSION         = $(DOTVERSION:.=)
STUBPREFIX      = $(PROJECT)stub

DLLOBJS = \
	$(TMP_DIR)\udp_tcl.obj \
	$(TMP_DIR)\tcludp.res

................................................................................
!if $(DEBUG)
ldebug	= -debug:full -debugtype:cv
!else
ldebug	= -release -opt:ref -opt:icf,3
!endif

### Declarations common to all linker options
lflags	= -nologo -machine:$(MACHINE) $(ldebug) /verbose:lib

!if $(PROFILE)
lflags	= $(lflags) -profile
!endif

!if $(ALIGN98_HACK) && !$(STATIC_BUILD)
### Align sections for PE size savings.