lappend auto_path [pwd]/Udp

package require Udp

puts stderr [info commands ::udp::*]

proc moop {lport datagram remote port lchan} {
    if {[catch {
        puts stderr "Moop: $lchan:$lport '$datagram' $remote:$port"
    } e eo]} {
        puts stderr "$e ($eo)"
    }
}

puts stderr server:[set server [::udp create 9999 {moop 9999}]]
puts stderr sopts:[fconfigure $server]

puts stderr client:[set client [::udp create]]

set count 0
time {::udp send $client localhost 9999 MOOOOOOOP[incr count]} 10
#close $client

time {after 1 ::udp::send $client localhost 9999 MOOOOOOOP[incr count]} 10

vwait forever

# UDP an extension to provide minimal UDP support to Tcl using direct events for reception
package provide Udp 1.3

if {[info commands ::udp::send] ne ""} {
    namespace eval ::udp {
        proc close {udp} {
            chan close $udp
        }

        namespace export -clear *
        namespace ensemble create -subcommands {}
    }
    return
}

package require critcl
::critcl::tsources udp.tcl

critcl::ccode {
    /* UDP client in the internet domain */
    #include <sys/types.h>
    #include <sys/socket.h>
    #include <netinet/in.h>
    #include <arpa/inet.h>
    #include <netdb.h>
    #include <stdio.h>
    #include <stdlib.h>
    #include <unistd.h>
    #include <string.h>
    #include <tcl.h>
    #include <errno.h>

    static char errBuf[256];

    /*
    * This structure describes per-instance state
    *  of a udp channel.
    *
    */
    typedef struct udpState {
        int sock;                /* inderlying (tcp) file descriptor */
        Tcl_Obj *script;        /* script prefix for incoming */
        Tcl_Interp *interp;        /* interp this was instantiated in */
        Tcl_Channel channel;        /* associated chan */

        int                addr;        /* local bound address */
        uint16_t        port;        /* local bound port */
        int                multicast;        /* indicator set for multicast add */
        Tcl_Obj                *groupsObj;        /* list of the mcast groups */
    } UdpState;

    /* ---------------------------------------------------------------------- 
    *
    * LSearch --
    *
    *         Find a string item in a list and return the index of -1.
    */

    static int
    LSearch(Tcl_Obj *listObj, const char *group)
    {
        int objc, n;
        Tcl_Obj **objv;
        Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
        for (n = 0; n < objc; n++) {
                                    if (strcmp(group, Tcl_GetString(objv[n])) == 0) {
                                        return n;
                                    }
                                }
        return -1;
    }

    /*
    * ----------------------------------------------------------------------
    *
    * 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) {
                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) {
            Tcl_SetResult(interp, "error changing multicast group", TCL_STATIC);
            return TCL_ERROR;
        }

        if (action == IP_ADD_MEMBERSHIP) {
            int ndx = LSearch(statePtr->groupsObj, grp);
            if (ndx == -1) {
                statePtr->multicast++;
                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;
    }

    /*
    *----------------------------------------------------------------------
    *
    * udpClose --
    *
    *        This function is invoked by the generic IO level to perform
    *        channel-type-specific cleanup when a UDP socket based channel is
    *        closed.
    *
    * Results:
    *        0 if successful, the value of errno if failed.
    *
    * Side effects:
    *        Closes the socket of the channel.
    *
    *----------------------------------------------------------------------
    */

    static int udpClose(
                            ClientData instanceData,        /* The socket to close. */
                            Tcl_Interp *interp)                /* For error reporting - unused. */
    {
        int objc;
        Tcl_Obj **objv;
        int errorCode = 0;

        UdpState *state = (UdpState *) instanceData;

        /*
        * If there are multicast groups added they should be dropped.
        */
        if (state->groupsObj) {
            int n = 0;
            Tcl_ListObjGetElements(interp, state->groupsObj, &objc, &objv);
            for (n = 0; n < objc; n++) {
                                        UdpMulticast((ClientData)state, interp, 
                                                     Tcl_GetString(objv[n]), IP_DROP_MEMBERSHIP);
                                    }
            Tcl_DecrRefCount(state->groupsObj);
        }

        if (state->script) {
            Tcl_DecrRefCount(state->script);
        }

        if (close(state->sock) < 0) {
            errorCode = Tcl_GetErrno();
        }

        Tcl_Free((char*)state);
        return errorCode;
    }

    /*
    *----------------------------------------------------------------------
    *
    * udpInput --
    *
    *        This function is invoked by the generic IO level to read input from a
    *        UDP socket based channel.  It is meaningless for UDP
    *
    * Results:        EINVAL
    *
    *----------------------------------------------------------------------
    */

    static int
    udpInput(
                 ClientData instanceData,        /* Socket state. */
                 char *buf,                        /* Where to store data read. */
                 int bufSize,                /* How much space is available in the buffer? */
                 int *errorCodePtr)                /* Where to store error code. */
    {
        *errorCodePtr = EINVAL;
        return -1;
    }

    /*
    *----------------------------------------------------------------------
    *
    * udpOutput --
    *
    *        This function is invoked by the generic IO level to write output to a
    *        UDP socket based channel.  It is meaningless for UDP.
    *
    * Results: EINVAL
    *
    *----------------------------------------------------------------------
    */

    static int
    udpOutput(
                  ClientData instanceData,        /* Socket state. */
                  const char *buf,                /* The data buffer. */
                  int toWrite,                /* How many bytes to write? */
                  int *errorCodePtr)                /* Where to store error code. */
    {
        *errorCodePtr = EINVAL;
        return -1;
    }

    /*
    *----------------------------------------------------------------------
    *
    * udpGetOption --
    *
    *        Computes an option value for a UDP socket based channel, or a list of
    *        all options and their values.
    *
    *        Note: This code is based on code contributed by John Haxby.
    *
    * Results:
    *        A standard Tcl result. The value of the specified option or a list of
    *        all options and their values is returned in the supplied DString. Sets
    *        Error message if needed.
    *
    * Side effects:
    *        None.
    *
    *----------------------------------------------------------------------
    */

    static int
    udpGetOption(ClientData instanceData, Tcl_Interp *interp,
                 char *optionName, Tcl_DString *optionValue)
    {
        UdpState *statePtr = (UdpState *)instanceData;
        CONST84 char * options[] = { "myport", "mcastgroups", "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->port));
            } 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)) {
                    /*UDPTRACE("UDP error - getsockopt\n");*/
                    Tcl_SetResult(interp, "error in getsockopt", TCL_STATIC);
                    r = TCL_ERROR;
                } else {
                    Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
                    sprintf(Tcl_DStringValue(&ds), "%d", 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)) {
                    /*UDPTRACE("UDP error - getsockopt");*/
                    Tcl_SetResult(interp, "error in getsockopt", TCL_STATIC);
                    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;
    }

    /*
    * ----------------------------------------------------------------------
    * udpGetService --
    *
    *  Return the service port number in network byte order from either a
    *  string representation of the port number or the service name. If the
    *  service string cannot be converted (ie: a name not present in the
                                           *  services database) then set a Tcl error.
    * ----------------------------------------------------------------------
    */
    static int
    udpGetService(Tcl_Interp *interp, const char *service,
                  unsigned short *servicePort)
    {
        struct servent *sv = NULL;
        char *remainder = NULL;
        int r = TCL_OK;

        sv = getservbyname(service, "udp");
        if (sv != NULL) {
            *servicePort = sv->s_port;
        } else {
            *servicePort = htons((unsigned short)strtol(service, &remainder, 0));
            if (remainder == service) {
                Tcl_ResetResult(interp);
                Tcl_AppendResult(interp, "invalid service name: \"", service,
                                 "\" could not be converted to a port number",
                                 TCL_STATIC);
                r = TCL_ERROR;
            }
        }
        return r;
    }

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

        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_AppendResult(interp,
                                     "setsockopt broadcast \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"",
                                     (char *) NULL);
                    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_AppendResult(interp,
                                     "setsockopt ttl \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"",
                                     (char *) NULL);
                    r = TCL_ERROR;
                } else {
                    Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
                }
            }
        } else {
            r = Tcl_BadChannelOption(interp, optionName, options);
        }

        return r;
    }

    /*
    *----------------------------------------------------------------------
    *
    * udpNotifyChannel --
    *
    *        This procedure is called by a channel driver when a driver detects an
    *        event on a channel. This procedure is responsible for actually
    *        handling the event by invoking any channel handler callbacks.
    *
    * Results:
    *        None.
    *
    * Side effects:
    *        Whatever the channel handler callback procedure does.
    *
    *----------------------------------------------------------------------
    */
    void
    udpNotifyChannel(UdpState *state, int mask)
    {
        int n,s, argc;
        Tcl_Obj **argv;
        Tcl_Obj *result = Tcl_DuplicateObj(state->script);
        Tcl_Interp *interp = state->interp;
        struct sockaddr_in from;
        socklen_t fromlen;
        char buf[1024];

        fromlen = sizeof(struct sockaddr_in);
        n = recvfrom(state->sock,buf,1024,0,(struct sockaddr *)&from,&fromlen);

        if (n < 0) {
            /* error in reception - got to report */
            Tcl_ListObjAppendElement(interp, result,
                                     Tcl_NewStringObj(Tcl_ErrnoMsg(Tcl_GetErrno()), -1));
        } else {
            unsigned char addrbuf[sizeof(struct in6_addr)];

            Tcl_ListObjAppendElement(interp, result, Tcl_NewByteArrayObj(buf, n));
            if (inet_ntop(AF_INET, (void*)&from.sin_addr, addrbuf, sizeof(struct in6_addr))) {
                Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(addrbuf,-1));
            } else {
                Tcl_ListObjAppendElement(interp, result,
                                         Tcl_NewStringObj(Tcl_ErrnoMsg(Tcl_GetErrno()),-1));
            }
            Tcl_ListObjAppendElement(interp, result,
                                     Tcl_NewIntObj(ntohs(from.sin_port)));
            Tcl_ListObjAppendElement(interp, result,
                                     Tcl_NewStringObj(Tcl_GetChannelName(state->channel),-1));
        }

        Tcl_ListObjGetElements(interp, result, &argc, &argv);
        Tcl_EvalObjv(interp, argc, argv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
    }

    /*
    *----------------------------------------------------------------------
    *
    * udpWatch --
    *
    *        Initialize the notifier to watch the sock from this channel.
    *
    * Results:
    *        None.
    *
    * Side effects:
    *        Sets up the notifier so that a future event on the channel will be
    *        seen by Tcl.
    *
    *----------------------------------------------------------------------
    */

    static void
    udpWatch(
                 ClientData instanceData,        /* The socket state. */
                 int mask)                        /* Events of interest; an OR-ed combination of
                                                * TCL_READABLE, TCL_WRITABLE and
                                                    * TCL_EXCEPTION. */
    {}

    /*
    *----------------------------------------------------------------------
    *
    * udpGetHandle --
    *
    *        Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
    *        UDP socket based channel.
    *
    * Results: EINVAL
    *
    * Side effects:
    *        None.
    *
    *----------------------------------------------------------------------
    */

    static int
    udpGetHandle(
                     ClientData instanceData,        /* The socket state. */
                     int direction,                /* Not used. */
                     ClientData *handlePtr)        /* Where to store the handle. */
    {
        UdpState *state = (UdpState *) instanceData;
        return state->sock;
    }

    static Tcl_ChannelType udp_chantype = {
        "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 */
        udpWatch,              /* Initialize notifier                           */
        udpGetHandle,          /* Get OS handle from the channel.               */
    };
}

namespace eval ::udp {
    critcl::cproc send {Tcl_Interp* interp char* udp char* destination long port Tcl_Obj* dgram} ok {
        int n, dglen;
        char *dgb;
        Tcl_Channel chan;
        struct sockaddr_in addr;
        struct hostent *hp;
        UdpState *state;

        chan = Tcl_GetChannel(interp, udp, NULL);                /* The channel to send on. */
        if (chan == (Tcl_Channel) NULL) {
            return TCL_ERROR;
        }
        state = Tcl_GetChannelInstanceData(chan);

        hp = gethostbyname(destination);
        if (hp==0) {
            Tcl_AppendResult(interp, "Unknown host \"", destination, "\"", (char *) NULL);
            return TCL_ERROR;
        }

        memcpy((char *)&addr.sin_addr, (char *)hp->h_addr, hp->h_length);
        addr.sin_port = htons(port);
        addr.sin_family = AF_INET;

        dgb = Tcl_GetByteArrayFromObj(dgram, &dglen);
        n=sendto(state->sock, dgb, dglen, 0, (const struct sockaddr *)&addr, sizeof(struct sockaddr_in));

        if (n != dglen) {
            Tcl_AppendResult(interp, "sendto error \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", (char *) NULL);
            return TCL_ERROR;
        }

        return TCL_OK;
    }

    critcl::ccommand create {clientdata interp objc objv} {
        int length;
        static int udp_count = 0;
        char channelName[24];
        struct sockaddr_in addr;
        UdpState *state = (UdpState *) Tcl_Alloc((unsigned) sizeof(UdpState));
        Tcl_Channel chan;

        state->interp = interp;
        state->sock = socket(AF_INET, SOCK_DGRAM, 0);

        #if HAVE_FLAG_FD_CLOEXEC
        fcntl(state->sock, F_SETFD, FD_CLOEXEC);
        #endif

        if (state->sock < 0) {
            Tcl_AppendResult(interp, "Opening udp socket \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", NULL);
            Tcl_Free((char*)state);
            return TCL_ERROR;
        }

        state->groupsObj = Tcl_NewListObj(0, NULL);
        state->script = NULL;

        if (objc > 1) {
            /* get port */
            state->port = 0;
            if (udpGetService(interp, Tcl_GetStringFromObj(objv[1], NULL), &state->port) != TCL_OK) {
                udpClose(state,interp);
                return TCL_ERROR;
            }

            if (objc == 4) {
                /* set address and script */
                const char *host = Tcl_GetStringFromObj(objv[2], NULL);
                struct hostent *hp = gethostbyname(host);
                if (hp == 0) {
                    Tcl_AppendResult(interp, "Host unknown \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", NULL);
                    udpClose(state,interp);
                    return TCL_ERROR;
                }

                memcpy((char *)&state->addr, (char *)hp->h_addr, hp->h_length);
                state->script = Tcl_DuplicateObj(objv[3]);        /* record script prefix */
            } else if (objc == 3) {
                /* set script */
                state->addr = INADDR_ANY;
                state->script = Tcl_DuplicateObj(objv[2]);        /* record script prefix */
            } else {
                Tcl_WrongNumArgs(interp, 1, objv, "udp create port ?addr? script");
                udpClose(state,interp);
                return TCL_ERROR;
            }

            length = sizeof(addr);
            memset(&addr,0,length);
            addr.sin_family=AF_INET;
            addr.sin_addr.s_addr=state->addr;
            addr.sin_port=state->port;
            if (bind(state->sock,(struct sockaddr *)&addr,length)<0) {
                Tcl_AppendResult(interp, "Bind \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", (char *) NULL);
                udpClose(state,interp);
                return TCL_ERROR;
            }

            /* generate events on socket readable */
            Tcl_CreateFileHandler(state->sock, TCL_READABLE,
                                  (Tcl_FileProc *) udpNotifyChannel,
                                  (ClientData) state);
        }

        sprintf(channelName, "udp_%d", udp_count++);
        chan = Tcl_CreateChannel(&udp_chantype, channelName, (ClientData)state, 0);
        if (chan == (Tcl_Channel)NULL) {
            close(state->sock);
            Tcl_Free((char*)state);
            return TCL_ERROR;
        }
        Tcl_RegisterChannel(interp, chan);
        state->channel = chan;

        Tcl_SetResult(interp, channelName, TCL_VOLATILE);
        return TCL_OK;
    }
}

# syslog using Udp extension
# Colin McCormack

lappend auto_path [pwd]/Udp
package require Udp
package require TclOO
package provide Syslog 1.0

oo::class create Syslog {
    method timestamp {time} {
        # return a timestamp of $time
        if {![string is integer -strict $time]} {
            set time [clock scan $time -timezone :UTC]
        }
        return [clock format $time -format "%Y-%m-%dT%H:%M:%SZ"]
    }

    method log {message args} {
        variable template
        set props [dict merge $template $args]
        foreach {p script} {
            timestamp {clock seconds}
        } {
            if {![dict exists $props $p]} {
                dict set props $p [eval $script]
            }
        }

        dict with props {
            set timestamp [my timestamp $timestamp]
            if {![string is integer -strict $facility]} {
                variable facilities
                set facility [dict get $facilities $facility]
            }
            if {![string is integer -strict $priority]} {
                variable priorities
                set priority [dict get $priorities $priority]
            }
            set PRI [expr {($facility * 8) + $priority}]
            set line "<$PRI>1 $timestamp $hostname $appname $procid $msgid - $message"
            #puts stderr $line
        }
        variable syslog; variable server; variable port
        ::udp send $syslog $server $port $line
    }

    destructor {
        variable syslog
        catch {chan close $syslog}
    }

    constructor {args} {
        variable facility user
        variable priority debug
        variable hostname [info host]
        variable procid [pid]
        variable appname $::argv0
        variable msgid -
        variable template {}

        variable port 514        ;# syslog's port

        variable {*}$args

        if {![info exists server]} {
            error "must specify Syslog server"
        }

        variable syslog [::udp create]

        foreach v {hostname procid appname msgid facility priority} {
            if {![dict exists $template $v]} {
                dict set template $v [set $v]
            }
        }

        variable facilities
        set i 0
        foreach f {
            kern user mail daemon auth syslog
            lrp news uucp cron authpriv ftp ntp audit alert clock
            local0 local1 local2 local3 local4 local5 local6 local7
        } {
            dict set facilities $f $i
            dict set facilities $i $f
            incr i
        }

        variable priorities
        set i 0
        foreach f {emergency alert critical error warning notice info debug} {
            dict set priorities $f $i
            dict set priorities $i $f
            incr i
        }
    }
}

if {[info exists argv0] && ($argv0 eq [info script])} {
    Syslog create syslog server box
    syslog log "This is a test"
}