Posted to tcl by colin at Tue Nov 01 02:45:06 GMT 2011view raw

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