Posted to tcl by colin at Fri Feb 15 12:35:03 GMT 2013view raw

  1. # UDP an extension to provide minimal UDP support to Tcl using direct events for reception
  2. package provide Udp 1.3
  3.  
  4. if {[info commands ::udp::send] ne ""} {
  5. namespace eval ::udp {
  6. proc close {udp} {
  7. chan close $udp
  8. }
  9.  
  10. namespace export -clear *
  11. namespace ensemble create -subcommands {}
  12. }
  13. return
  14. }
  15.  
  16. package require critcl
  17. ::critcl::tsources udp.tcl
  18.  
  19. critcl::ccode {
  20. /* UDP client in the internet domain */
  21. #include <sys/types.h>
  22. #include <sys/socket.h>
  23. #include <netinet/in.h>
  24. #include <arpa/inet.h>
  25. #include <netdb.h>
  26. #include <stdio.h>
  27. #include <stdlib.h>
  28. #include <unistd.h>
  29. #include <string.h>
  30. #include <tcl.h>
  31. #include <errno.h>
  32.  
  33. static char errBuf[256];
  34.  
  35. /*
  36. * This structure describes per-instance state
  37. * of a udp channel.
  38. *
  39. */
  40. typedef struct udpState {
  41. int sock; /* inderlying (tcp) file descriptor */
  42. Tcl_Obj *script; /* script prefix for incoming */
  43. Tcl_Interp *interp; /* interp this was instantiated in */
  44. Tcl_Channel channel; /* associated chan */
  45.  
  46. int addr; /* local bound address */
  47. uint16_t port; /* local bound port */
  48. int multicast; /* indicator set for multicast add */
  49. Tcl_Obj *groupsObj; /* list of the mcast groups */
  50. } UdpState;
  51.  
  52. /* ----------------------------------------------------------------------
  53. *
  54. * LSearch --
  55. *
  56. * Find a string item in a list and return the index of -1.
  57. */
  58.  
  59. static int
  60. LSearch(Tcl_Obj *listObj, const char *group)
  61. {
  62. int objc, n;
  63. Tcl_Obj **objv;
  64. Tcl_ListObjGetElements(NULL, listObj, &objc, &objv);
  65. for (n = 0; n < objc; n++) {
  66. if (strcmp(group, Tcl_GetString(objv[n])) == 0) {
  67. return n;
  68. }
  69. }
  70. return -1;
  71. }
  72.  
  73. /*
  74. * ----------------------------------------------------------------------
  75. *
  76. * UdpMulticast --
  77. *
  78. * Action should be IP_ADD_MEMBERSHIP | IP_DROP_MEMBERSHIP
  79. *
  80. */
  81.  
  82. static int
  83. UdpMulticast(ClientData instanceData, Tcl_Interp *interp,
  84. const char *grp, int action)
  85. {
  86. UdpState *statePtr = (UdpState *)instanceData;
  87. struct ip_mreq mreq;
  88. struct hostent *name;
  89.  
  90. memset(&mreq, 0, sizeof(mreq));
  91.  
  92. mreq.imr_multiaddr.s_addr = inet_addr(grp);
  93. if (mreq.imr_multiaddr.s_addr == -1) {
  94. name = gethostbyname(grp);
  95. if (name == NULL) {
  96. Tcl_SetResult(interp, "invalid group name", TCL_STATIC);
  97. return TCL_ERROR;
  98. }
  99. memcpy(&mreq.imr_multiaddr.s_addr, name->h_addr,
  100. sizeof(mreq.imr_multiaddr));
  101. }
  102. mreq.imr_interface.s_addr = INADDR_ANY;
  103. if (setsockopt(statePtr->sock, IPPROTO_IP, action,
  104. (const char*)&mreq, sizeof(mreq)) < 0) {
  105. Tcl_SetResult(interp, "error changing multicast group", TCL_STATIC);
  106. return TCL_ERROR;
  107. }
  108.  
  109. if (action == IP_ADD_MEMBERSHIP) {
  110. int ndx = LSearch(statePtr->groupsObj, grp);
  111. if (ndx == -1) {
  112. statePtr->multicast++;
  113. Tcl_ListObjAppendElement(interp, statePtr->groupsObj,
  114. Tcl_NewStringObj(grp,-1));
  115. }
  116. } else {
  117. int ndx = LSearch(statePtr->groupsObj, grp);
  118. if (ndx != -1) {
  119. Tcl_Obj *old, *ptr;
  120. int dup = 0;
  121. old = ptr = statePtr->groupsObj;
  122. statePtr->multicast--;
  123. if ((dup = Tcl_IsShared(ptr))) {
  124. ptr = Tcl_DuplicateObj(ptr);
  125. }
  126. Tcl_ListObjReplace(interp, ptr, ndx, 1, 0, NULL);
  127. if (dup) {
  128. statePtr->groupsObj = ptr;
  129. Tcl_IncrRefCount(ptr);
  130. Tcl_DecrRefCount(old);
  131. }
  132. }
  133. }
  134. if (interp != NULL)
  135. Tcl_SetObjResult(interp, statePtr->groupsObj);
  136. return TCL_OK;
  137. }
  138.  
  139. /*
  140. *----------------------------------------------------------------------
  141. *
  142. * udpClose --
  143. *
  144. * This function is invoked by the generic IO level to perform
  145. * channel-type-specific cleanup when a UDP socket based channel is
  146. * closed.
  147. *
  148. * Results:
  149. * 0 if successful, the value of errno if failed.
  150. *
  151. * Side effects:
  152. * Closes the socket of the channel.
  153. *
  154. *----------------------------------------------------------------------
  155. */
  156.  
  157. static int udpClose(
  158. ClientData instanceData, /* The socket to close. */
  159. Tcl_Interp *interp) /* For error reporting - unused. */
  160. {
  161. int objc;
  162. Tcl_Obj **objv;
  163. int errorCode = 0;
  164.  
  165. UdpState *state = (UdpState *) instanceData;
  166.  
  167. /*
  168. * If there are multicast groups added they should be dropped.
  169. */
  170. if (state->groupsObj) {
  171. int n = 0;
  172. Tcl_ListObjGetElements(interp, state->groupsObj, &objc, &objv);
  173. for (n = 0; n < objc; n++) {
  174. UdpMulticast((ClientData)state, interp,
  175. Tcl_GetString(objv[n]), IP_DROP_MEMBERSHIP);
  176. }
  177. Tcl_DecrRefCount(state->groupsObj);
  178. }
  179.  
  180. if (state->script) {
  181. Tcl_DecrRefCount(state->script);
  182. }
  183.  
  184. if (close(state->sock) < 0) {
  185. errorCode = Tcl_GetErrno();
  186. }
  187.  
  188. Tcl_Free((char*)state);
  189. return errorCode;
  190. }
  191.  
  192. /*
  193. *----------------------------------------------------------------------
  194. *
  195. * udpInput --
  196. *
  197. * This function is invoked by the generic IO level to read input from a
  198. * UDP socket based channel. It is meaningless for UDP
  199. *
  200. * Results: EINVAL
  201. *
  202. *----------------------------------------------------------------------
  203. */
  204.  
  205. static int
  206. udpInput(
  207. ClientData instanceData, /* Socket state. */
  208. char *buf, /* Where to store data read. */
  209. int bufSize, /* How much space is available in the buffer? */
  210. int *errorCodePtr) /* Where to store error code. */
  211. {
  212. *errorCodePtr = EINVAL;
  213. return -1;
  214. }
  215.  
  216. /*
  217. *----------------------------------------------------------------------
  218. *
  219. * udpOutput --
  220. *
  221. * This function is invoked by the generic IO level to write output to a
  222. * UDP socket based channel. It is meaningless for UDP.
  223. *
  224. * Results: EINVAL
  225. *
  226. *----------------------------------------------------------------------
  227. */
  228.  
  229. static int
  230. udpOutput(
  231. ClientData instanceData, /* Socket state. */
  232. const char *buf, /* The data buffer. */
  233. int toWrite, /* How many bytes to write? */
  234. int *errorCodePtr) /* Where to store error code. */
  235. {
  236. *errorCodePtr = EINVAL;
  237. return -1;
  238. }
  239.  
  240. /*
  241. *----------------------------------------------------------------------
  242. *
  243. * udpGetOption --
  244. *
  245. * Computes an option value for a UDP socket based channel, or a list of
  246. * all options and their values.
  247. *
  248. * Note: This code is based on code contributed by John Haxby.
  249. *
  250. * Results:
  251. * A standard Tcl result. The value of the specified option or a list of
  252. * all options and their values is returned in the supplied DString. Sets
  253. * Error message if needed.
  254. *
  255. * Side effects:
  256. * None.
  257. *
  258. *----------------------------------------------------------------------
  259. */
  260.  
  261. static int
  262. udpGetOption(ClientData instanceData, Tcl_Interp *interp,
  263. char *optionName, Tcl_DString *optionValue)
  264. {
  265. UdpState *statePtr = (UdpState *)instanceData;
  266. CONST84 char * options[] = { "myport", "mcastgroups", "broadcast", "ttl", NULL};
  267. int r = TCL_OK;
  268.  
  269. if (optionName == NULL) {
  270. Tcl_DString ds;
  271. const char **p;
  272.  
  273. Tcl_DStringInit(&ds);
  274. for (p = options; *p != NULL; p++) {
  275. char op[16];
  276. sprintf(op, "-%s", *p);
  277. Tcl_DStringSetLength(&ds, 0);
  278. udpGetOption(instanceData, interp, op, &ds);
  279. Tcl_DStringAppend(optionValue, " ", 1);
  280. Tcl_DStringAppend(optionValue, op, -1);
  281. Tcl_DStringAppend(optionValue, " ", 1);
  282. Tcl_DStringAppendElement(optionValue, Tcl_DStringValue(&ds));
  283. }
  284.  
  285. } else {
  286.  
  287. Tcl_DString ds, dsInt;
  288. Tcl_DStringInit(&ds);
  289. Tcl_DStringInit(&dsInt);
  290.  
  291. if (!strcmp("-myport", optionName)) {
  292. Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
  293. sprintf(Tcl_DStringValue(&ds), "%u", ntohs(statePtr->port));
  294. } else if (!strcmp("-mcastgroups", optionName)) {
  295.  
  296. int objc, n;
  297. Tcl_Obj **objv;
  298. Tcl_ListObjGetElements(interp, statePtr->groupsObj, &objc, &objv);
  299. for (n = 0; n < objc; n++) {
  300. Tcl_DStringAppendElement(&ds, Tcl_GetString(objv[n]));
  301. }
  302.  
  303. } else if (!strcmp("-broadcast", optionName)) {
  304.  
  305. int tmp = 1;
  306. socklen_t optlen = sizeof(int);
  307. if (getsockopt(statePtr->sock, SOL_SOCKET, SO_BROADCAST,
  308. (char *)&tmp, &optlen)) {
  309. /*UDPTRACE("UDP error - getsockopt\n");*/
  310. Tcl_SetResult(interp, "error in getsockopt", TCL_STATIC);
  311. r = TCL_ERROR;
  312. } else {
  313. Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
  314. sprintf(Tcl_DStringValue(&ds), "%d", tmp);
  315. }
  316.  
  317. } else if (!strcmp("-ttl", optionName)) {
  318. unsigned int tmp = 0;
  319. socklen_t optlen = sizeof(unsigned int);
  320. int cmd = IP_TTL;
  321. if (statePtr->multicast > 0)
  322. cmd = IP_MULTICAST_TTL;
  323. if (getsockopt(statePtr->sock, IPPROTO_IP, cmd,
  324. (char *)&tmp, &optlen)) {
  325. /*UDPTRACE("UDP error - getsockopt");*/
  326. Tcl_SetResult(interp, "error in getsockopt", TCL_STATIC);
  327. r = TCL_ERROR;
  328. } else {
  329. Tcl_DStringSetLength(&ds, TCL_INTEGER_SPACE);
  330. sprintf(Tcl_DStringValue(&ds), "%u", tmp);
  331. }
  332. } else {
  333. CONST84 char **p;
  334. Tcl_DString tmp;
  335. Tcl_DStringInit(&tmp);
  336. for (p = options; *p != NULL; p++)
  337. Tcl_DStringAppendElement(&tmp, *p);
  338. r = Tcl_BadChannelOption(interp, optionName, Tcl_DStringValue(&tmp));
  339. Tcl_DStringFree(&tmp);
  340. }
  341.  
  342. if (r == TCL_OK) {
  343. Tcl_DStringAppend(optionValue, Tcl_DStringValue(&ds), -1);
  344. }
  345. Tcl_DStringFree(&dsInt);
  346. Tcl_DStringFree(&ds);
  347. }
  348.  
  349. return r;
  350. }
  351.  
  352. /*
  353. * ----------------------------------------------------------------------
  354. * udpGetService --
  355. *
  356. * Return the service port number in network byte order from either a
  357. * string representation of the port number or the service name. If the
  358. * service string cannot be converted (ie: a name not present in the
  359. * services database) then set a Tcl error.
  360. * ----------------------------------------------------------------------
  361. */
  362. static int
  363. udpGetService(Tcl_Interp *interp, const char *service,
  364. unsigned short *servicePort)
  365. {
  366. struct servent *sv = NULL;
  367. char *remainder = NULL;
  368. int r = TCL_OK;
  369.  
  370. sv = getservbyname(service, "udp");
  371. if (sv != NULL) {
  372. *servicePort = sv->s_port;
  373. } else {
  374. *servicePort = htons((unsigned short)strtol(service, &remainder, 0));
  375. if (remainder == service) {
  376. Tcl_ResetResult(interp);
  377. Tcl_AppendResult(interp, "invalid service name: \"", service,
  378. "\" could not be converted to a port number",
  379. TCL_STATIC);
  380. r = TCL_ERROR;
  381. }
  382. }
  383. return r;
  384. }
  385.  
  386. /*
  387. * ----------------------------------------------------------------------
  388. * udpSetOption --
  389. *
  390. * Handle channel configuration requests from the generic layer.
  391. *
  392. * ----------------------------------------------------------------------
  393. */
  394. static int
  395. udpSetOption(ClientData instanceData, Tcl_Interp *interp,
  396. char *optionName, char *newValue)
  397. {
  398. UdpState *statePtr = (UdpState *)instanceData;
  399. char * options = "remote mcastadd mcastdrop broadcast ttl";
  400. int r = TCL_OK;
  401.  
  402. if (!strcmp("-mcastadd", optionName)) {
  403. r = UdpMulticast(instanceData, interp,
  404. (const char *)newValue, IP_ADD_MEMBERSHIP);
  405. } else if (!strcmp("-mcastdrop", optionName)) {
  406. r = UdpMulticast(instanceData, interp,
  407. (const char *)newValue, IP_DROP_MEMBERSHIP);
  408. } else if (!strcmp("-broadcast", optionName)) {
  409. int tmp = 1;
  410. r = Tcl_GetInt(interp, newValue, &tmp);
  411. if (r == TCL_OK) {
  412. if (setsockopt(statePtr->sock, SOL_SOCKET, SO_BROADCAST,
  413. (const char *)&tmp, sizeof(int))) {
  414. Tcl_AppendResult(interp,
  415. "setsockopt broadcast \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"",
  416. (char *) NULL);
  417. r = TCL_ERROR;
  418. } else {
  419. Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
  420. }
  421. }
  422. } else if (!strcmp("-ttl", optionName)) {
  423. unsigned int tmp = 0;
  424. int cmd = IP_TTL;
  425. if (statePtr->multicast > 0)
  426. cmd = IP_MULTICAST_TTL;
  427. r = Tcl_GetInt(interp, newValue, &tmp);
  428. if (r == TCL_OK) {
  429. if (setsockopt(statePtr->sock, IPPROTO_IP, cmd,
  430. (const char *)&tmp, sizeof(unsigned int))) {
  431. Tcl_AppendResult(interp,
  432. "setsockopt ttl \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"",
  433. (char *) NULL);
  434. r = TCL_ERROR;
  435. } else {
  436. Tcl_SetObjResult(interp, Tcl_NewIntObj(tmp));
  437. }
  438. }
  439. } else {
  440. r = Tcl_BadChannelOption(interp, optionName, options);
  441. }
  442.  
  443. return r;
  444. }
  445.  
  446. /*
  447. *----------------------------------------------------------------------
  448. *
  449. * udpNotifyChannel --
  450. *
  451. * This procedure is called by a channel driver when a driver detects an
  452. * event on a channel. This procedure is responsible for actually
  453. * handling the event by invoking any channel handler callbacks.
  454. *
  455. * Results:
  456. * None.
  457. *
  458. * Side effects:
  459. * Whatever the channel handler callback procedure does.
  460. *
  461. *----------------------------------------------------------------------
  462. */
  463. void
  464. udpNotifyChannel(UdpState *state, int mask)
  465. {
  466. int n,s, argc;
  467. Tcl_Obj **argv;
  468. Tcl_Obj *result = Tcl_DuplicateObj(state->script);
  469. Tcl_Interp *interp = state->interp;
  470. struct sockaddr_in from;
  471. socklen_t fromlen;
  472. char buf[1024];
  473.  
  474. fromlen = sizeof(struct sockaddr_in);
  475. n = recvfrom(state->sock,buf,1024,0,(struct sockaddr *)&from,&fromlen);
  476.  
  477. if (n < 0) {
  478. /* error in reception - got to report */
  479. Tcl_ListObjAppendElement(interp, result,
  480. Tcl_NewStringObj(Tcl_ErrnoMsg(Tcl_GetErrno()), -1));
  481. } else {
  482. unsigned char addrbuf[sizeof(struct in6_addr)];
  483.  
  484. Tcl_ListObjAppendElement(interp, result, Tcl_NewByteArrayObj(buf, n));
  485. if (inet_ntop(AF_INET, (void*)&from.sin_addr, addrbuf, sizeof(struct in6_addr))) {
  486. Tcl_ListObjAppendElement(interp, result, Tcl_NewStringObj(addrbuf,-1));
  487. } else {
  488. Tcl_ListObjAppendElement(interp, result,
  489. Tcl_NewStringObj(Tcl_ErrnoMsg(Tcl_GetErrno()),-1));
  490. }
  491. Tcl_ListObjAppendElement(interp, result,
  492. Tcl_NewIntObj(ntohs(from.sin_port)));
  493. Tcl_ListObjAppendElement(interp, result,
  494. Tcl_NewStringObj(Tcl_GetChannelName(state->channel),-1));
  495. }
  496.  
  497. Tcl_ListObjGetElements(interp, result, &argc, &argv);
  498. Tcl_EvalObjv(interp, argc, argv, TCL_EVAL_DIRECT|TCL_EVAL_GLOBAL);
  499. }
  500.  
  501. /*
  502. *----------------------------------------------------------------------
  503. *
  504. * udpWatch --
  505. *
  506. * Initialize the notifier to watch the sock from this channel.
  507. *
  508. * Results:
  509. * None.
  510. *
  511. * Side effects:
  512. * Sets up the notifier so that a future event on the channel will be
  513. * seen by Tcl.
  514. *
  515. *----------------------------------------------------------------------
  516. */
  517.  
  518. static void
  519. udpWatch(
  520. ClientData instanceData, /* The socket state. */
  521. int mask) /* Events of interest; an OR-ed combination of
  522. * TCL_READABLE, TCL_WRITABLE and
  523. * TCL_EXCEPTION. */
  524. {}
  525.  
  526. /*
  527. *----------------------------------------------------------------------
  528. *
  529. * udpGetHandle --
  530. *
  531. * Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
  532. * UDP socket based channel.
  533. *
  534. * Results: EINVAL
  535. *
  536. * Side effects:
  537. * None.
  538. *
  539. *----------------------------------------------------------------------
  540. */
  541.  
  542. static int
  543. udpGetHandle(
  544. ClientData instanceData, /* The socket state. */
  545. int direction, /* Not used. */
  546. ClientData *handlePtr) /* Where to store the handle. */
  547. {
  548. UdpState *state = (UdpState *) instanceData;
  549. return state->sock;
  550. }
  551.  
  552. static Tcl_ChannelType udp_chantype = {
  553. "udp", /* Type name. */
  554. NULL, /* Set blocking/nonblocking behaviour. NULL'able */
  555. udpClose, /* Close channel, clean instance data */
  556. udpInput, /* Handle read request */
  557. udpOutput, /* Handle write request */
  558. NULL, /* Move location of access point. NULL'able */
  559. udpSetOption, /* Set options. NULL'able */
  560. udpGetOption, /* Get options. NULL'able */
  561. udpWatch, /* Initialize notifier */
  562. udpGetHandle, /* Get OS handle from the channel. */
  563. };
  564. }
  565.  
  566. namespace eval ::udp {
  567. critcl::cproc send {Tcl_Interp* interp char* udp char* destination long port Tcl_Obj* dgram} ok {
  568. int n, dglen;
  569. char *dgb;
  570. Tcl_Channel chan;
  571. struct sockaddr_in addr;
  572. struct hostent *hp;
  573. UdpState *state;
  574.  
  575. chan = Tcl_GetChannel(interp, udp, NULL); /* The channel to send on. */
  576. if (chan == (Tcl_Channel) NULL) {
  577. return TCL_ERROR;
  578. }
  579. state = Tcl_GetChannelInstanceData(chan);
  580.  
  581. hp = gethostbyname(destination);
  582. if (hp==0) {
  583. Tcl_AppendResult(interp, "Unknown host \"", destination, "\"", (char *) NULL);
  584. return TCL_ERROR;
  585. }
  586.  
  587. memcpy((char *)&addr.sin_addr, (char *)hp->h_addr, hp->h_length);
  588. addr.sin_port = htons(port);
  589. addr.sin_family = AF_INET;
  590.  
  591. dgb = Tcl_GetByteArrayFromObj(dgram, &dglen);
  592. n=sendto(state->sock, dgb, dglen, 0, (const struct sockaddr *)&addr, sizeof(struct sockaddr_in));
  593.  
  594. if (n != dglen) {
  595. Tcl_AppendResult(interp, "sendto error \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", (char *) NULL);
  596. return TCL_ERROR;
  597. }
  598.  
  599. return TCL_OK;
  600. }
  601.  
  602. critcl::ccommand create {clientdata interp objc objv} {
  603. int length;
  604. static int udp_count = 0;
  605. char channelName[24];
  606. struct sockaddr_in addr;
  607. UdpState *state = (UdpState *) Tcl_Alloc((unsigned) sizeof(UdpState));
  608. Tcl_Channel chan;
  609.  
  610. state->interp = interp;
  611. state->sock = socket(AF_INET, SOCK_DGRAM, 0);
  612.  
  613. #if HAVE_FLAG_FD_CLOEXEC
  614. fcntl(state->sock, F_SETFD, FD_CLOEXEC);
  615. #endif
  616.  
  617. if (state->sock < 0) {
  618. Tcl_AppendResult(interp, "Opening udp socket \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", NULL);
  619. Tcl_Free((char*)state);
  620. return TCL_ERROR;
  621. }
  622.  
  623. state->groupsObj = Tcl_NewListObj(0, NULL);
  624. state->script = NULL;
  625.  
  626. if (objc > 1) {
  627. /* get port */
  628. state->port = 0;
  629. if (udpGetService(interp, Tcl_GetStringFromObj(objv[1], NULL), &state->port) != TCL_OK) {
  630. udpClose(state,interp);
  631. return TCL_ERROR;
  632. }
  633.  
  634. if (objc == 4) {
  635. /* set address and script */
  636. const char *host = Tcl_GetStringFromObj(objv[2], NULL);
  637. struct hostent *hp = gethostbyname(host);
  638. if (hp == 0) {
  639. Tcl_AppendResult(interp, "Host unknown \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", NULL);
  640. udpClose(state,interp);
  641. return TCL_ERROR;
  642. }
  643.  
  644. memcpy((char *)&state->addr, (char *)hp->h_addr, hp->h_length);
  645. state->script = Tcl_DuplicateObj(objv[3]); /* record script prefix */
  646. } else if (objc == 3) {
  647. /* set script */
  648. state->addr = INADDR_ANY;
  649. state->script = Tcl_DuplicateObj(objv[2]); /* record script prefix */
  650. } else {
  651. Tcl_WrongNumArgs(interp, 1, objv, "udp create port ?addr? script");
  652. udpClose(state,interp);
  653. return TCL_ERROR;
  654. }
  655.  
  656. length = sizeof(addr);
  657. memset(&addr,0,length);
  658. addr.sin_family=AF_INET;
  659. addr.sin_addr.s_addr=state->addr;
  660. addr.sin_port=state->port;
  661. if (bind(state->sock,(struct sockaddr *)&addr,length)<0) {
  662. Tcl_AppendResult(interp, "Bind \"", Tcl_ErrnoMsg(Tcl_GetErrno()), "\"", (char *) NULL);
  663. udpClose(state,interp);
  664. return TCL_ERROR;
  665. }
  666.  
  667. /* generate events on socket readable */
  668. Tcl_CreateFileHandler(state->sock, TCL_READABLE,
  669. (Tcl_FileProc *) udpNotifyChannel,
  670. (ClientData) state);
  671. }
  672.  
  673. sprintf(channelName, "udp_%d", udp_count++);
  674. chan = Tcl_CreateChannel(&udp_chantype, channelName, (ClientData)state, 0);
  675. if (chan == (Tcl_Channel)NULL) {
  676. close(state->sock);
  677. Tcl_Free((char*)state);
  678. return TCL_ERROR;
  679. }
  680. Tcl_RegisterChannel(interp, chan);
  681. state->channel = chan;
  682.  
  683. Tcl_SetResult(interp, channelName, TCL_VOLATILE);
  684. return TCL_OK;
  685. }
  686. }