chiark / gitweb /
ulong improved; clock arithmetic hbytes abolished; secnet responder implemented and...
[chiark-tcl.git] / 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  *    if script not supplied, cancel
10  */
11
12 #include "tables.h"
13 #include "hbytes.h"
14
15 typedef struct DgramSocket {
16   int ix, fd, script_llength;
17   Tcl_Interp *ip;
18   Tcl_Obj *script;
19   void *addr_buf, *msg_buf;
20   int addr_buflen, msg_buflen;
21 } DgramSocket;
22
23 static int n_socks;
24 static DgramSocket **socks;
25
26 static int sockfail(Tcl_Interp *ip, int fd, const char *m) {
27   int e;
28   e= errno;
29   close(fd);
30   return posixerr(ip,e,m);
31 }
32
33 int do_dgram_socket_create(ClientData cd, Tcl_Interp *ip,
34                           SockAddr_Value local, DgramSockID *sock_r) {
35   int fd, al, r, sockix;
36   DgramSocket *sock;
37   const struct sockaddr *sa;
38
39   for (sockix=0; sockix<n_socks && socks[sockix]; sockix++);
40   if (sockix>=n_socks) {
41     n_socks += 2;
42     n_socks *= 2;
43     socks= (void*)Tcl_Realloc((void*)socks, n_socks*sizeof(*socks));
44     while (sockix<n_socks) socks[sockix++]=0;
45     sockix--;
46   }
47
48   sa= sockaddr_addr(&local);
49   al= sockaddr_len(&local);
50
51   fd= socket(sa->sa_family, SOCK_DGRAM, 0);
52   if (fd<0) return posixerr(ip,errno,"socket");
53   r= bind(fd, sa, al);  if (r) return sockfail(ip,fd,"bind");
54   r= setnonblock(fd, 1);  if (r) return sockfail(ip,fd,"setnonblock");
55
56   socks[sockix]= sock= TALLOC(sizeof(DgramSocket));
57   sock->fd= fd;
58   sock->ix= sockix;
59   sock->script= 0;
60   sock->addr_buflen= al+1;
61   sock->addr_buf= TALLOC(sock->addr_buflen);
62   sock->msg_buflen= 0;
63   sock->msg_buf= 0;
64
65   *sock_r= sock;
66   return TCL_OK;
67 }
68
69 int do_dgram_socket_transmit(ClientData cd, Tcl_Interp *ip,
70                              DgramSocket *sock, HBytes_Value data,
71                              SockAddr_Value remote) {
72   int l, r;
73
74   r= sendto(sock->fd,
75             hbytes_data(&data), l=hbytes_len(&data),
76             0,
77             sockaddr_addr(&remote), sockaddr_len(&remote));
78   if (r==-1) return posixerr(ip,errno,"sendto");
79   else if (r!=l) return staticerr(ip,"sendto gave wrong answer");
80   return TCL_OK;
81 }
82
83 static void cancel(DgramSocket *sock) {
84   if (sock->script) {
85     Tcl_DeleteFileHandler(sock->fd);
86     Tcl_DecrRefCount(sock->script);
87     sock->script= 0;
88   }
89 }
90
91 static void recv_call(ClientData sock_cd, int mask) {
92   DgramSocket *sock= (void*)sock_cd;
93   Tcl_Interp *ip= sock->ip;
94   int sz, rc, i, peek;
95   HBytes_Value message_val;
96   SockAddr_Value peer_val;
97   Tcl_Obj *args[3], *invoke;
98   struct msghdr mh;
99   struct iovec iov;
100
101   hbytes_empty(&message_val);
102   sockaddr_clear(&peer_val);
103   invoke=0; for (i=0; i<3; i++) args[i]=0;
104
105   mh.msg_iov= &iov;
106   mh.msg_iovlen= 1;
107   mh.msg_control= 0;
108   mh.msg_controllen= 0;
109   mh.msg_flags= 0;
110
111   peek= MSG_PEEK;
112   
113   for (;;) {
114     mh.msg_name= sock->addr_buf;
115     mh.msg_namelen= sock->addr_buflen;
116
117     iov.iov_base= sock->msg_buf;
118     iov.iov_len= sock->msg_buflen;
119
120     sz= recvmsg(sock->fd, &mh, peek);
121     if (sz==-1) { rc=0; goto x_rc; }
122
123     assert(mh.msg_namelen < sock->addr_buflen);
124
125     if (!(mh.msg_flags & MSG_TRUNC)) {
126       if (!peek) break;
127       peek= 0;
128       continue;
129     }
130
131     TFREE(sock->msg_buf);
132     sock->msg_buflen *= 2;
133     sock->msg_buflen += 100;
134     sock->msg_buf= TALLOC(sock->msg_buflen);
135   }
136
137   hbytes_array(&message_val, iov.iov_base, sz);
138   sockaddr_create(&peer_val, mh.msg_name, mh.msg_namelen);
139
140   args[0]= ret_hb(ip, message_val);  hbytes_empty(&message_val);
141   args[1]= ret_sockaddr(ip, peer_val);  sockaddr_clear(&peer_val);
142   args[2]= ret_sockid(ip, sock);
143   for (i=0; i<3; i++) Tcl_IncrRefCount(args[i]);
144
145   invoke= Tcl_DuplicateObj(sock->script);
146   Tcl_IncrRefCount(invoke);
147
148   rc= Tcl_ListObjReplace(ip,invoke,sock->script_llength,0,3,args);
149   for (i=0; i<3; i++) { Tcl_DecrRefCount(args[i]); args[i]= 0; }
150   if (rc) goto x_rc;
151
152   rc= Tcl_EvalObjEx(ip,invoke,TCL_EVAL_GLOBAL|TCL_EVAL_DIRECT);
153
154 x_rc:
155   if (invoke) Tcl_DecrRefCount(invoke);
156
157   if (rc)
158     Tcl_BackgroundError(ip);
159 }
160
161 int do_dgram_socket_on_receive(ClientData cd, Tcl_Interp *ip,
162                                DgramSocket *sock, Tcl_Obj *script) {
163   int rc;
164   
165   if (script) {
166     rc= Tcl_ListObjLength(ip, script, &sock->script_llength);
167     if (rc) return rc;
168   }
169   
170   cancel(sock);
171   if (script) {
172     Tcl_IncrRefCount(script);
173     sock->script= script;
174     sock->ip= ip;
175   }
176   Tcl_CreateFileHandler(sock->fd, TCL_READABLE, recv_call, sock);
177   return TCL_OK;
178 }
179
180 int do_dgram_socket_close(ClientData cd, Tcl_Interp *ip, DgramSocket *sock) {
181   int sockix;
182   cancel(sock);
183   close(sock->fd); /* nothing useful to be done with errors */
184   sockix= sock->ix;
185   TFREE(sock->addr_buf);
186   TFREE(sock->msg_buf);
187   TFREE(sock);
188   socks[sockix]= 0;
189   return TCL_OK;
190 }
191
192 /* Arg parsing */
193
194 int pat_sockid(Tcl_Interp *ip, Tcl_Obj *o, DgramSocket **val) {
195   int rc, sockix;
196   DgramSocket *sock;
197   
198   rc= Tcl_ConvertToType(ip,o,&dgramsockid_type);
199   if (rc) return rc;
200
201   sockix= o->internalRep.longValue;
202   if (sockix >= n_socks || !(sock= socks[sockix]))
203     return staticerr(ip,"dgram socket not open");
204
205   assert(socks[sockix]->ix == sockix);
206
207   *val= sock;
208   return TCL_OK;
209 }
210
211 Tcl_Obj *ret_sockid(Tcl_Interp *ip, DgramSocket *val) {
212   Tcl_Obj *o;
213
214   o= Tcl_NewObj();
215   Tcl_InvalidateStringRep(o);
216   o->internalRep.longValue= val->ix;
217   o->typePtr= &dgramsockid_type;
218   return o;
219 }
220
221 static void sockid_t_free(Tcl_Obj *o) { }
222
223 static void sockid_t_dup(Tcl_Obj *src, Tcl_Obj *dup) {
224   dup->internalRep= src->internalRep;
225   dup->typePtr= &dgramsockid_type;
226 }
227
228 static void sockid_t_ustr(Tcl_Obj *o) {
229   char buf[75];
230
231   snprintf(buf,sizeof(buf), "%d", (int)o->internalRep.longValue);
232   obj_updatestr_vstringls(o,
233                           "dgramsock",9,
234                           buf, strlen(buf),
235                           (char*)0);
236 }
237
238 static int sockid_t_sfa(Tcl_Interp *ip, Tcl_Obj *o) {
239   unsigned long ul;
240   char *ep, *str;
241   
242   str= Tcl_GetStringFromObj(o,0);
243   if (memcmp(str,"dgramsock",9)) return staticerr(ip,"bad dgram socket id");
244   errno=0; ul=strtoul(str+9,&ep,10);
245   if (errno || *ep) return staticerr(ip,"bad dgram socket id number");
246   if (ul > INT_MAX) return staticerr(ip,"out of range dgram socket id");
247
248   objfreeir(o);
249   o->internalRep.longValue= ul;
250   o->typePtr= &dgramsockid_type;
251   return TCL_OK;
252 }
253
254 Tcl_ObjType dgramsockid_type = {
255   "dgramsockid",
256   sockid_t_free, sockid_t_dup, sockid_t_ustr, sockid_t_sfa
257 };