]>
git.zerfleddert.de Git - micropolis/blob - src/tk/tkrawtcp.c
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.
10 * Author: Pekka Nikander <pnr@innopoli.ajk.tele.fi>
11 * Modified: Tim MacKenzie <tym@dibbler.cs.monash.edu.au)
13 * Copyright 1992 Telecom Finland
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.
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
30 static char rcsid
[] = "...";
38 #include <sys/types.h>
39 #include <sys/socket.h>
40 #include <netinet/in.h>
42 #include <arpa/inet.h>
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
));
59 *------------------------------------------------------------------
63 * Set up on OpenFile structure in the interpreter for a newly
70 * Adds an OpenFile to the list.
71 *------------------------------------------------------------------
76 Tcp_MakeOpenFile(interp
,fd
,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
83 Interp
*iPtr
= (Interp
*) interp
;
84 register OpenFile
*filePtr
;
86 filePtr
= (OpenFile
*) ckalloc(sizeof(OpenFile
));
91 /* Open the file with the correct type (doesn't handle !r && !w) */
93 filePtr
->f
= fdopen(fd
,(r
&&w
)?"rb+":(r
?"rb":"wb"));
95 filePtr
->f
= fdopen(fd
,(r
&&w
)?"r+":(r
?"r":"w"));
97 /* Don't do buffered communication if full-duplex... it breaks! */
98 if (r
&w
) setbuf(filePtr
->f
,0);
100 filePtr
->readable
= r
;
101 filePtr
->writable
= w
;
102 filePtr
->numPids
= 0;
103 filePtr
->pidPtr
= NULL
;
104 filePtr
->errorId
= -1;
107 * Enter this new OpenFile structure in the table for the
108 * interpreter. May have to expand the table to do this.
111 TclMakeFileTable(iPtr
, fd
);
112 if (iPtr
->filePtrArray
[fd
] != NULL
) {
113 panic("Tcl_OpenCmd found file already open");
115 iPtr
->filePtrArray
[fd
] = filePtr
;
119 *------------------------------------------------------------------
123 * Open a socket connection to a given host and service.
126 * A standard Tcl result.
129 * An open socket connection.
130 * Sets the global variable connect_info(file%d) to the obtained
131 * port when setting up server.
132 *------------------------------------------------------------------
137 Tcp_ConnectCmd(notUsed
, interp
, argc
, argv
)
143 Interp
*iPtr
= (Interp
*) interp
;
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
);
156 if (!strcmp(argv
[1],"-server"))
160 * Create the connection
162 if (argc
- server
== 2) {/* Unix domain socket */
164 fd
= unix_connect(argv
[1+server
],server
);
166 fd
= inet_connect(argv
[1+server
], argv
[2+server
],server
);
169 /* Tell them why it fell apart */
172 Tcl_AppendResult(interp
,
173 "Couldn't setup listening socket with path \"",
174 argv
[1+server
],"\" : ",Tcl_UnixError(interp
),
177 Tcl_AppendResult(interp
,
178 "Couldn't connect to \"",argv
[1],"\" : ",
179 Tcl_UnixError(interp
),(char *) NULL
);
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
);
188 Tcl_AppendResult(interp
, "couldn't open connection to \"",
189 argv
[1], "\" port \"", argv
[2], "\": ",
190 Tcl_UnixError(interp
), (char *) NULL
);
194 sprintf(interp
->result
, "file%d", fd
);
195 if (server
&& !unicks
) {
196 /* Find out what port we got */
198 struct sockaddr_in sockaddr
;
199 int res
,len
=sizeof(sockaddr
);
200 res
=getsockname(fd
,(struct sockaddr
*) &sockaddr
, &len
);
202 sprintf(buf
,"%d",errno
);
204 sprintf(buf
,"%d",(int)ntohs(sockaddr
.sin_port
));
205 Tcl_SetVar2(interp
,"connect_info",interp
->result
,buf
,TCL_GLOBAL_ONLY
);
208 Tcp_MakeOpenFile(iPtr
,fd
,1,1-server
);
214 *------------------------------------------------------------------
218 * Shutdown a socket for reading writing or both using shutdown(2)
221 * standard tcl result.
224 * Modifies the OpenFile structure appropriately
225 *------------------------------------------------------------------
230 Tcp_ShutdownCmd(notUsed
, interp
, argc
, argv
)
236 Interp
*iPtr
= (Interp
*) interp
;
243 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
244 " fileid <option>\"", (char *) NULL
);
248 if (TclGetOpenFile(interp
, argv
[1], &filePtr
) != TCL_OK
) {
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
);
260 if (shutdown(fd
,0)) {
261 Tcl_AppendResult(interp
, "shutdown: ", Tcl_UnixError(interp
),
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
);
272 if (shutdown(fd
,1)) {
273 Tcl_AppendResult(interp
, "shutdown: ", Tcl_UnixError(interp
),
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
),
295 *------------------------------------------------------------------
299 * Accept a connection on a listening socket
302 * a standard tcl result
306 * Sets the global variable connect_info(file%d) to a list
307 * containing the remote address (host ip, port) of the
309 *------------------------------------------------------------------
314 Tcp_AcceptCmd(notUsed
, interp
, argc
, argv
)
320 Interp
*iPtr
= (Interp
*) interp
;
321 struct sockaddr_in sockaddr
;
322 int len
= sizeof sockaddr
;
328 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
329 " listening_socket\"", (char *) NULL
);
333 if (TclGetOpenFile(interp
, argv
[1], &filePtr
) != TCL_OK
) {
336 if (!filePtr
->readable
) {
337 Tcl_AppendResult(interp
, "\"", argv
[1],
338 "\" wasn't opened for reading", (char *) NULL
);
343 fd
= fileno(filePtr
->f
);
345 fd
= accept(fd
,(struct sockaddr
*)&sockaddr
,&len
);
347 Tcl_AppendResult(interp
, "system error in accept()", (char *)NULL
);
351 {/* Set the global connect_info */
354 if (sockaddr
.sin_family
== AF_INET
)
355 sprintf(buf
,"%s %d",inet_ntoa(sockaddr
.sin_addr
),
356 ntohs(sockaddr
.sin_port
));
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
);
366 Tcp_MakeOpenFile(iPtr
,fd
,1,1);
368 sprintf(interp
->result
, "file%d", fd
);
373 *----------------------------------------------------------------
377 * Create a (unix_domain) fd connection using given rendeavous
384 *----------------------------------------------------------------
388 unix_connect(path
,server
)
389 char *path
; /* Path name to create or use */
390 int server
; /* 1->make server, 0->connect to server */
392 struct sockaddr_un sockaddr
;
396 sock
= socket(PF_UNIX
, SOCK_STREAM
, 0);
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 */
406 status
= bind(sock
,(struct sockaddr
*) &sockaddr
, sizeof(sockaddr
));
408 status
= connect(sock
, (struct sockaddr
*) &sockaddr
, sizeof(sockaddr
));
424 *----------------------------------------------------------------
428 * Create a (inet domain) fd connection to given host and port.
435 *----------------------------------------------------------------
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 */
444 struct hostent
*hostent
, _hostent
;
445 struct servent
*servent
, _servent
;
446 struct protoent
*protoent
;
447 struct sockaddr_in sockaddr
;
449 int hostaddr
, hostaddrPtr
[2];
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
;
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
;
471 servent
= getservbyname(service
, "tcp");
472 if (servent
== NULL
) {
473 servport
= htons(atoi(service
));
474 if (servport
== -1) {
478 _servent
.s_port
= servport
;
479 _servent
.s_proto
= "tcp";
482 protoent
= getprotobyname(servent
->s_proto
);
483 if (protoent
== NULL
) {
488 sock
= socket(PF_INET
, SOCK_STREAM
, protoent
->p_proto
);
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
;
500 status
= bind(sock
,(struct sockaddr
*) &sockaddr
, sizeof(sockaddr
));
502 status
= connect(sock
, (struct sockaddr
*) &sockaddr
, sizeof(sockaddr
));
518 *----------------------------------------------------------------
520 * Tcp_FileHandlerCmd --
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
528 * A standard Tcl result. (Always OK).
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
536 *----------------------------------------------------------------
541 Tcp_FileHandlerCmd(notUsed
, interp
, argc
, argv
)
551 if (argc
!= 2 && argc
!= 4) {
552 Tcl_AppendResult(interp
, "wrong # args: should be \"", argv
[0],
553 " fileId ?mode command?\"", (char *) NULL
);
557 if (TclGetOpenFile(interp
, argv
[1], &filePtr
) != TCL_OK
) {
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
568 Tk_DeleteFileHandler(fileno(filePtr
->f
));
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 :-)
578 if (strchr(argv
[2], 'r')) {
581 if (strchr(argv
[2], 'w')) {
584 if (strchr(argv
[2], 'e')) {
585 mask
|= TK_EXCEPTION
;
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\"",
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]);
604 * NOTE! There may be an earlier file handler. Should do something.
606 Tk_CreateFileHandler(fileno(filePtr
->f
), mask
, HandleSocket
,
607 (ClientData
) cmdPtr
);
612 *----------------------------------------------------------------
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.
626 * The user supplied command can do anything.
628 *----------------------------------------------------------------
632 HandleSocket(clientData
, mask
)
633 ClientData clientData
;
637 FileCmd
*cmdPtr
= (FileCmd
*) clientData
;
638 OpenFile
*filePtr
= cmdPtr
->filePtr
;
639 Tcl_Interp
*interp
= cmdPtr
->interp
;
642 int fd
= fileno(filePtr
->f
);
644 Tk_Preserve((ClientData
)cmdPtr
);
647 if (TclGetOpenFile(interp
, cmdPtr
->fileId
, &dummy
) != TCL_OK
) {
648 /* File is closed! */
649 Tcl_ResetResult(interp
);
652 assert(dummy
== cmdPtr
->filePtr
);
654 if (mask
& TK_READABLE
) {
655 result
= Tcl_VarEval(interp
, cmdPtr
->tclCmd
, " r ", cmdPtr
->fileId
,
657 if (result
!= TCL_OK
) {
661 if (mask
& TK_WRITABLE
) {
662 result
= Tcl_VarEval(interp
, cmdPtr
->tclCmd
, " w ", cmdPtr
->fileId
,
664 if (result
!= TCL_OK
) {
668 if (mask
& TK_EXCEPTION
) {
669 result
= Tcl_VarEval(interp
, cmdPtr
->tclCmd
, " e ", cmdPtr
->fileId
,
671 if (result
!= TCL_OK
) {
676 if (feof(filePtr
->f
) || ferror(filePtr
->f
)) {
677 result
= Tcl_VarEval(interp
, "close ", cmdPtr
->fileId
,
679 if (result
!= TCL_OK
) {
686 Tk_Release((ClientData
)cmdPtr
);
689 Tk_DeleteFileHandler(fd
);
690 Tk_EventuallyFree((ClientData
)cmdPtr
, (Tk_FreeProc
*)free
);