cde/programs/dtdocbook/tcl/tclUnixChan.c

   1 /*
   2  * CDE - Common Desktop Environment
   3  *
   4  * Copyright (c) 1993-2012, The Open Group. All rights reserved.
   5  *
   6  * These libraries and programs are free software; you can
   7  * redistribute them and/or modify them under the terms of the GNU
   8  * Lesser General Public License as published by the Free Software
   9  * Foundation; either version 2 of the License, or (at your option)
  10  * any later version.
  11  *
  12  * These libraries and programs are distributed in the hope that
  13  * they will be useful, but WITHOUT ANY WARRANTY; without even the
  14  * implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
  15  * PURPOSE. See the GNU Lesser General Public License for more
  16  * details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with these librararies and programs; if not, write
  20  * to the Free Software Foundation, Inc., 51 Franklin Street, Fifth
  21  * Floor, Boston, MA 02110-1301 USA
  22  */
  23 /* $XConsortium: tclUnixChan.c /main/3 1996/10/03 17:18:13 drk $ */
  24 /*
  25  * tclUnixChan.c
  26  *
  27  *      Common channel driver for Unix channels based on files, command
  28  *      pipes and TCP sockets.
  29  *
  30  * Copyright (c) 1995-1996 Sun Microsystems, Inc.
  31  *
  32  * See the file "license.terms" for information on usage and redistribution
  33  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  34  *
  35  * SCCS: @(#) tclUnixChan.c 1.161 96/04/18 08:28:54
  36  */
  37
  38 #include        "tclInt.h"      /* Internal definitions for Tcl. */
  39 #include        "tclPort.h"     /* Portability features for Tcl. */
  40
  41 /*
  42  * This structure describes per-instance state of a pipe based channel.
  43  */
  44
  45 typedef struct PipeState {
  46     Tcl_File readFile;  /* Output from pipe. */
  47     Tcl_File writeFile; /* Input to pipe. */
  48     Tcl_File errorFile; /* Error output from pipe. */
  49     int numPids;        /* How many processes are attached to this pipe? */
  50     pid_t *pidPtr;      /* The process IDs themselves. Allocated by
  51                          * the creator of the pipe. */
  52 } PipeState;
  53
  54 /*
  55  * This structure describes per-instance state of a tcp based channel.
  56  */
  57
  58 typedef struct TcpState {
  59     int flags;                          /* ORed combination of the
  60                                          * bitfields defined below. */
  61     Tcl_File sock;                      /* The socket itself. */
  62     Tcl_TcpAcceptProc *acceptProc;      /* Proc to call on accept. */
  63     ClientData acceptProcData;          /* The data for the accept proc. */
  64 } TcpState;
  65
  66 /*
  67  * These bits may be ORed together into the "flags" field of a TcpState
  68  * structure.
  69  */
  70
  71 #define TCP_ASYNC_SOCKET        (1<<0)  /* Asynchronous socket. */
  72 #define TCP_ASYNC_CONNECT       (1<<1)  /* Async connect in progress. */
  73
  74 /*
  75  * The following defines how much buffer space the kernel should maintain
  76  * for a socket.
  77  */
  78
  79 #define SOCKET_BUFSIZE  4096
  80
  81 /*
  82  * Static routines for this file:
  83  */
  84
  85 static int              CommonBlockModeProc _ANSI_ARGS_((
  86                             ClientData instanceData, Tcl_File inFile,
  87                             Tcl_File outFile, int mode));
  88 static TcpState *       CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
  89                             int port, char *host, int server,
  90                             char *myaddr, int myport, int async));
  91 static int              CreateSocketAddress _ANSI_ARGS_(
  92                             (struct sockaddr_in *sockaddrPtr,
  93                             char *host, int port));
  94 static int              FileCloseProc _ANSI_ARGS_((ClientData instanceData,
  95                             Tcl_Interp *interp, Tcl_File inFile,
  96                             Tcl_File outFile));
  97 static int              FilePipeInputProc _ANSI_ARGS_((ClientData instanceData,
  98                             Tcl_File inFile, char *buf, int toRead,
  99                             int *errorCode));
 100 static int              FilePipeOutputProc _ANSI_ARGS_((
 101                             ClientData instanceData, Tcl_File outFile,
 102                             char *buf, int toWrite, int *errorCode));
 103 static int              FileSeekProc _ANSI_ARGS_((ClientData instanceData,
 104                             Tcl_File inFile, Tcl_File outFile, long offset,
 105                             int mode, int *errorCode));
 106 static int              PipeCloseProc _ANSI_ARGS_((ClientData instanceData,
 107                             Tcl_Interp *interp, Tcl_File inFile,
 108                             Tcl_File outFile));
 109 static void             TcpAccept _ANSI_ARGS_((ClientData data, int mask));
 110 static int              TcpBlockModeProc _ANSI_ARGS_((ClientData data,
 111                             Tcl_File inFile, Tcl_File outFile, int mode));
 112 static int              TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
 113                             Tcl_Interp *interp, Tcl_File inFile,
 114                             Tcl_File outFile));
 115 static int              TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
 116                             char *optionName, Tcl_DString *dsPtr));
 117 static int              TcpInputProc _ANSI_ARGS_((ClientData instanceData,
 118                             Tcl_File infile, char *buf, int toRead,
 119                             int *errorCode));
 120 static int              TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
 121                             Tcl_File outFile, char *buf, int toWrite,
 122                             int *errorCode));
 123 static int              WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
 124                             Tcl_File fileToWaitFor, int *errorCodePtr));
 125
 126 /*
 127  * This structure describes the channel type structure for file based IO:
 128  */
 129
 130 static Tcl_ChannelType fileChannelType = {
 131     "file",                             /* Type name. */
 132     CommonBlockModeProc,                /* Set blocking/nonblocking mode.*/
 133     FileCloseProc,                      /* Close proc. */
 134     FilePipeInputProc,                  /* Input proc. */
 135     FilePipeOutputProc,                 /* Output proc. */
 136     FileSeekProc,                       /* Seek proc. */
 137     NULL,                               /* Set option proc. */
 138     NULL,                               /* Get option proc. */
 139 };
 140
 141 /*
 142  * This structure describes the channel type structure for command pipe
 143  * based IO:
 144  */
 145
 146 static Tcl_ChannelType pipeChannelType = {
 147     "pipe",                             /* Type name. */
 148     CommonBlockModeProc,                /* Set blocking/nonblocking mode.*/
 149     PipeCloseProc,                      /* Close proc. */
 150     FilePipeInputProc,                  /* Input proc. */
 151     FilePipeOutputProc,                 /* Output proc. */
 152     NULL,                               /* Seek proc. */
 153     NULL,                               /* Set option proc. */
 154     NULL,                               /* Get option proc. */
 155 };
 156
 157 /*
 158  * This structure describes the channel type structure for TCP socket
 159  * based IO:
 160  */
 161
 162 static Tcl_ChannelType tcpChannelType = {
 163     "tcp",                              /* Type name. */
 164     TcpBlockModeProc,                   /* Set blocking/nonblocking mode.*/
 165     TcpCloseProc,                       /* Close proc. */
 166     TcpInputProc,                       /* Input proc. */
 167     TcpOutputProc,                      /* Output proc. */
 168     NULL,                               /* Seek proc. */
 169     NULL,                               /* Set option proc. */
 170     TcpGetOptionProc,                   /* Get option proc. */
 171 };
 172 \f
 173 /*
 174  *----------------------------------------------------------------------
 175  *
 176  * CommonBlockModeProc --
 177  *
 178  *      Helper procedure to set blocking and nonblocking modes on a
 179  *      channel. Invoked either by generic IO level code or by other
 180  *      channel drivers after doing channel-type-specific inialization.
 181  *
 182  * Results:
 183  *      0 if successful, errno when failed.
 184  *
 185  * Side effects:
 186  *      Sets the device into blocking or non-blocking mode.
 187  *
 188  *----------------------------------------------------------------------
 189  */
 190
 191         /* ARGSUSED */
 192 static int
 193 CommonBlockModeProc(instanceData, inFile, outFile, mode)
 194     ClientData instanceData;            /* Unused. */
 195     Tcl_File inFile, outFile;           /* Input, output files for channel. */
 196     int mode;                           /* The mode to set. Can be one of
 197                                          * TCL_MODE_BLOCKING or
 198                                          * TCL_MODE_NONBLOCKING. */
 199 {
 200     int curStatus;
 201     int fd;
 202
 203     if (inFile != NULL) {
 204         fd = (int) Tcl_GetFileInfo(inFile, NULL);
 205         curStatus = fcntl(fd, F_GETFL);
 206         if (mode == TCL_MODE_BLOCKING) {
 207             curStatus &= (~(O_NONBLOCK));
 208         } else {
 209             curStatus |= O_NONBLOCK;
 210         }
 211         if (fcntl(fd, F_SETFL, curStatus) < 0) {
 212             return errno;
 213         }
 214         curStatus = fcntl(fd, F_GETFL);
 215     }
 216     if (outFile != NULL) {
 217         fd = (int) Tcl_GetFileInfo(outFile, NULL);
 218         curStatus = fcntl(fd, F_GETFL);
 219         if (mode == TCL_MODE_BLOCKING) {
 220             curStatus &= (~(O_NONBLOCK));
 221         } else {
 222             curStatus |= O_NONBLOCK;
 223         }
 224         if (fcntl(fd, F_SETFL, curStatus) < 0) {
 225             return errno;
 226         }
 227     }
 228
 229     return 0;
 230 }
 231 \f
 232 /*
 233  *----------------------------------------------------------------------
 234  *
 235  * FilePipeInputProc --
 236  *
 237  *      This procedure is invoked from the generic IO level to read
 238  *      input from a file or command pipeline channel.
 239  *
 240  * Results:
 241  *      The number of bytes read is returned or -1 on error. An output
 242  *      argument contains a POSIX error code if an error occurs, or zero.
 243  *
 244  * Side effects:
 245  *      Reads input from the input device of the channel.
 246  *
 247  *----------------------------------------------------------------------
 248  */
 249
 250         /* ARGSUSED */
 251 static int
 252 FilePipeInputProc(instanceData, inFile, buf, toRead, errorCodePtr)
 253     ClientData instanceData;            /* Unused. */
 254     Tcl_File inFile;                    /* Input device for channel. */
 255     char *buf;                          /* Where to store data read. */
 256     int toRead;                         /* How much space is available
 257                                          * in the buffer? */
 258     int *errorCodePtr;                  /* Where to store error code. */
 259 {
 260     int fd;                             /* The OS handle for reading. */
 261     int bytesRead;                      /* How many bytes were actually
 262                                          * read from the input device? */
 263
 264     *errorCodePtr = 0;
 265     fd = (int) Tcl_GetFileInfo(inFile, NULL);
 266
 267     /*
 268      * Assume there is always enough input available. This will block
 269      * appropriately, and read will unblock as soon as a short read is
 270      * possible, if the channel is in blocking mode. If the channel is
 271      * nonblocking, the read will never block.
 272      */
 273
 274     bytesRead = read(fd, buf, (size_t) toRead);
 275     if (bytesRead > -1) {
 276         return bytesRead;
 277     }
 278     *errorCodePtr = errno;
 279     return -1;
 280 }
 281 \f
 282 /*
 283  *----------------------------------------------------------------------
 284  *
 285  * FilePipeOutputProc--
 286  *
 287  *      This procedure is invoked from the generic IO level to write
 288  *      output to a file or command pipeline channel.
 289  *
 290  * Results:
 291  *      The number of bytes written is returned or -1 on error. An
 292  *      output argument contains a POSIX error code if an error occurred,
 293  *      or zero.
 294  *
 295  * Side effects:
 296  *      Writes output on the output device of the channel.
 297  *
 298  *----------------------------------------------------------------------
 299  */
 300
 301         /* ARGSUSED */
 302 static int
 303 FilePipeOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
 304     ClientData instanceData;            /* Unused. */
 305     Tcl_File outFile;                   /* Output device for channel. */
 306     char *buf;                          /* The data buffer. */
 307     int toWrite;                        /* How many bytes to write? */
 308     int *errorCodePtr;                  /* Where to store error code. */
 309 {
 310     int written;
 311     int fd;
 312
 313     *errorCodePtr = 0;
 314     fd = (int) Tcl_GetFileInfo(outFile, NULL);
 315     written = write(fd, buf, (size_t) toWrite);
 316     if (written > -1) {
 317         return written;
 318     }
 319     *errorCodePtr = errno;
 320     return -1;
 321 }
 322 \f
 323 /*
 324  *----------------------------------------------------------------------
 325  *
 326  * FileCloseProc --
 327  *
 328  *      This procedure is called from the generic IO level to perform
 329  *      channel-type-specific cleanup when a file based channel is closed.
 330  *
 331  * Results:
 332  *      0 if successful, errno if failed.
 333  *
 334  * Side effects:
 335  *      Closes the device of the channel.
 336  *
 337  *----------------------------------------------------------------------
 338  */
 339
 340         /* ARGSUSED */
 341 static int
 342 FileCloseProc(instanceData, interp, inFile, outFile)
 343     ClientData instanceData;    /* Unused. */
 344     Tcl_Interp *interp;         /* For error reporting - unused. */
 345     Tcl_File inFile;            /* Input file to close. */
 346     Tcl_File outFile;           /* Output file to close. */
 347 {
 348     int fd, errorCode = 0;
 349
 350     if (inFile != NULL) {
 351
 352         /*
 353          * Check for read/write file so we only close it once.
 354          */
 355
 356         if (inFile == outFile) {
 357             outFile = NULL;
 358         }
 359         fd = (int) Tcl_GetFileInfo(inFile, NULL);
 360         Tcl_FreeFile(inFile);
 361
 362         if (close(fd) < 0) {
 363             errorCode = errno;
 364         }
 365     }
 366
 367     if (outFile != NULL) {
 368         fd = (int) Tcl_GetFileInfo(outFile, NULL);
 369         Tcl_FreeFile(outFile);
 370         if ((close(fd) < 0) && (errorCode == 0)) {
 371             errorCode = errno;
 372         }
 373     }
 374     return errorCode;
 375 }
 376 \f
 377 /*
 378  *----------------------------------------------------------------------
 379  *
 380  * FileSeekProc --
 381  *
 382  *      This procedure is called by the generic IO level to move the
 383  *      access point in a file based channel.
 384  *
 385  * Results:
 386  *      -1 if failed, the new position if successful. An output
 387  *      argument contains the POSIX error code if an error occurred,
 388  *      or zero.
 389  *
 390  * Side effects:
 391  *      Moves the location at which the channel will be accessed in
 392  *      future operations.
 393  *
 394  *----------------------------------------------------------------------
 395  */
 396
 397         /* ARGSUSED */
 398 static int
 399 FileSeekProc(instanceData, inFile, outFile, offset, mode, errorCodePtr)
 400     ClientData instanceData;                    /* Unused. */
 401     Tcl_File inFile, outFile;                   /* Input and output
 402                                                  * files for channel. */
 403     long offset;                                /* Offset to seek to. */
 404     int mode;                                   /* Relative to where
 405                                                  * should we seek? Can be
 406                                                  * one of SEEK_START,
 407                                                  * SEEK_SET or SEEK_END. */
 408     int *errorCodePtr;                          /* To store error code. */
 409 {
 410     int newLoc;
 411     int fd;
 412
 413     *errorCodePtr = 0;
 414     if (inFile != (Tcl_File) NULL) {
 415         fd = (int) Tcl_GetFileInfo(inFile, NULL);
 416     } else if (outFile != (Tcl_File) NULL) {
 417         fd = (int) Tcl_GetFileInfo(outFile, NULL);
 418     } else {
 419         *errorCodePtr = EFAULT;
 420         return -1;
 421     }
 422     newLoc = lseek(fd, offset, mode);
 423     if (newLoc > -1) {
 424         return newLoc;
 425     }
 426     *errorCodePtr = errno;
 427     return -1;
 428 }
 429 \f
 430 /*
 431  *----------------------------------------------------------------------
 432  *
 433  * TclGetAndDetachPids --
 434  *
 435  *      This procedure is invoked in the generic implementation of a
 436  *      background "exec" (An exec when invoked with a terminating "&")
 437  *      to store a list of the PIDs for processes in a command pipeline
 438  *      in interp->result and to detach the processes.
 439  *
 440  * Results:
 441  *      None.
 442  *
 443  * Side effects:
 444  *      Modifies interp->result. Detaches processes.
 445  *
 446  *----------------------------------------------------------------------
 447  */
 448
 449 void
 450 TclGetAndDetachPids(interp, chan)
 451     Tcl_Interp *interp;
 452     Tcl_Channel chan;
 453 {
 454     PipeState *pipePtr;
 455     Tcl_ChannelType *chanTypePtr;
 456     int i;
 457     char buf[20];
 458
 459     /*
 460      * Punt if the channel is not a command channel.
 461      */
 462
 463     chanTypePtr = Tcl_GetChannelType(chan);
 464     if (chanTypePtr != &pipeChannelType) {
 465         return;
 466     }
 467
 468     pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
 469     for (i = 0; i < pipePtr->numPids; i++) {
 470         sprintf(buf, "%ld", (long)pipePtr->pidPtr[i]);
 471         Tcl_AppendElement(interp, buf);
 472         Tcl_DetachPids(1, &(pipePtr->pidPtr[i]));
 473     }
 474     if (pipePtr->numPids > 0) {
 475         ckfree((char *) pipePtr->pidPtr);
 476         pipePtr->numPids = 0;
 477     }
 478 }
 479 \f
 480 /*
 481  *----------------------------------------------------------------------
 482  *
 483  * PipeCloseProc --
 484  *
 485  *      This procedure is invoked by the generic IO level to perform
 486  *      channel-type-specific cleanup when a command pipeline channel
 487  *      is closed.
 488  *
 489  * Results:
 490  *      0 on success, errno otherwise.
 491  *
 492  * Side effects:
 493  *      Closes the command pipeline channel.
 494  *
 495  *----------------------------------------------------------------------
 496  */
 497
 498         /* ARGSUSED */
 499 static int
 500 PipeCloseProc(instanceData, interp, inFile, outFile)
 501     ClientData instanceData;    /* The pipe to close. */
 502     Tcl_Interp *interp;         /* For error reporting. */
 503     Tcl_File inFile, outFile;   /* Unused. */
 504 {
 505     PipeState *pipePtr;
 506     Tcl_Channel errChan;
 507     int fd, errorCode, result;
 508
 509     errorCode = 0;
 510     pipePtr = (PipeState *) instanceData;
 511     if (pipePtr->readFile != NULL) {
 512         fd = (int) Tcl_GetFileInfo(pipePtr->readFile, NULL);
 513         Tcl_FreeFile(pipePtr->readFile);
 514         if (close(fd) < 0) {
 515             errorCode = errno;
 516         }
 517     }
 518     if (pipePtr->writeFile != NULL) {
 519         fd = (int) Tcl_GetFileInfo(pipePtr->writeFile, NULL);
 520         Tcl_FreeFile(pipePtr->writeFile);
 521         if ((close(fd) < 0) && (errorCode == 0)) {
 522             errorCode = errno;
 523         }
 524     }
 525
 526     /*
 527      * Wrap the error file into a channel and give it to the cleanup
 528      * routine.
 529      */
 530
 531     if (pipePtr->errorFile != NULL) {
 532         errChan = Tcl_CreateChannel(&fileChannelType, "pipeError",
 533                 pipePtr->errorFile, NULL, NULL);
 534     } else {
 535         errChan = NULL;
 536     }
 537     result = TclCleanupChildren(interp, pipePtr->numPids, pipePtr->pidPtr,
 538             errChan);
 539     if (pipePtr->numPids != 0) {
 540         ckfree((char *) pipePtr->pidPtr);
 541     }
 542     ckfree((char *) pipePtr);
 543     if (errorCode == 0) {
 544         return result;
 545     }
 546     return errorCode;
 547 }
 548 \f
 549 /*
 550  *----------------------------------------------------------------------
 551  *
 552  * Tcl_OpenFileChannel --
 553  *
 554  *      Open an file based channel on Unix systems.
 555  *
 556  * Results:
 557  *      The new channel or NULL. If NULL, the output argument
 558  *      errorCodePtr is set to a POSIX error and an error message is
 559  *      left in interp->result if interp is not NULL.
 560  *
 561  * Side effects:
 562  *      May open the channel and may cause creation of a file on the
 563  *      file system.
 564  *
 565  *----------------------------------------------------------------------
 566  */
 567
 568 Tcl_Channel
 569 Tcl_OpenFileChannel(interp, fileName, modeString, permissions)
 570     Tcl_Interp *interp;                 /* Interpreter for error reporting;
 571                                          * can be NULL. */
 572     char *fileName;                     /* Name of file to open. */
 573     char *modeString;                   /* A list of POSIX open modes or
 574                                          * a string such as "rw". */
 575     int permissions;                    /* If the open involves creating a
 576                                          * file, with what modes to create
 577                                          * it? */
 578 {
 579     int fd, seekFlag, mode, channelPermissions;
 580     Tcl_File file;
 581     Tcl_Channel chan;
 582     char *nativeName, channelName[20];
 583     Tcl_DString buffer;
 584
 585     mode = TclGetOpenMode(interp, modeString, &seekFlag);
 586     if (mode == -1) {
 587         return NULL;
 588     }
 589     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
 590         case O_RDONLY:
 591             channelPermissions = TCL_READABLE;
 592             break;
 593         case O_WRONLY:
 594             channelPermissions = TCL_WRITABLE;
 595             break;
 596         case O_RDWR:
 597             channelPermissions = (TCL_READABLE | TCL_WRITABLE);
 598             break;
 599         default:
 600             /*
 601              * This may occurr if modeString was "", for example.
 602              */
 603             panic("Tcl_OpenFileChannel: invalid mode value");
 604             return NULL;
 605     }
 606
 607     nativeName = Tcl_TranslateFileName(interp, fileName, &buffer);
 608     if (nativeName == NULL) {
 609         return NULL;
 610     }
 611     fd = open(nativeName, mode, permissions);
 612
 613     /*
 614      * If nativeName is not NULL, the buffer is valid and we must free
 615      * the storage.
 616      */
 617
 618     Tcl_DStringFree(&buffer);
 619
 620     if (fd < 0) {
 621         if (interp != (Tcl_Interp *) NULL) {
 622             Tcl_AppendResult(interp, "couldn't open \"", fileName, "\": ",
 623                     Tcl_PosixError(interp), (char *) NULL);
 624         }
 625         return NULL;
 626     }
 627
 628     sprintf(channelName, "file%d", fd);
 629     file = Tcl_GetFile((ClientData) fd, TCL_UNIX_FD);
 630
 631     chan = Tcl_CreateChannel(&fileChannelType, channelName,
 632             (channelPermissions & TCL_READABLE) ? file : NULL,
 633             (channelPermissions & TCL_WRITABLE) ? file : NULL,
 634             (ClientData) NULL);
 635
 636     /*
 637      * The channel may not be open now, for example if we tried to
 638      * open a file with permissions that cannot be satisfied.
 639      */
 640
 641     if (chan == (Tcl_Channel) NULL) {
 642         if (interp != (Tcl_Interp *) NULL) {
 643             Tcl_AppendResult(interp, "couldn't create channel \"",
 644                     channelName, "\": ", Tcl_PosixError(interp),
 645                     (char *) NULL);
 646         }
 647         Tcl_FreeFile(file);
 648         close(fd);
 649         return NULL;
 650     }
 651
 652     if (seekFlag) {
 653         if (Tcl_Seek(chan, 0, SEEK_END) < 0) {
 654             if (interp != (Tcl_Interp *) NULL) {
 655                 Tcl_AppendResult(interp, "couldn't seek to end of file on \"",
 656                         channelName, "\": ", Tcl_PosixError(interp),
 657                         (char *) NULL);
 658             }
 659             Tcl_Close(NULL, chan);
 660             return NULL;
 661         }
 662     }
 663     return chan;
 664 }
 665 \f
 666 /*
 667  *----------------------------------------------------------------------
 668  *
 669  * Tcl_MakeFileChannel --
 670  *
 671  *      Makes a Tcl_Channel from an existing OS level file handle.
 672  *
 673  * Results:
 674  *      The Tcl_Channel created around the preexisting OS level file handle.
 675  *
 676  * Side effects:
 677  *      None.
 678  *
 679  *----------------------------------------------------------------------
 680  */
 681
 682 Tcl_Channel
 683 Tcl_MakeFileChannel(inFd, outFd, mode)
 684     ClientData inFd;            /* OS level handle used for input. */
 685     ClientData outFd;           /* OS level handle used for output. */
 686     int mode;                   /* ORed combination of TCL_READABLE and
 687                                  * TCL_WRITABLE to indicate whether inFile
 688                                  * and/or outFile are valid. */
 689 {
 690     Tcl_File inFile, outFile;
 691     char channelName[20];
 692
 693     if (mode == 0) {
 694         return (Tcl_Channel) NULL;
 695     }
 696
 697     inFile = (Tcl_File) NULL;
 698     outFile = (Tcl_File) NULL;
 699
 700     if (mode & TCL_READABLE) {
 701         sprintf(channelName, "file%d", (int) inFd);
 702         inFile = Tcl_GetFile(inFd, TCL_UNIX_FD);
 703     }
 704
 705     if (mode & TCL_WRITABLE) {
 706         sprintf(channelName, "file%d", (int) outFd);
 707         outFile = Tcl_GetFile(outFd, TCL_UNIX_FD);
 708     }
 709
 710     return Tcl_CreateChannel(&fileChannelType, channelName, inFile, outFile,
 711             (ClientData) NULL);
 712 }
 713 \f
 714 /*
 715  *----------------------------------------------------------------------
 716  *
 717  * TclCreateCommandChannel --
 718  *
 719  *      This function is called by the generic IO level to perform
 720  *      the platform specific channel initialization for a command
 721  *      channel.
 722  *
 723  * Results:
 724  *      Returns a new channel or NULL on failure.
 725  *
 726  * Side effects:
 727  *      Allocates a new channel.
 728  *
 729  *----------------------------------------------------------------------
 730  */
 731
 732 Tcl_Channel
 733 TclCreateCommandChannel(readFile, writeFile, errorFile, numPids, pidPtr)
 734     Tcl_File readFile;          /* If non-null, gives the file for reading. */
 735     Tcl_File writeFile;         /* If non-null, gives the file for writing. */
 736     Tcl_File errorFile;         /* If non-null, gives the file where errors
 737                                  * can be read. */
 738     int numPids;                /* The number of pids in the pid array. */
 739     pid_t *pidPtr;              /* An array of process identifiers.
 740                                  * Allocated by the caller, freed when
 741                                  * the channel is closed or the processes
 742                                  * are detached (in a background exec). */
 743 {
 744     Tcl_Channel channel;
 745     char channelName[20];
 746     int channelId;
 747     PipeState *statePtr = (PipeState *) ckalloc((unsigned) sizeof(PipeState));
 748
 749     statePtr->readFile = readFile;
 750     statePtr->writeFile = writeFile;
 751     statePtr->errorFile = errorFile;
 752     statePtr->numPids = numPids;
 753     statePtr->pidPtr = pidPtr;
 754
 755     /*
 756      * Use one of the fds associated with the channel as the
 757      * channel id.
 758      */
 759
 760     if (readFile) {
 761         channelId = (int) Tcl_GetFileInfo(readFile, NULL);
 762     } else if (writeFile) {
 763         channelId = (int) Tcl_GetFileInfo(writeFile, NULL);
 764     } else if (errorFile) {
 765         channelId = (int) Tcl_GetFileInfo(errorFile, NULL);
 766     } else {
 767         channelId = 0;
 768     }
 769
 770     /*
 771      * For backward compatibility with previous versions of Tcl, we
 772      * use "file%d" as the base name for pipes even though it would
 773      * be more natural to use "pipe%d".
 774      */
 775
 776     sprintf(channelName, "file%d", channelId);
 777     channel = Tcl_CreateChannel(&pipeChannelType, channelName, readFile,
 778             writeFile, (ClientData) statePtr);
 779
 780     if (channel == NULL) {
 781
 782         /*
 783          * pidPtr will be freed by the caller if the return value is NULL.
 784          */
 785
 786         ckfree((char *)statePtr);
 787     }
 788     return channel;
 789 }
 790 \f
 791 /*
 792  *----------------------------------------------------------------------
 793  *
 794  * Tcl_PidCmd --
 795  *
 796  *      This procedure is invoked to process the "pid" Tcl command.
 797  *      See the user documentation for details on what it does.
 798  *
 799  * Results:
 800  *      A standard Tcl result.
 801  *
 802  * Side effects:
 803  *      See the user documentation.
 804  *
 805  *----------------------------------------------------------------------
 806  */
 807
 808         /* ARGSUSED */
 809 int
 810 Tcl_PidCmd(dummy, interp, argc, argv)
 811     ClientData dummy;                   /* Not used. */
 812     Tcl_Interp *interp;                 /* Current interpreter. */
 813     int argc;                           /* Number of arguments. */
 814     char **argv;                        /* Argument strings. */
 815 {
 816     Tcl_Channel chan;                   /* The channel to get pids for. */
 817     Tcl_ChannelType *chanTypePtr;       /* The type of that channel. */
 818     PipeState *pipePtr;                 /* The pipe state. */
 819     int i;                              /* Loops over PIDs attached to the
 820                                          * pipe. */
 821     char string[50];                    /* Temp buffer for string rep. of
 822                                          * PIDs attached to the pipe. */
 823
 824     if (argc > 2) {
 825         Tcl_AppendResult(interp, "wrong # args: should be \"",
 826                 argv[0], " ?channelId?\"", (char *) NULL);
 827         return TCL_ERROR;
 828     }
 829     if (argc == 1) {
 830         sprintf(interp->result, "%ld", (long) getpid());
 831     } else {
 832         chan = Tcl_GetChannel(interp, argv[1], NULL);
 833         if (chan == (Tcl_Channel) NULL) {
 834             return TCL_ERROR;
 835         }
 836         chanTypePtr = Tcl_GetChannelType(chan);
 837         if (chanTypePtr != &pipeChannelType) {
 838             return TCL_OK;
 839         }
 840         pipePtr = (PipeState *) Tcl_GetChannelInstanceData(chan);
 841         for (i = 0; i < pipePtr->numPids; i++) {
 842             sprintf(string, "%ld", (long)pipePtr->pidPtr[i]);
 843             Tcl_AppendElement(interp, string);
 844         }
 845     }
 846     return TCL_OK;
 847 }
 848 \f
 849 /*
 850  *----------------------------------------------------------------------
 851  *
 852  * TcpBlockModeProc --
 853  *
 854  *      This procedure is invoked by the generic IO level to set blocking
 855  *      and nonblocking mode on a TCP socket based channel.
 856  *
 857  * Results:
 858  *      0 if successful, errno when failed.
 859  *
 860  * Side effects:
 861  *      Sets the device into blocking or nonblocking mode.
 862  *
 863  *----------------------------------------------------------------------
 864  */
 865
 866         /* ARGSUSED */
 867 static int
 868 TcpBlockModeProc(instanceData, inFile, outFile, mode)
 869     ClientData instanceData;            /* Socket state. */
 870     Tcl_File inFile, outFile;           /* Input, output files for channel. */
 871     int mode;                           /* The mode to set. Can be one of
 872                                          * TCL_MODE_BLOCKING or
 873                                          * TCL_MODE_NONBLOCKING. */
 874 {
 875     TcpState *statePtr;
 876
 877     statePtr = (TcpState *) instanceData;
 878     if (mode == TCL_MODE_BLOCKING) {
 879         statePtr->flags &= (~(TCP_ASYNC_SOCKET));
 880     } else {
 881         statePtr->flags |= TCP_ASYNC_SOCKET;
 882     }
 883     return CommonBlockModeProc(instanceData, inFile, outFile, mode);
 884 }
 885 \f
 886 /*
 887  *----------------------------------------------------------------------
 888  *
 889  * WaitForConnect --
 890  *
 891  *      Waits for a connection on an asynchronously opened socket to
 892  *      be completed.
 893  *
 894  * Results:
 895  *      None.
 896  *
 897  * Side effects:
 898  *      The socket is connected after this function returns.
 899  *
 900  *----------------------------------------------------------------------
 901  */
 902
 903 static int
 904 WaitForConnect(statePtr, fileToWaitFor, errorCodePtr)
 905     TcpState *statePtr;         /* State of the socket. */
 906     Tcl_File fileToWaitFor;     /* File to wait on to become connected. */
 907     int *errorCodePtr;          /* Where to store errors? */
 908 {
 909     int sock;                   /* The socket itself. */
 910     int timeOut;                /* How long to wait. */
 911     int state;                  /* Of calling TclWaitForFile. */
 912     int flags;                  /* fcntl flags for the socket. */
 913
 914     /*
 915      * If an asynchronous connect is in progress, attempt to wait for it
 916      * to complete before reading.
 917      */
 918
 919     if (statePtr->flags & TCP_ASYNC_CONNECT) {
 920         if (statePtr->flags & TCP_ASYNC_SOCKET) {
 921             timeOut = 0;
 922         } else {
 923             timeOut = -1;
 924         }
 925         errno = 0;
 926         state = TclWaitForFile(fileToWaitFor, TCL_WRITABLE | TCL_EXCEPTION,
 927                 timeOut);
 928         if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
 929             sock = (int) Tcl_GetFileInfo(statePtr->sock, NULL);
 930             flags = fcntl(sock, F_GETFL);
 931             flags &= (~(O_NONBLOCK));
 932             (void) fcntl(sock, F_SETFL, flags);
 933         }
 934         if (state & TCL_EXCEPTION) {
 935             return -1;
 936         }
 937         if (state & TCL_WRITABLE) {
 938             statePtr->flags &= (~(TCP_ASYNC_CONNECT));
 939         } else if (timeOut == 0) {
 940             *errorCodePtr = errno = EWOULDBLOCK;
 941             return -1;
 942         }
 943     }
 944     return 0;
 945 }
 946 \f
 947 /*
 948  *----------------------------------------------------------------------
 949  *
 950  * TcpInputProc --
 951  *
 952  *      This procedure is invoked by the generic IO level to read input
 953  *      from a TCP socket based channel.
 954  *
 955  *      NOTE: We cannot share code with FilePipeInputProc because here
 956  *      we must use recv to obtain the input from the channel, not read.
 957  *
 958  * Results:
 959  *      The number of bytes read is returned or -1 on error. An output
 960  *      argument contains the POSIX error code on error, or zero if no
 961  *      error occurred.
 962  *
 963  * Side effects:
 964  *      Reads input from the input device of the channel.
 965  *
 966  *----------------------------------------------------------------------
 967  */
 968
 969         /* ARGSUSED */
 970 static int
 971 TcpInputProc(instanceData, inFile, buf, bufSize, errorCodePtr)
 972     ClientData instanceData;            /* Socket state. */
 973     Tcl_File inFile;                    /* Input device for channel. */
 974     char *buf;                          /* Where to store data read. */
 975     int bufSize;                        /* How much space is available
 976                                          * in the buffer? */
 977     int *errorCodePtr;                  /* Where to store error code. */
 978 {
 979     TcpState *statePtr;                 /* The state of the socket. */
 980     int sock;                           /* The OS handle. */
 981     int bytesRead;                      /* How many bytes were read? */
 982     int state;                          /* Of waiting for connection. */
 983
 984     *errorCodePtr = 0;
 985     sock = (int) Tcl_GetFileInfo(inFile, NULL);
 986     statePtr = (TcpState *) instanceData;
 987
 988     state = WaitForConnect(statePtr, inFile, errorCodePtr);
 989     if (state != 0) {
 990         return -1;
 991     }
 992     bytesRead = recv(sock, buf, bufSize, 0);
 993     if (bytesRead > -1) {
 994         return bytesRead;
 995     }
 996     if (errno == ECONNRESET) {
 997
 998         /*
 999          * Turn ECONNRESET into a soft EOF condition.
1000          */
1001
1002         return 0;
1003     }
1004     *errorCodePtr = errno;
1005     return -1;
1006 }
1007 \f
1008 /*
1009  *----------------------------------------------------------------------
1010  *
1011  * TcpOutputProc --
1012  *
1013  *      This procedure is invoked by the generic IO level to write output
1014  *      to a TCP socket based channel.
1015  *
1016  *      NOTE: We cannot share code with FilePipeOutputProc because here
1017  *      we must use send, not write, to get reliable error reporting.
1018  *
1019  * Results:
1020  *      The number of bytes written is returned. An output argument is
1021  *      set to a POSIX error code if an error occurred, or zero.
1022  *
1023  * Side effects:
1024  *      Writes output on the output device of the channel.
1025  *
1026  *----------------------------------------------------------------------
1027  */
1028
1029 static int
1030 TcpOutputProc(instanceData, outFile, buf, toWrite, errorCodePtr)
1031     ClientData instanceData;            /* Socket state. */
1032     Tcl_File outFile;                   /* Output device for channel. */
1033     char *buf;                          /* The data buffer. */
1034     int toWrite;                        /* How many bytes to write? */
1035     int *errorCodePtr;                  /* Where to store error code. */
1036 {
1037     TcpState *statePtr;
1038     int written;
1039     int sock;                           /* OS level socket. */
1040     int state;                          /* Of waiting for connection. */
1041
1042     *errorCodePtr = 0;
1043     sock = (int) Tcl_GetFileInfo(outFile, NULL);
1044     statePtr = (TcpState *) instanceData;
1045     state = WaitForConnect(statePtr, outFile, errorCodePtr);
1046     if (state != 0) {
1047         return -1;
1048     }
1049     written = send(sock, buf, toWrite, 0);
1050     if (written > -1) {
1051         return written;
1052     }
1053     *errorCodePtr = errno;
1054     return -1;
1055 }
1056 \f
1057 /*
1058  *----------------------------------------------------------------------
1059  *
1060  * TcpCloseProc --
1061  *
1062  *      This procedure is invoked by the generic IO level to perform
1063  *      channel-type-specific cleanup when a TCP socket based channel
1064  *      is closed.
1065  *
1066  * Results:
1067  *      0 if successful, the value of errno if failed.
1068  *
1069  * Side effects:
1070  *      Closes the socket of the channel.
1071  *
1072  *----------------------------------------------------------------------
1073  */
1074
1075         /* ARGSUSED */
1076 static int
1077 TcpCloseProc(instanceData, interp, inFile, outFile)
1078     ClientData instanceData;    /* The socket to close. */
1079     Tcl_Interp *interp;         /* For error reporting - unused. */
1080     Tcl_File inFile, outFile;   /* Unused. */
1081 {
1082     TcpState *statePtr;
1083     Tcl_File sockFile;
1084     int sock;
1085     int errorCode = 0;
1086
1087     statePtr = (TcpState *) instanceData;
1088     sockFile = statePtr->sock;
1089     sock = (int) Tcl_GetFileInfo(sockFile, NULL);
1090
1091     /*
1092      * Delete a file handler that may be active for this socket if this
1093      * is a server socket - the file handler was created automatically
1094      * by Tcl as part of the mechanism to accept new client connections.
1095      * Channel handlers are already deleted in the generic IO channel
1096      * closing code that called this function, so we do not have to
1097      * delete them here.
1098      */
1099
1100     Tcl_DeleteFileHandler(sockFile);
1101
1102     ckfree((char *) statePtr);
1103
1104     /*
1105      * We assume that inFile==outFile==sockFile and so
1106      * we only clean up sockFile.
1107      */
1108
1109     Tcl_FreeFile(sockFile);
1110
1111     if (close(sock) < 0) {
1112         errorCode = errno;
1113     }
1114
1115     return errorCode;
1116 }
1117 \f
1118 /*
1119  *----------------------------------------------------------------------
1120  *
1121  * TcpGetOptionProc --
1122  *
1123  *      Computes an option value for a TCP socket based channel, or a
1124  *      list of all options and their values.
1125  *
1126  *      Note: This code is based on code contributed by John Haxby.
1127  *
1128  * Results:
1129  *      A standard Tcl result. The value of the specified option or a
1130  *      list of all options and their values is returned in the
1131  *      supplied DString.
1132  *
1133  * Side effects:
1134  *      None.
1135  *
1136  *----------------------------------------------------------------------
1137  */
1138
1139 static int
1140 TcpGetOptionProc(instanceData, optionName, dsPtr)
1141     ClientData instanceData;            /* Socket state. */
1142     char *optionName;                   /* Name of the option to
1143                                          * retrieve the value for, or
1144                                          * NULL to get all options and
1145                                          * their values. */
1146     Tcl_DString *dsPtr;                 /* Where to store the computed
1147                                          * value; initialized by caller. */
1148 {
1149     TcpState *statePtr;
1150     struct sockaddr_in sockname;
1151     struct sockaddr_in peername;
1152     struct hostent *hostEntPtr;
1153     int sock;
1154     int size = sizeof(struct sockaddr_in);
1155     size_t len = 0;
1156     char buf[128];
1157
1158     statePtr = (TcpState *) instanceData;
1159     sock = (int) Tcl_GetFileInfo(statePtr->sock, NULL);
1160     if (optionName != (char *) NULL) {
1161         len = strlen(optionName);
1162     }
1163
1164     if ((len == 0) ||
1165             ((len > 1) && (optionName[1] == 'p') &&
1166                     (strncmp(optionName, "-peername", len) == 0))) {
1167         if (getpeername(sock, (struct sockaddr *) &peername, &size) >= 0) {
1168             if (len == 0) {
1169                 Tcl_DStringAppendElement(dsPtr, "-peername");
1170                 Tcl_DStringStartSublist(dsPtr);
1171             }
1172             Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
1173             hostEntPtr = gethostbyaddr((char *) &(peername.sin_addr),
1174                     sizeof(peername.sin_addr), AF_INET);
1175             if (hostEntPtr != (struct hostent *) NULL) {
1176                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
1177             } else {
1178                 Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
1179             }
1180             sprintf(buf, "%d", ntohs(peername.sin_port));
1181             Tcl_DStringAppendElement(dsPtr, buf);
1182             if (len == 0) {
1183                 Tcl_DStringEndSublist(dsPtr);
1184             } else {
1185                 return TCL_OK;
1186             }
1187         }
1188     }
1189
1190     if ((len == 0) ||
1191             ((len > 1) && (optionName[1] == 's') &&
1192                     (strncmp(optionName, "-sockname", len) == 0))) {
1193         if (getsockname(sock, (struct sockaddr *) &sockname, &size) >= 0) {
1194             if (len == 0) {
1195                 Tcl_DStringAppendElement(dsPtr, "-sockname");
1196                 Tcl_DStringStartSublist(dsPtr);
1197             }
1198             Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
1199             hostEntPtr = gethostbyaddr((char *) &(sockname.sin_addr),
1200                     sizeof(peername.sin_addr), AF_INET);
1201             if (hostEntPtr != (struct hostent *) NULL) {
1202                 Tcl_DStringAppendElement(dsPtr, hostEntPtr->h_name);
1203             } else {
1204                 Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
1205             }
1206             sprintf(buf, "%d", ntohs(sockname.sin_port));
1207             Tcl_DStringAppendElement(dsPtr, buf);
1208             if (len == 0) {
1209                 Tcl_DStringEndSublist(dsPtr);
1210             } else {
1211                 return TCL_OK;
1212             }
1213         }
1214     }
1215
1216     if (len > 0) {
1217         Tcl_SetErrno(EINVAL);
1218         return TCL_ERROR;
1219     }
1220
1221     return TCL_OK;
1222 }
1223 \f
1224 /*
1225  *----------------------------------------------------------------------
1226  *
1227  * CreateSocket --
1228  *
1229  *      This function opens a new socket in client or server mode
1230  *      and initializes the TcpState structure.
1231  *
1232  * Results:
1233  *      Returns a new TcpState, or NULL with an error in interp->result,
1234  *      if interp is not NULL.
1235  *
1236  * Side effects:
1237  *      Opens a socket.
1238  *
1239  *----------------------------------------------------------------------
1240  */
1241
1242 static TcpState *
1243 CreateSocket(interp, port, host, server, myaddr, myport, async)
1244     Tcl_Interp *interp;         /* For error reporting; can be NULL. */
1245     int port;                   /* Port number to open. */
1246     char *host;                 /* Name of host on which to open port.
1247                                  * NULL implies INADDR_ANY */
1248     int server;                 /* 1 if socket should be a server socket,
1249                                  * else 0 for a client socket. */
1250     char *myaddr;               /* Optional client-side address */
1251     int myport;                 /* Optional client-side port */
1252     int async;                  /* If nonzero and creating a client socket,
1253                                  * attempt to do an async connect. Otherwise
1254                                  * do a synchronous connect or bind. */
1255 {
1256     int status, sock, asyncConnect, curState, origState;
1257     struct sockaddr_in sockaddr;        /* socket address */
1258     struct sockaddr_in mysockaddr;      /* Socket address for client */
1259     TcpState *statePtr;
1260
1261     sock = -1;
1262     origState = 0;
1263     if (! CreateSocketAddress(&sockaddr, host, port)) {
1264         goto addressError;
1265     }
1266     if ((myaddr != NULL || myport != 0) &&
1267             ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
1268         goto addressError;
1269     }
1270
1271     sock = socket(AF_INET, SOCK_STREAM, 0);
1272     if (sock < 0) {
1273         goto addressError;
1274     }
1275
1276     /*
1277      * Set kernel space buffering
1278      */
1279
1280     TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
1281
1282     asyncConnect = 0;
1283     status = 0;
1284     if (server) {
1285
1286         /*
1287          * Set up to reuse server addresses automatically and bind to the
1288          * specified port.
1289          */
1290
1291         status = 1;
1292         (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
1293                 sizeof(status));
1294         status = bind(sock, (struct sockaddr *) &sockaddr,
1295                 sizeof(struct sockaddr));
1296         if (status != -1) {
1297             status = listen(sock, 5);
1298         }
1299     } else {
1300         if (myaddr != NULL || myport != 0) {
1301             status = 1;
1302             (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
1303                     sizeof(status));
1304             status = bind(sock, (struct sockaddr *) &mysockaddr,
1305                     sizeof(struct sockaddr));
1306             if (status < 0) {
1307                 goto bindError;
1308             }
1309         }
1310
1311         /*
1312          * Attempt to connect. The connect may fail at present with an
1313          * EINPROGRESS but at a later time it will complete. The caller
1314          * will set up a file handler on the socket if she is interested in
1315          * being informed when the connect completes.
1316          */
1317
1318         if (async) {
1319             origState = fcntl(sock, F_GETFL);
1320             curState = origState | O_NONBLOCK;
1321             status = fcntl(sock, F_SETFL, curState);
1322         } else {
1323             status = 0;
1324         }
1325         if (status > -1) {
1326             status = connect(sock, (struct sockaddr *) &sockaddr,
1327                     sizeof(sockaddr));
1328             if (status < 0) {
1329                 if (errno == EINPROGRESS) {
1330                     asyncConnect = 1;
1331                     status = 0;
1332                 }
1333             }
1334         }
1335     }
1336
1337 bindError:
1338     if (status < 0) {
1339         if (interp != NULL) {
1340             Tcl_AppendResult(interp, "couldn't open socket: ",
1341                     Tcl_PosixError(interp), (char *) NULL);
1342         }
1343         if (sock != -1) {
1344             close(sock);
1345         }
1346         return NULL;
1347     }
1348
1349     /*
1350      * Allocate a new TcpState for this socket.
1351      */
1352
1353     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
1354     statePtr->flags = 0;
1355     if (asyncConnect) {
1356         statePtr->flags = TCP_ASYNC_CONNECT;
1357     }
1358     statePtr->sock = Tcl_GetFile((ClientData) sock, TCL_UNIX_FD);
1359
1360     return statePtr;
1361
1362 addressError:
1363     if (sock != -1) {
1364         close(sock);
1365     }
1366     if (interp != NULL) {
1367         Tcl_AppendResult(interp, "couldn't open socket: ",
1368                 Tcl_PosixError(interp), (char *) NULL);
1369     }
1370     return NULL;
1371 }
1372 \f
1373 /*
1374  *----------------------------------------------------------------------
1375  *
1376  * CreateSocketAddress --
1377  *
1378  *      This function initializes a sockaddr structure for a host and port.
1379  *
1380  * Results:
1381  *      1 if the host was valid, 0 if the host could not be converted to
1382  *      an IP address.
1383  *
1384  * Side effects:
1385  *      Fills in the *sockaddrPtr structure.
1386  *
1387  *----------------------------------------------------------------------
1388  */
1389
1390 static int
1391 CreateSocketAddress(sockaddrPtr, host, port)
1392     struct sockaddr_in *sockaddrPtr;    /* Socket address */
1393     char *host;                         /* Host.  NULL implies INADDR_ANY */
1394     int port;                           /* Port number */
1395 {
1396     struct hostent *hostent;            /* Host database entry */
1397     struct in_addr addr;                /* For 64/32 bit madness */
1398
1399     (void) memset((VOID *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
1400     sockaddrPtr->sin_family = AF_INET;
1401     sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
1402     if (host == NULL) {
1403         addr.s_addr = INADDR_ANY;
1404     } else {
1405         addr.s_addr = inet_addr(host);
1406         if (addr.s_addr == (unsigned long) -1) {
1407             hostent = gethostbyname(host);
1408             if (hostent != NULL) {
1409                 memcpy((VOID *) &addr,
1410                         (VOID *) hostent->h_addr_list[0],
1411                         (size_t) hostent->h_length);
1412             } else {
1413 #ifdef  EHOSTUNREACH
1414                 errno = EHOSTUNREACH;
1415 #else
1416 #ifdef ENXIO
1417                 errno = ENXIO;
1418 #endif
1419 #endif
1420                 return 0;       /* error */
1421             }
1422         }
1423     }
1424
1425     /*
1426      * NOTE: On 64 bit machines the assignment below is rumored to not
1427      * do the right thing. Please report errors related to this if you
1428      * observe incorrect behavior on 64 bit machines such as DEC Alphas.
1429      * Should we modify this code to do an explicit memcpy?
1430      */
1431
1432     sockaddrPtr->sin_addr.s_addr = addr.s_addr;
1433     return 1;   /* Success. */
1434 }
1435 \f
1436 /*
1437  *----------------------------------------------------------------------
1438  *
1439  * Tcl_OpenTcpClient --
1440  *
1441  *      Opens a TCP client socket and creates a channel around it.
1442  *
1443  * Results:
1444  *      The channel or NULL if failed.  An error message is returned
1445  *      in the interpreter on failure.
1446  *
1447  * Side effects:
1448  *      Opens a client socket and creates a new channel.
1449  *
1450  *----------------------------------------------------------------------
1451  */
1452
1453 Tcl_Channel
1454 Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
1455     Tcl_Interp *interp;                 /* For error reporting; can be NULL. */
1456     int port;                           /* Port number to open. */
1457     char *host;                         /* Host on which to open port. */
1458     char *myaddr;                       /* Client-side address */
1459     int myport;                         /* Client-side port */
1460     int async;                          /* If nonzero, attempt to do an
1461                                          * asynchronous connect. Otherwise
1462                                          * we do a blocking connect. */
1463 {
1464     Tcl_Channel chan;
1465     TcpState *statePtr;
1466     char channelName[20];
1467
1468     /*
1469      * Create a new client socket and wrap it in a channel.
1470      */
1471
1472     statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
1473     if (statePtr == NULL) {
1474         return NULL;
1475     }
1476
1477     statePtr->acceptProc = NULL;
1478     statePtr->acceptProcData = (ClientData) NULL;
1479
1480     sprintf(channelName, "sock%d",
1481             (int) Tcl_GetFileInfo(statePtr->sock, NULL));
1482
1483     chan = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr->sock,
1484             statePtr->sock, (ClientData) statePtr);
1485     if (Tcl_SetChannelOption(interp, chan, "-translation", "auto crlf") ==
1486             TCL_ERROR) {
1487         Tcl_Close((Tcl_Interp *) NULL, chan);
1488         return NULL;
1489     }
1490     return chan;
1491 }
1492 \f
1493 /*
1494  *----------------------------------------------------------------------
1495  *
1496  * Tcl_MakeTcpClientChannel --
1497  *
1498  *      Creates a Tcl_Channel from an existing client TCP socket.
1499  *
1500  * Results:
1501  *      The Tcl_Channel wrapped around the preexisting TCP socket.
1502  *
1503  * Side effects:
1504  *      None.
1505  *
1506  *----------------------------------------------------------------------
1507  */
1508
1509 Tcl_Channel
1510 Tcl_MakeTcpClientChannel(sock)
1511     ClientData sock;            /* The socket to wrap up into a channel. */
1512 {
1513     TcpState *statePtr;
1514     Tcl_File sockFile;
1515     char channelName[20];
1516     Tcl_Channel chan;
1517
1518     sockFile = Tcl_GetFile(sock, TCL_UNIX_FD);
1519     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
1520     statePtr->sock = sockFile;
1521     statePtr->acceptProc = NULL;
1522     statePtr->acceptProcData = (ClientData) NULL;
1523
1524     sprintf(channelName, "sock%d", (int) sock);
1525
1526     chan = Tcl_CreateChannel(&tcpChannelType, channelName, sockFile, sockFile,
1527             (ClientData) statePtr);
1528     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-translation",
1529             "auto crlf") == TCL_ERROR) {
1530         Tcl_Close((Tcl_Interp *) NULL, chan);
1531         return NULL;
1532     }
1533     return chan;
1534 }
1535 \f
1536 /*
1537  *----------------------------------------------------------------------
1538  *
1539  * Tcl_OpenTcpServer --
1540  *
1541  *      Opens a TCP server socket and creates a channel around it.
1542  *
1543  * Results:
1544  *      The channel or NULL if failed. If an error occurred, an
1545  *      error message is left in interp->result if interp is
1546  *      not NULL.
1547  *
1548  * Side effects:
1549  *      Opens a server socket and creates a new channel.
1550  *
1551  *----------------------------------------------------------------------
1552  */
1553
1554 Tcl_Channel
1555 Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
1556     Tcl_Interp *interp;                 /* For error reporting - may be
1557                                          * NULL. */
1558     int port;                           /* Port number to open. */
1559     char *myHost;                       /* Name of local host. */
1560     Tcl_TcpAcceptProc *acceptProc;      /* Callback for accepting connections
1561                                          * from new clients. */
1562     ClientData acceptProcData;          /* Data for the callback. */
1563 {
1564     Tcl_Channel chan;
1565     TcpState *statePtr;
1566     char channelName[20];
1567
1568     /*
1569      * Create a new client socket and wrap it in a channel.
1570      */
1571
1572     statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
1573     if (statePtr == NULL) {
1574         return NULL;
1575     }
1576
1577     statePtr->acceptProc = acceptProc;
1578     statePtr->acceptProcData = acceptProcData;
1579
1580     /*
1581      * Set up the callback mechanism for accepting connections
1582      * from new clients.
1583      */
1584
1585     Tcl_CreateFileHandler(statePtr->sock, TCL_READABLE, TcpAccept,
1586             (ClientData) statePtr);
1587     sprintf(channelName, "sock%d",
1588             (int) Tcl_GetFileInfo(statePtr->sock, NULL));
1589     chan = Tcl_CreateChannel(&tcpChannelType, channelName, NULL, NULL,
1590             (ClientData) statePtr);
1591     return chan;
1592 }
1593 \f
1594 /*
1595  *----------------------------------------------------------------------
1596  *
1597  * TcpAccept --
1598  *      Accept a TCP socket connection.  This is called by the event loop.
1599  *
1600  * Results:
1601  *      None.
1602  *
1603  * Side effects:
1604  *      Creates a new connection socket. Calls the registered callback
1605  *      for the connection acceptance mechanism.
1606  *
1607  *----------------------------------------------------------------------
1608  */
1609
1610         /* ARGSUSED */
1611 static void
1612 TcpAccept(data, mask)
1613     ClientData data;                    /* Callback token. */
1614     int mask;                           /* Not used. */
1615 {
1616     TcpState *sockState;                /* Client data of server socket. */
1617     int newsock;                        /* The new client socket */
1618     Tcl_File newFile;                   /* Its file. */
1619     TcpState *newSockState;             /* State for new socket. */
1620     struct sockaddr_in addr;            /* The remote address */
1621     int len;                            /* For accept interface */
1622     Tcl_Channel chan;                   /* Channel instance created. */
1623     char channelName[20];
1624
1625     sockState = (TcpState *) data;
1626
1627     len = sizeof(struct sockaddr_in);
1628     newsock = accept((int) Tcl_GetFileInfo(sockState->sock, NULL),
1629             (struct sockaddr *)&addr, &len);
1630     if (newsock < 0) {
1631         return;
1632     }
1633
1634     newFile = Tcl_GetFile((ClientData) newsock, TCL_UNIX_FD);
1635     if (newFile) {
1636         newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
1637
1638         newSockState->flags = 0;
1639         newSockState->sock = newFile;
1640         newSockState->acceptProc = (Tcl_TcpAcceptProc *) NULL;
1641         newSockState->acceptProcData = (ClientData) NULL;
1642
1643         sprintf(channelName, "sock%d", (int) newsock);
1644         chan = Tcl_CreateChannel(&tcpChannelType, channelName, newFile,
1645                 newFile, (ClientData) newSockState);
1646         if (chan == (Tcl_Channel) NULL) {
1647             ckfree((char *) newSockState);
1648             close(newsock);
1649             Tcl_FreeFile(newFile);
1650         } else {
1651             if (Tcl_SetChannelOption((Tcl_Interp *) NULL, chan, "-translation",
1652                     "auto crlf") == TCL_ERROR) {
1653                 Tcl_Close((Tcl_Interp *) NULL, chan);
1654             }
1655             if (sockState->acceptProc != (Tcl_TcpAcceptProc *) NULL) {
1656                 (sockState->acceptProc) (sockState->acceptProcData, chan,
1657                         inet_ntoa(addr.sin_addr), ntohs(addr.sin_port));
1658             }
1659         }
1660     }
1661 }
1662 \f
1663 /*
1664  *----------------------------------------------------------------------
1665  *
1666  * TclGetDefaultStdChannel --
1667  *
1668  *      Creates channels for standard input, standard output or standard
1669  *      error output if they do not already exist.
1670  *
1671  * Results:
1672  *      Returns the specified default standard channel, or NULL.
1673  *
1674  * Side effects:
1675  *      May cause the creation of a standard channel and the underlying
1676  *      file.
1677  *
1678  *----------------------------------------------------------------------
1679  */
1680
1681 Tcl_Channel
1682 TclGetDefaultStdChannel(type)
1683     int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
1684 {
1685     Tcl_Channel channel = NULL;
1686     int fd = 0;                 /* Initializations needed to prevent */
1687     int mode = 0;               /* compiler warning (used before set). */
1688     char *bufMode = NULL;
1689
1690     /*
1691      * If the channels were not created yet, create them now and
1692      * store them in the static variables.
1693      */
1694
1695     switch (type) {
1696         case TCL_STDIN:
1697             fd = 0;
1698             mode = TCL_READABLE;
1699             bufMode = "line";
1700             break;
1701         case TCL_STDOUT:
1702             fd = 1;
1703             mode = TCL_WRITABLE;
1704             bufMode = "line";
1705             break;
1706         case TCL_STDERR:
1707             fd = 2;
1708             mode = TCL_WRITABLE;
1709             bufMode = "none";
1710             break;
1711         default:
1712             panic("TclGetDefaultStdChannel: Unexpected channel type");
1713             break;
1714     }
1715
1716     channel = Tcl_MakeFileChannel((ClientData) fd, (ClientData) fd, mode);
1717
1718     /*
1719      * Set up the normal channel options for stdio handles.
1720      */
1721
1722     if (Tcl_SetChannelOption(NULL, channel, "-translation", "auto") ==
1723             TCL_ERROR) {
1724         Tcl_Close((Tcl_Interp *) NULL, channel);
1725         return NULL;
1726     }
1727     if (Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode) ==
1728             TCL_ERROR) {
1729         Tcl_Close((Tcl_Interp *) NULL, channel);
1730         return NULL;
1731     }
1732     return channel;
1733 }
1734 \f
1735 /*
1736  *----------------------------------------------------------------------
1737  *
1738  * TclClosePipeFile --
1739  *
1740  *      This function is a simple wrapper for close on a file or
1741  *      pipe handle. Called in the generic command pipeline cleanup
1742  *      code to do platform specific closing of the files associated
1743  *      with the command channel.
1744  *
1745  * Results:
1746  *      None.
1747  *
1748  * Side effects:
1749  *      Closes the fd and frees the Tcl_File.
1750  *
1751  *----------------------------------------------------------------------
1752  */
1753
1754 void
1755 TclClosePipeFile(file)
1756     Tcl_File file;
1757 {
1758     int fd = (int) Tcl_GetFileInfo(file, NULL);
1759     close(fd);
1760     Tcl_FreeFile(file);
1761 }
1762 \f
1763 /*
1764  *----------------------------------------------------------------------
1765  *
1766  * Tcl_GetOpenFile --
1767  *
1768  *      Given a name of a channel registered in the given interpreter,
1769  *      returns a FILE * for it.
1770  *
1771  * Results:
1772  *      A standard Tcl result. If the channel is registered in the given
1773  *      interpreter and it is managed by the "file" channel driver, and
1774  *      it is open for the requested mode, then the output parameter
1775  *      filePtr is set to a FILE * for the underlying file. On error, the
1776  *      filePtr is not set, TCL_ERROR is returned and an error message is
1777  *      left in interp->result.
1778  *
1779  * Side effects:
1780  *      May invoke fdopen to create the FILE * for the requested file.
1781  *
1782  *----------------------------------------------------------------------
1783  */
1784
1785 int
1786 Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
1787     Tcl_Interp *interp;         /* Interpreter in which to find file. */
1788     char *string;               /* String that identifies file. */
1789     int forWriting;             /* 1 means the file is going to be used
1790                                  * for writing, 0 means for reading. */
1791     int checkUsage;             /* 1 means verify that the file was opened
1792                                  * in a mode that allows the access specified
1793                                  * by "forWriting". Ignored, we always
1794                                  * check that the channel is open for the
1795                                  * requested mode. */
1796     ClientData *filePtr;        /* Store pointer to FILE structure here. */
1797 {
1798     Tcl_Channel chan;
1799     int chanMode;
1800     Tcl_ChannelType *chanTypePtr;
1801     Tcl_File tf;
1802     int fd;
1803     FILE *f;
1804
1805     chan = Tcl_GetChannel(interp, string, &chanMode);
1806     if (chan == (Tcl_Channel) NULL) {
1807         return TCL_ERROR;
1808     }
1809     if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
1810         Tcl_AppendResult(interp,
1811                 "\"", string, "\" wasn't opened for writing", (char *) NULL);
1812         return TCL_ERROR;
1813     } else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) {
1814         Tcl_AppendResult(interp,
1815                 "\"", string, "\" wasn't opened for reading", (char *) NULL);
1816         return TCL_ERROR;
1817     }
1818
1819     /*
1820      * We allow creating a FILE * out of file based, pipe based and socket
1821      * based channels. We currently do not allow any other channel types,
1822      * because it is likely that stdio will not know what to do with them.
1823      */
1824
1825     chanTypePtr = Tcl_GetChannelType(chan);
1826     if ((chanTypePtr == &fileChannelType) || (chanTypePtr == &pipeChannelType)
1827             || (chanTypePtr == &tcpChannelType)) {
1828         tf = Tcl_GetChannelFile(chan,
1829                 (forWriting ? TCL_WRITABLE : TCL_READABLE));
1830         fd = (int) Tcl_GetFileInfo(tf, NULL);
1831
1832         /*
1833          * The call to fdopen below is probably dangerous, since it will
1834          * truncate an existing file if the file is being opened
1835          * for writing....
1836          */
1837
1838         f = fdopen(fd, (forWriting ? "w" : "r"));
1839         if (f == NULL) {
1840             Tcl_AppendResult(interp, "cannot get a FILE * for \"", string,
1841                     "\"", (char *) NULL);
1842             return TCL_ERROR;
1843         }
1844         *filePtr = (ClientData) f;
1845         return TCL_OK;
1846     }
1847
1848     Tcl_AppendResult(interp, "\"", string,
1849             "\" cannot be used to get a FILE * - unsupported type",
1850             (char *) NULL);
1851     return TCL_ERROR;
1852 }