UDP is a datagram protocol, and the best API for it is a direct event model. Small test script for Udp package ====== lappend auto_path [pwd]/Udp package require Udp puts stderr [info commands ::udp::*] proc moop {args} { puts stderr "Moop: $args" } puts stderr server:[set server [::udp::create 9999 moop]] puts stderr sopts:[fconfigure $server] puts stderr client:[set client [::udp::create]] time {after 1 ::udp::send $client localhost 9999 MOOOOOOOP} 10 vwait forever ====== udp.tcl - critcl udp extension - make with critcl -libdir $PWD -pkg Udp udp.tcl ====== # UDP an extension to provide minimal UDP support to Tcl using direct events for reception package provide Udp 1.0 package require critcl critcl::config outdir . #namespace import critcl::* critcl::ccode { /* UDP client in the internet domain */ #include #include #include #include #include #include #include #include #include #include #include static char errBuf[256]; /* * This structure describes per-instance state * of a udp channel. * */ typedef struct udpState { int sock; /* underlying (tcp) file descriptor */ Tcl_Obj *script; /* script prefix for incoming */ Tcl_Interp *interp; /* interp this was instantiated in */ Tcl_Channel chan; /* 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 or -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 (close(state->sock) < 0) { errorCode = Tcl_GetErrno(); } ckfree((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))) { /*sprintf(errBuf, "%s", "udp - setsockopt"); UDPTRACE("UDP error - setsockopt\n");*/ Tcl_SetObjResult(interp, Tcl_NewStringObj(errBuf, -1)); 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))) { /*sprintf(errBuf, "udp - setsockopt ttl"); UDPTRACE("UDP error - setsockopt\n");*/ Tcl_SetObjResult(interp, Tcl_NewStringObj(errBuf, -1)); 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, /* Channel that detected an event. */ int mask) /* OR'ed combination of TCL_READABLE, * TCL_WRITABLE, or TCL_EXCEPTION: indicates * which events were detected. */ { int n,s; Tcl_Obj *result = Tcl_DuplicateObj(state->script); Tcl_Interp *interp = state->interp; struct sockaddr_in from; socklen_t fromlen; char buf[1024]; //fprintf(stderr, "Notify %p\n", state); 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 { Tcl_ListObjAppendElement(interp, result, Tcl_NewByteArrayObj(buf, n)); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(ntohl(from.sin_addr.s_addr))); Tcl_ListObjAppendElement(interp, result, Tcl_NewIntObj(ntohs(from.sin_port))); } Tcl_EvalObjEx(interp, result, 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. */ { UdpState *state = (UdpState *) instanceData; Tcl_CreateFileHandler(state->sock, mask, (Tcl_FileProc *) udpNotifyChannel, (ClientData) state); } /* *---------------------------------------------------------------------- * * 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::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); state->groupsObj = Tcl_NewListObj(0, NULL); #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; } //fprintf(stderr, "create %p\n", state); if (objc > 1) { /* get port */ state->port = 0; if (udpGetService(interp, Tcl_GetStringFromObj(objv[1], NULL), &state->port) != TCL_OK) { Tcl_Free((char*)state); return TCL_ERROR; } //fprintf(stderr, "PORT:%d %x\n", state->port, state->port); 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); close(state->sock); Tcl_Free((char*)state); return TCL_ERROR; } bcopy((char *)hp->h_addr, (char *)&state->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"); close(state->sock); Tcl_Free((char*)state); return TCL_ERROR; } length = sizeof(addr); bzero(&addr,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); close(state->sock); Tcl_Free((char*)state); return TCL_ERROR; } /* generate events on socket readable */ //fprintf(stderr, "HANDLER %x %x\n", state->addr, state->port); Tcl_CreateFileHandler(state->sock, TCL_READABLE, (Tcl_FileProc *) udpNotifyChannel, (ClientData) state); //fprintf(stderr, "script %p '%s'\n", state->script, Tcl_GetString(state->script)); } 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->chan = chan; Tcl_SetResult(interp, channelName, TCL_VOLATILE); return TCL_OK; } critcl::cproc send {Tcl_Interp* interp char* udp char* destination long port Tcl_Obj* dgram} ok { int n, dglen; char *dgb; Tcl_Channel chan = Tcl_GetChannel(interp, udp, NULL); /* The channel to send on. */ struct sockaddr_in addr; struct hostent *hp; long length; UdpState *state; if (chan == (Tcl_Channel) NULL) { return TCL_ERROR; } state = Tcl_GetChannelInstanceData(chan); //fprintf(stderr, "send 1 %p\n", state); hp = gethostbyname(destination); if (hp==0) { Tcl_AppendResult(interp, "Unknown host \"", destination, "\"", (char *) NULL); return TCL_ERROR; } //fprintf(stderr, "send 2 %p\n", hp); bcopy((char *)hp->h_addr, (char *)&addr.sin_addr, hp->h_length); addr.sin_port = htons(port); addr.sin_family = AF_INET; length=sizeof(struct sockaddr_in); //fprintf(stderr, "send 3 %p\n", hp); dgb = Tcl_GetByteArrayFromObj(dgram, &dglen); //fprintf(stderr, "send 4 %p\n", dgb); n=sendto(state->sock, dgb, dglen, 0, (const struct sockaddr *)&addr, length); //fprintf(stderr, "send 5 %d\n", n); if (n != dglen) { Tcl_AppendResult(interp, "sendto error \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", (char *) NULL); return TCL_ERROR; } //fprintf(stderr, "send 6 %d\n", n); return TCL_OK; } } ====== <> Networking