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