]>
Commit | Line | Data |
---|---|---|
1 | /* | |
2 | * tkRawTCP.c -- | |
3 | * | |
4 | * This file contains a simple Tcl "connect" command | |
5 | * that returns an standard Tcl File descriptor (as would | |
6 | * be returned by Tcl_OpenCmd). | |
7 | * Extended to create servers, accept connections, shutdown parts of full | |
8 | * duplex connections and handle UNIX domain sockets. | |
9 | * | |
10 | * Author: Pekka Nikander <pnr@innopoli.ajk.tele.fi> | |
11 | * Modified: Tim MacKenzie <tym@dibbler.cs.monash.edu.au) | |
12 | * | |
13 | * Copyright 1992 Telecom Finland | |
14 | * | |
15 | * Permission to use, copy, modify, and distribute this | |
16 | * software and its documentation for any purpose and without | |
17 | * fee is hereby granted, provided that this copyright | |
18 | * notice appears in all copies. Telecom Finland | |
19 | * makes no representations about the suitability of this | |
20 | * software for any purpose. It is provided "as is" without | |
21 | * express or implied warranty. | |
22 | * | |
23 | * Created: Sun Mar 22 18:20:29 1992 | |
24 | * based on: Last modified: Sun Mar 22 21:34:31 1992 pnr | |
25 | * Last modified: Mon Jun 29 15:25:14 EST 1992 tym | |
26 | * | |
27 | */ | |
28 | ||
29 | #ifndef lint | |
30 | static char rcsid[] = "..."; | |
31 | #endif /* not lint */ | |
32 | ||
33 | #include "tclint.h" | |
34 | #include "tclunix.h" | |
35 | ||
36 | #include <assert.h> | |
37 | #include <string.h> | |
38 | #include <sys/types.h> | |
39 | #include <sys/socket.h> | |
40 | #include <netinet/in.h> | |
41 | #include <netdb.h> | |
42 | #include <arpa/inet.h> | |
43 | #include <sys/un.h> | |
44 | ||
45 | #include <tk.h> | |
46 | ||
47 | static int inet_connect _ANSI_ARGS_((char *host, char *port,int server)); | |
48 | static int unix_connect _ANSI_ARGS_((char *path, int server)); | |
49 | static void HandleSocket _ANSI_ARGS_ ((ClientData clientData, int mask)); | |
50 | ||
51 | typedef struct { | |
52 | Tcl_Interp *interp; | |
53 | OpenFile *filePtr; | |
54 | char *tclCmd; | |
55 | char *fileId; | |
56 | } FileCmd; | |
57 | ||
58 | /* | |
59 | *------------------------------------------------------------------ | |
60 | * | |
61 | * Tcp_MakeOpenFile -- | |
62 | * | |
63 | * Set up on OpenFile structure in the interpreter for a newly | |
64 | * opened file | |
65 | * | |
66 | * Results: | |
67 | * none | |
68 | * | |
69 | * Side effects: | |
70 | * Adds an OpenFile to the list. | |
71 | *------------------------------------------------------------------ | |
72 | */ | |
73 | ||
74 | /* ARGSUSED */ | |
75 | void | |
76 | Tcp_MakeOpenFile(interp,fd,r,w) | |
77 | Tcl_Interp *interp; | |
78 | int fd; | |
79 | int r,w; | |
80 | {/* Create an OpenFile structure using f and install it in the interpreter with | |
81 | * Readable and Writable set to r and w | |
82 | */ | |
83 | Interp *iPtr = (Interp *) interp; | |
84 | register OpenFile *filePtr; | |
85 | ||
86 | filePtr = (OpenFile *) ckalloc(sizeof(OpenFile)); | |
87 | ||
88 | filePtr->f = NULL; | |
89 | filePtr->f2 = NULL; | |
90 | ||
91 | /* Open the file with the correct type (doesn't handle !r && !w) */ | |
92 | #ifdef MSDOS | |
93 | filePtr->f = fdopen(fd,(r&&w)?"rb+":(r?"rb":"wb")); | |
94 | #else | |
95 | filePtr->f = fdopen(fd,(r&&w)?"r+":(r?"r":"w")); | |
96 | #endif | |
97 | /* Don't do buffered communication if full-duplex... it breaks! */ | |
98 | if (r&w) setbuf(filePtr->f,0); | |
99 | ||
100 | filePtr->readable = r; | |
101 | filePtr->writable = w; | |
102 | filePtr->numPids = 0; | |
103 | filePtr->pidPtr = NULL; | |
104 | filePtr->errorId = -1; | |
105 | ||
106 | /* | |
107 | * Enter this new OpenFile structure in the table for the | |
108 | * interpreter. May have to expand the table to do this. | |
109 | */ | |
110 | ||
111 | TclMakeFileTable(iPtr, fd); | |
112 | if (iPtr->filePtrArray[fd] != NULL) { | |
113 | panic("Tcl_OpenCmd found file already open"); | |
114 | } | |
115 | iPtr->filePtrArray[fd] = filePtr; | |
116 | } | |
117 | ||
118 | /* | |
119 | *------------------------------------------------------------------ | |
120 | * | |
121 | * Tcp_ConnectCmd -- | |
122 | * | |
123 | * Open a socket connection to a given host and service. | |
124 | * | |
125 | * Results: | |
126 | * A standard Tcl result. | |
127 | * | |
128 | * Side effects: | |
129 | * An open socket connection. | |
130 | * Sets the global variable connect_info(file%d) to the obtained | |
131 | * port when setting up server. | |
132 | *------------------------------------------------------------------ | |
133 | */ | |
134 | ||
135 | /* ARGSUSED */ | |
136 | int | |
137 | Tcp_ConnectCmd(notUsed, interp, argc, argv) | |
138 | ClientData notUsed; | |
139 | Tcl_Interp *interp; | |
140 | int argc; | |
141 | char **argv; | |
142 | { | |
143 | Interp *iPtr = (Interp *) interp; | |
144 | char *host,*port; | |
145 | int fd; | |
146 | int server=0; | |
147 | int unicks = 0; | |
148 | ||
149 | if (argc != 2 && argc != 3 && | |
150 | (argc != 4 || (argc == 4 && strcmp(argv[1],"-server")))) { | |
151 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], | |
152 | "[{-server}] address_spec\"", (char *) NULL); | |
153 | return TCL_ERROR; | |
154 | } | |
155 | ||
156 | if (!strcmp(argv[1],"-server")) | |
157 | server = 1; | |
158 | ||
159 | /* | |
160 | * Create the connection | |
161 | */ | |
162 | if (argc - server == 2) {/* Unix domain socket */ | |
163 | unicks = 1; | |
164 | fd = unix_connect(argv[1+server],server); | |
165 | } else | |
166 | fd = inet_connect(argv[1+server], argv[2+server],server); | |
167 | ||
168 | if (fd < 0) { | |
169 | /* Tell them why it fell apart */ | |
170 | if (unicks) | |
171 | if (server) | |
172 | Tcl_AppendResult(interp, | |
173 | "Couldn't setup listening socket with path \"", | |
174 | argv[1+server],"\" : ",Tcl_UnixError(interp), | |
175 | (char *) NULL); | |
176 | else | |
177 | Tcl_AppendResult(interp, | |
178 | "Couldn't connect to \"",argv[1],"\" : ", | |
179 | Tcl_UnixError(interp),(char *) NULL); | |
180 | else | |
181 | if (server) | |
182 | Tcl_AppendResult(interp, | |
183 | "couldn't setup listening socket on port:", | |
184 | atoi(argv[3])==0?"any":argv[3]," using address \"", | |
185 | strlen(argv[2])?argv[2]:"anywhere.","\": ", | |
186 | Tcl_UnixError(interp), (char *)NULL); | |
187 | else | |
188 | Tcl_AppendResult(interp, "couldn't open connection to \"", | |
189 | argv[1], "\" port \"", argv[2], "\": ", | |
190 | Tcl_UnixError(interp), (char *) NULL); | |
191 | return TCL_ERROR; | |
192 | } | |
193 | ||
194 | sprintf(interp->result, "file%d", fd); | |
195 | if (server && !unicks) { | |
196 | /* Find out what port we got */ | |
197 | char buf[50]; | |
198 | struct sockaddr_in sockaddr; | |
199 | int res,len=sizeof(sockaddr); | |
200 | res =getsockname(fd,(struct sockaddr *) &sockaddr, &len); | |
201 | if (res < 0) { | |
202 | sprintf(buf,"%d",errno); | |
203 | } else | |
204 | sprintf(buf,"%d",(int)ntohs(sockaddr.sin_port)); | |
205 | Tcl_SetVar2(interp,"connect_info",interp->result,buf,TCL_GLOBAL_ONLY); | |
206 | } | |
207 | ||
208 | Tcp_MakeOpenFile(iPtr,fd,1,1-server); | |
209 | ||
210 | return TCL_OK; | |
211 | } | |
212 | ||
213 | /* | |
214 | *------------------------------------------------------------------ | |
215 | * | |
216 | * Tcp_ShutdownCmd -- | |
217 | * | |
218 | * Shutdown a socket for reading writing or both using shutdown(2) | |
219 | * | |
220 | * Results: | |
221 | * standard tcl result. | |
222 | * | |
223 | * Side effects: | |
224 | * Modifies the OpenFile structure appropriately | |
225 | *------------------------------------------------------------------ | |
226 | */ | |
227 | ||
228 | /* ARGSUSED */ | |
229 | int | |
230 | Tcp_ShutdownCmd(notUsed, interp, argc, argv) | |
231 | ClientData notUsed; | |
232 | Tcl_Interp *interp; | |
233 | int argc; | |
234 | char **argv; | |
235 | { | |
236 | Interp *iPtr = (Interp *) interp; | |
237 | OpenFile *filePtr; | |
238 | register FILE *f; | |
239 | int fd; | |
240 | ||
241 | if (argc != 3) { | |
242 | wrong_args: | |
243 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], | |
244 | " fileid <option>\"", (char *) NULL); | |
245 | return TCL_ERROR; | |
246 | } | |
247 | ||
248 | if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) { | |
249 | return TCL_ERROR; | |
250 | } | |
251 | ||
252 | f = filePtr->f; | |
253 | fd = fileno(filePtr->f); | |
254 | if (!strcmp(argv[2],"0") || !strcmp(argv[2],"receives") || | |
255 | !strcmp(argv[2],"read")) { | |
256 | if (!filePtr->readable) { | |
257 | Tcl_AppendResult(interp, "File is not readable",(char *) NULL); | |
258 | return TCL_ERROR; | |
259 | } | |
260 | if (shutdown(fd,0)) { | |
261 | Tcl_AppendResult(interp, "shutdown: ", Tcl_UnixError(interp), | |
262 | (char *) NULL); | |
263 | return TCL_ERROR; | |
264 | } | |
265 | filePtr->readable=0; | |
266 | } else if (!strcmp(argv[2],"1") || !strcmp(argv[2],"sends") || | |
267 | !strcmp(argv[2],"write")) { | |
268 | if (!filePtr->writable) { | |
269 | Tcl_AppendResult(interp, "File is not writable",(char *) NULL); | |
270 | return TCL_ERROR; | |
271 | } | |
272 | if (shutdown(fd,1)) { | |
273 | Tcl_AppendResult(interp, "shutdown: ", Tcl_UnixError(interp), | |
274 | (char *) NULL); | |
275 | return TCL_ERROR; | |
276 | } | |
277 | filePtr->writable=0; | |
278 | } else if (!strcmp(argv[2],"2") || !strcmp(argv[2],"all") || | |
279 | !strcmp(argv[2],"both")) { | |
280 | if (shutdown(fd,2)) { | |
281 | Tcl_AppendResult(interp, "shutdown: ", Tcl_UnixError(interp), | |
282 | (char *) NULL); | |
283 | return TCL_ERROR; | |
284 | } | |
285 | filePtr->writable=0; | |
286 | filePtr->readable=0; | |
287 | } else | |
288 | goto wrong_args; | |
289 | return TCL_OK; | |
290 | } | |
291 | ||
292 | ||
293 | ||
294 | /* | |
295 | *------------------------------------------------------------------ | |
296 | * | |
297 | * Tcp_AcceptCmd -- | |
298 | * | |
299 | * Accept a connection on a listening socket | |
300 | * | |
301 | * Results: | |
302 | * a standard tcl result | |
303 | * | |
304 | * Side effects: | |
305 | * Opens a new file. | |
306 | * Sets the global variable connect_info(file%d) to a list | |
307 | * containing the remote address (host ip, port) of the | |
308 | * connector. | |
309 | *------------------------------------------------------------------ | |
310 | */ | |
311 | ||
312 | /* ARGSUSED */ | |
313 | int | |
314 | Tcp_AcceptCmd(notUsed, interp, argc, argv) | |
315 | ClientData notUsed; | |
316 | Tcl_Interp *interp; | |
317 | int argc; | |
318 | char **argv; | |
319 | { | |
320 | Interp *iPtr = (Interp *) interp; | |
321 | struct sockaddr_in sockaddr; | |
322 | int len = sizeof sockaddr; | |
323 | OpenFile *filePtr; | |
324 | register FILE *f; | |
325 | int fd; | |
326 | ||
327 | if (argc != 2) { | |
328 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], | |
329 | " listening_socket\"", (char *) NULL); | |
330 | return TCL_ERROR; | |
331 | } | |
332 | ||
333 | if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) { | |
334 | return TCL_ERROR; | |
335 | } | |
336 | if (!filePtr->readable) { | |
337 | Tcl_AppendResult(interp, "\"", argv[1], | |
338 | "\" wasn't opened for reading", (char *) NULL); | |
339 | return TCL_ERROR; | |
340 | } | |
341 | ||
342 | f = filePtr->f; | |
343 | fd = fileno(filePtr->f); | |
344 | ||
345 | fd = accept(fd,(struct sockaddr *)&sockaddr,&len); | |
346 | if (fd < 0) { | |
347 | Tcl_AppendResult(interp, "system error in accept()", (char *)NULL); | |
348 | return TCL_ERROR; | |
349 | } | |
350 | ||
351 | {/* Set the global connect_info */ | |
352 | char buf[100]; | |
353 | char nm[10]; | |
354 | if (sockaddr.sin_family == AF_INET) | |
355 | sprintf(buf,"%s %d",inet_ntoa(sockaddr.sin_addr), | |
356 | ntohs(sockaddr.sin_port)); | |
357 | else | |
358 | buf[0]=0; /* Empty string for UNIX domain sockets */ | |
359 | sprintf(nm,"file%d",fd); | |
360 | Tcl_SetVar2(interp,"connect_info",nm,buf,TCL_GLOBAL_ONLY); | |
361 | } | |
362 | ||
363 | /* | |
364 | * Create the FILE* | |
365 | */ | |
366 | Tcp_MakeOpenFile(iPtr,fd,1,1); | |
367 | ||
368 | sprintf(interp->result, "file%d", fd); | |
369 | return TCL_OK; | |
370 | } | |
371 | ||
372 | /* | |
373 | *---------------------------------------------------------------- | |
374 | * | |
375 | * unix_connect -- | |
376 | * | |
377 | * Create a (unix_domain) fd connection using given rendeavous | |
378 | * | |
379 | * Results: | |
380 | * An open fd or -1. | |
381 | * | |
382 | * Side effects: | |
383 | * None. | |
384 | *---------------------------------------------------------------- | |
385 | */ | |
386 | ||
387 | static int | |
388 | unix_connect(path,server) | |
389 | char *path; /* Path name to create or use */ | |
390 | int server; /* 1->make server, 0->connect to server */ | |
391 | { | |
392 | struct sockaddr_un sockaddr; | |
393 | int sock, status; | |
394 | extern int errno; | |
395 | ||
396 | sock = socket(PF_UNIX, SOCK_STREAM, 0); | |
397 | if (sock < 0) { | |
398 | return -1; | |
399 | } | |
400 | ||
401 | sockaddr.sun_family = AF_UNIX; | |
402 | strncpy(sockaddr.sun_path,path,sizeof(sockaddr.sun_path)-1); | |
403 | sockaddr.sun_path[sizeof(sockaddr.sun_path)-1] = 0; /* Just in case */ | |
404 | ||
405 | if (server) | |
406 | status = bind(sock,(struct sockaddr *) &sockaddr, sizeof(sockaddr)); | |
407 | else | |
408 | status = connect(sock, (struct sockaddr *) &sockaddr, sizeof(sockaddr)); | |
409 | ||
410 | if (status < 0) { | |
411 | close (sock); | |
412 | return -1; | |
413 | } | |
414 | ||
415 | if (server) { | |
416 | listen(sock,5); | |
417 | return sock; | |
418 | } | |
419 | ||
420 | return sock; | |
421 | } | |
422 | ||
423 | /* | |
424 | *---------------------------------------------------------------- | |
425 | * | |
426 | * inet_connect -- | |
427 | * | |
428 | * Create a (inet domain) fd connection to given host and port. | |
429 | * | |
430 | * Results: | |
431 | * An open fd or -1. | |
432 | * | |
433 | * Side effects: | |
434 | * None. | |
435 | *---------------------------------------------------------------- | |
436 | */ | |
437 | ||
438 | static int | |
439 | inet_connect(host, service,server) | |
440 | char *host; /* Host to connect, name or IP address */ | |
441 | char *service; /* Port to use, service name or port number */ | |
442 | int server; | |
443 | { | |
444 | struct hostent *hostent, _hostent; | |
445 | struct servent *servent, _servent; | |
446 | struct protoent *protoent; | |
447 | struct sockaddr_in sockaddr; | |
448 | int sock, status; | |
449 | int hostaddr, hostaddrPtr[2]; | |
450 | int servport; | |
451 | extern int errno; | |
452 | ||
453 | hostent = gethostbyname(host); | |
454 | if (hostent == NULL) { | |
455 | hostaddr = inet_addr(host); | |
456 | if (hostaddr == -1) { | |
457 | if (server && !strlen(host)) | |
458 | hostaddr = INADDR_ANY; | |
459 | else { | |
460 | errno = EINVAL; | |
461 | return -1; | |
462 | } | |
463 | } | |
464 | _hostent.h_addr_list = (char **)hostaddrPtr; | |
465 | _hostent.h_addr_list[0] = (char *)&hostaddr; | |
466 | _hostent.h_addr_list[1] = NULL; | |
467 | _hostent.h_length = sizeof(hostaddr); | |
468 | _hostent.h_addrtype = AF_INET; | |
469 | hostent = &_hostent; | |
470 | } | |
471 | servent = getservbyname(service, "tcp"); | |
472 | if (servent == NULL) { | |
473 | servport = htons(atoi(service)); | |
474 | if (servport == -1) { | |
475 | errno = EINVAL; | |
476 | return -1; | |
477 | } | |
478 | _servent.s_port = servport; | |
479 | _servent.s_proto = "tcp"; | |
480 | servent = &_servent; | |
481 | } | |
482 | protoent = getprotobyname(servent->s_proto); | |
483 | if (protoent == NULL) { | |
484 | errno = EINVAL; | |
485 | return -1; | |
486 | } | |
487 | ||
488 | sock = socket(PF_INET, SOCK_STREAM, protoent->p_proto); | |
489 | if (sock < 0) { | |
490 | return -1; | |
491 | } | |
492 | ||
493 | sockaddr.sin_family = AF_INET; | |
494 | memcpy((char *)&(sockaddr.sin_addr.s_addr), | |
495 | (char *) hostent->h_addr_list[0], | |
496 | (size_t) hostent->h_length); | |
497 | sockaddr.sin_port = servent->s_port; | |
498 | ||
499 | if (server) | |
500 | status = bind(sock,(struct sockaddr *) &sockaddr, sizeof(sockaddr)); | |
501 | else | |
502 | status = connect(sock, (struct sockaddr *) &sockaddr, sizeof(sockaddr)); | |
503 | ||
504 | if (status < 0) { | |
505 | close (sock); | |
506 | return -1; | |
507 | } | |
508 | ||
509 | if (server) { | |
510 | listen(sock,5); | |
511 | return sock; | |
512 | } | |
513 | ||
514 | return sock; | |
515 | } | |
516 | ||
517 | /* | |
518 | *---------------------------------------------------------------- | |
519 | * | |
520 | * Tcp_FileHandlerCmd -- | |
521 | * | |
522 | * Register a file handler with an open file. If there is | |
523 | * already and existing handler, it will be no longer called. | |
524 | * If no mask and command are given, any existing handler | |
525 | * will be deleted. | |
526 | * | |
527 | * Results: | |
528 | * A standard Tcl result. (Always OK). | |
529 | * | |
530 | * Side effects: | |
531 | * A new file handler is associated with a give TCL open file. | |
532 | * Whenever the file is readable, writeable and/or there is | |
533 | * an expection condition on the file, a user supplied TCL | |
534 | * command is called. | |
535 | * | |
536 | *---------------------------------------------------------------- | |
537 | */ | |
538 | ||
539 | /* ARGSUSED */ | |
540 | int | |
541 | Tcp_FileHandlerCmd(notUsed, interp, argc, argv) | |
542 | ClientData notUsed; | |
543 | Tcl_Interp *interp; | |
544 | int argc; | |
545 | char **argv; | |
546 | { | |
547 | FileCmd *cmdPtr; | |
548 | OpenFile *filePtr; | |
549 | int mask; | |
550 | ||
551 | if (argc != 2 && argc != 4) { | |
552 | Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0], | |
553 | " fileId ?mode command?\"", (char *) NULL); | |
554 | return TCL_ERROR; | |
555 | } | |
556 | ||
557 | if (TclGetOpenFile(interp, argv[1], &filePtr) != TCL_OK) { | |
558 | return TCL_ERROR; | |
559 | } | |
560 | ||
561 | if (argc == 2) { | |
562 | /* | |
563 | * NOTE! Currently the cmdPtr structure will be left | |
564 | * *unfreed* if the file handler is deleted | |
565 | * via this code. Tough. Would need a hash table | |
566 | * or something... | |
567 | */ | |
568 | Tk_DeleteFileHandler(fileno(filePtr->f)); | |
569 | return TCL_OK; | |
570 | } | |
571 | ||
572 | /* | |
573 | * Find out on what situations the user is interested in. | |
574 | * This is not the most elegant or efficient way to do this, | |
575 | * but who cares? (I do, but not much enough :-) | |
576 | */ | |
577 | mask = 0; | |
578 | if (strchr(argv[2], 'r')) { | |
579 | mask |= TK_READABLE; | |
580 | } | |
581 | if (strchr(argv[2], 'w')) { | |
582 | mask |= TK_WRITABLE; | |
583 | } | |
584 | if (strchr(argv[2], 'e')) { | |
585 | mask |= TK_EXCEPTION; | |
586 | } | |
587 | if (mask == 0 || (strlen(argv[2]) != strspn(argv[2], "rwe"))) { | |
588 | Tcl_AppendResult(interp, "bad mask argument \"", argv[2], | |
589 | "\": should be any combination of \"r\", \"w\" and \"e\"", | |
590 | (char *) NULL); | |
591 | fclose(filePtr->f); | |
592 | return TCL_ERROR; | |
593 | } | |
594 | ||
595 | cmdPtr = (FileCmd *)ckalloc(sizeof(FileCmd)); | |
596 | cmdPtr->interp = interp; | |
597 | cmdPtr->filePtr = filePtr; | |
598 | cmdPtr->tclCmd = ckalloc(strlen(argv[3]) + 1); | |
599 | strcpy(cmdPtr->tclCmd, argv[3]); | |
600 | cmdPtr->fileId = ckalloc(strlen(argv[1]) + 1); | |
601 | strcpy(cmdPtr->fileId, argv[1]); | |
602 | ||
603 | /* | |
604 | * NOTE! There may be an earlier file handler. Should do something. | |
605 | */ | |
606 | Tk_CreateFileHandler(fileno(filePtr->f), mask, HandleSocket, | |
607 | (ClientData) cmdPtr); | |
608 | ||
609 | return TCL_OK; | |
610 | } | |
611 | /* | |
612 | *---------------------------------------------------------------- | |
613 | * | |
614 | * HandleSocket -- | |
615 | * | |
616 | * This procedure is called from Tk_DoOneEvent whenever there is | |
617 | * a desired condition on a given open socket. An Tcl command | |
618 | * given by the user is executed to handle the connection. If | |
619 | * and EOF or ERROR condition is noticed, all memory resources | |
620 | * associated with the socket are released and the socket is closed. | |
621 | * | |
622 | * Results: | |
623 | * None. | |
624 | * | |
625 | * Side effects: | |
626 | * The user supplied command can do anything. | |
627 | * | |
628 | *---------------------------------------------------------------- | |
629 | */ | |
630 | ||
631 | static void | |
632 | HandleSocket(clientData, mask) | |
633 | ClientData clientData; | |
634 | int mask; | |
635 | { | |
636 | int result; | |
637 | FileCmd *cmdPtr = (FileCmd *) clientData; | |
638 | OpenFile *filePtr = cmdPtr->filePtr; | |
639 | Tcl_Interp *interp = cmdPtr->interp; | |
640 | OpenFile *dummy; | |
641 | int delete; | |
642 | int fd = fileno(filePtr->f); | |
643 | ||
644 | Tk_Preserve((ClientData)cmdPtr); | |
645 | ||
646 | delete = 0; | |
647 | if (TclGetOpenFile(interp, cmdPtr->fileId, &dummy) != TCL_OK) { | |
648 | /* File is closed! */ | |
649 | Tcl_ResetResult(interp); | |
650 | delete = 1; | |
651 | } else { | |
652 | assert(dummy == cmdPtr->filePtr); | |
653 | ||
654 | if (mask & TK_READABLE) { | |
655 | result = Tcl_VarEval(interp, cmdPtr->tclCmd, " r ", cmdPtr->fileId, | |
656 | (char *) NULL); | |
657 | if (result != TCL_OK) { | |
658 | TkBindError(interp); | |
659 | } | |
660 | } | |
661 | if (mask & TK_WRITABLE) { | |
662 | result = Tcl_VarEval(interp, cmdPtr->tclCmd, " w ", cmdPtr->fileId, | |
663 | (char *) NULL); | |
664 | if (result != TCL_OK) { | |
665 | TkBindError(interp); | |
666 | } | |
667 | } | |
668 | if (mask & TK_EXCEPTION) { | |
669 | result = Tcl_VarEval(interp, cmdPtr->tclCmd, " e ", cmdPtr->fileId, | |
670 | (char *) NULL); | |
671 | if (result != TCL_OK) { | |
672 | TkBindError(interp); | |
673 | } | |
674 | } | |
675 | ||
676 | if (feof(filePtr->f) || ferror(filePtr->f)) { | |
677 | result = Tcl_VarEval(interp, "close ", cmdPtr->fileId, | |
678 | (char *) NULL); | |
679 | if (result != TCL_OK) { | |
680 | TkBindError(interp); | |
681 | } | |
682 | delete = 1; | |
683 | } | |
684 | } | |
685 | ||
686 | Tk_Release((ClientData)cmdPtr); | |
687 | ||
688 | if (delete) { | |
689 | Tk_DeleteFileHandler(fd); | |
690 | Tk_EventuallyFree((ClientData)cmdPtr, (Tk_FreeProc *)free); | |
691 | } | |
692 | } |