dgram/dgram.c

   1 /*
   2  */
   3 /*
   4  * dgram-socket create <local>                        => <sockid>
   5  * dgram-socket close <sockid>
   6  * dgram-socket transmit <sockid> <data> <remote>
   7  * dgram-socket on-receive <sockid> <script>
   8  *    calls, effectively,  eval <script> [list <data> <remote-addr> <socket>]
   9  */
  10
  11 #include "tables.h"
  12 #include "hbytes.h"
  13
  14 static int sockfail(Tcl_Interp *ip, int fd, const char *m) {
  15   int e;
  16   e= errno;
  17   close(fd);
  18   return posixerr(ip,e,m);
  19 }
  20
  21 int do_dgram_socket_create(ClientData cd, Tcl_Interp *ip,
  22                           SockAddr_Value local, int *result) {
  23   int fd, al, r;
  24   const struct sockaddr *sa;
  25
  26   sa= sockaddr_addr(&local);
  27   al= sockaddr_len(&local);
  28
  29   fd= socket(sa->sa_family, SOCK_DGRAM, 0);
  30   if (fd<0) return posixerr(ip,errno,"socket");
  31   r= bind(fd, sa, al);  if (r) return sockfail(ip,fd,"bind");
  32   r= setnonblock(fd, 1);  if (r) return sockfail(ip,fd,"setnonblock");
  33   *result= fd;
  34   return TCL_OK;
  35 }
  36
  37 /* Arg parsing */
  38
  39 int pat_sockid(Tcl_Interp *ip, Tcl_Obj *o, int *val) {
  40   int rc;
  41
  42   rc= Tcl_ConvertToType(ip,o,&sockid_type);
  43   if (rc) return rc;
  44
  45   *val= o->internalRep.longValue;
  46   return TCL_OK;
  47 }
  48
  49 Tcl_Obj *ret_sockid(Tcl_Interp *ip, int val) {
  50   Tcl_Obj *o;
  51
  52   o= Tcl_NewObj();
  53   Tcl_InvalidateStringRep(o);
  54   o->internalRep.longValue= val;
  55   o->typePtr= &sockid_type;
  56   return o;
  57 }
  58
  59 static void sockid_t_free(Tcl_Obj *o) { }
  60
  61 static void sockid_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
  62   dup->internalRep= src->internalRep;
  63 }
  64
  65 static void sockid_t_ustr(Tcl_Obj *o) {
  66   char buf[100];
  67   int l;
  68
  69   snprintf(buf,sizeof(buf),"dgramsock%d", (int)o->internalRep.longValue);
  70   l= o->length= strlen(buf);
  71   o->bytes= TALLOC(l+1);
  72   strcpy(o->bytes, buf);
  73 }
  74
  75 static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
  76   unsigned long ul;
  77   char *ep, *str;
  78
  79   str= Tcl_GetStringFromObj(o,0);
  80   if (memcmp(str,"dgramsock",9)) return staticerr(ip,"bad dgram socket id");
  81   errno=0; ul=strtoul(str+9,&ep,10);
  82   if (errno || *ep) return staticerr(ip,"bad dgram socket id number");
  83   if (ul > INT_MAX) return staticerr(ip,"out of range dgram socket id");
  84   o->internalRep.longValue= ul;
  85   return TCL_OK;
  86 }
  87
  88 Tcl_ObjType sockid_type = {
  89   "sockid-nearly",
  90   sockid_t_free, sockid_t_dup, sockid_t_ustr, sockid_t_sfa
  91 };