Return to tkrawtcp.c CVS log

Up to [Micropolis - Activity] / micropolis / src / tk

Annotation of micropolis/src/tk/tkrawtcp.c, revision 1.1

1.1     ! root        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 <[email protected]>
        !            11:  * Modified: Tim MacKenzie <[email protected]) 
        !            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: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.