]> git.zerfleddert.de Git - micropolis/blob - src/tk/tkrawtcp.c
src/sim/makefile: Micropolis build fixes for recent macOS
[micropolis] / src / tk / tkrawtcp.c
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 }
Impressum, Datenschutz