tcl/unix/tclUnixChan.c

   1 /*
   2  * tclUnixChan.c
   3  *
   4  *      Common channel driver for Unix channels based on files, command
   5  *      pipes and TCP sockets.
   6  *
   7  * Copyright (c) 1995-1997 Sun Microsystems, Inc.
   8  * Copyright (c) 1998-1999 by Scriptics Corporation.
   9  *
  10  * See the file "license.terms" for information on usage and redistribution
  11  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12  *
  13  * RCS: @(#) $Id$
  14  */
  15
  16 #include "tclInt.h"     /* Internal definitions for Tcl. */
  17 #include "tclPort.h"    /* Portability features for Tcl. */
  18
  19 /*
  20  * sys/ioctl.h has already been included by tclPort.h.  Including termios.h
  21  * or termio.h causes a bunch of warning messages because some duplicate
  22  * (but not contradictory) #defines exist in termios.h and/or termio.h
  23  */
  24 #undef NL0
  25 #undef NL1
  26 #undef CR0
  27 #undef CR1
  28 #undef CR2
  29 #undef CR3
  30 #undef TAB0
  31 #undef TAB1
  32 #undef TAB2
  33 #undef XTABS
  34 #undef BS0
  35 #undef BS1
  36 #undef FF0
  37 #undef FF1
  38 #undef ECHO
  39 #undef NOFLSH
  40 #undef TOSTOP
  41 #undef FLUSHO
  42 #undef PENDIN
  43
  44 #define SUPPORTS_TTY
  45
  46 #ifdef USE_TERMIOS
  47 #   include <termios.h>
  48 #   ifdef HAVE_SYS_IOCTL_H
  49 #       include <sys/ioctl.h>
  50 #   endif /* HAVE_SYS_IOCTL_H */
  51 #   ifdef HAVE_SYS_MODEM_H
  52 #       include <sys/modem.h>
  53 #   endif /* HAVE_SYS_MODEM_H */
  54 #   define IOSTATE                      struct termios
  55 #   define GETIOSTATE(fd, statePtr)     tcgetattr((fd), (statePtr))
  56 #   define SETIOSTATE(fd, statePtr)     tcsetattr((fd), TCSADRAIN, (statePtr))
  57 #   define GETCONTROL(fd, intPtr)       ioctl((fd), TIOCMGET, (intPtr))
  58 #   define SETCONTROL(fd, intPtr)       ioctl((fd), TIOCMSET, (intPtr))
  59     /*
  60      * TIP #35 introduced a different on exit flush/close behavior that
  61      * doesn't work correctly with standard channels on all systems.
  62      * The problem is tcflush throws away waiting channel data.  This may
  63      * be necessary for true serial channels that may block, but isn't
  64      * correct in the standard case.  This might be replaced with tcdrain
  65      * instead, but that can block.  For now, we revert to making this do
  66      * nothing, and TtyOutputProc being the same old FileOutputProc.
  67      * -- hobbs [Bug #525783]
  68      */
  69 #   define BAD_TIP35_FLUSH 0
  70 #   if BAD_TIP35_FLUSH
  71 #       define TTYFLUSH(fd)             tcflush((fd), TCIOFLUSH);
  72 #   else
  73 #       define TTYFLUSH(fd)
  74 #   endif /* BAD_TIP35_FLUSH */
  75 #   ifdef FIONREAD
  76 #       define GETREADQUEUE(fd, int)    ioctl((fd), FIONREAD, &(int))
  77 #   elif defined(FIORDCHK)
  78 #       define GETREADQUEUE(fd, int)    int = ioctl((fd), FIORDCHK, NULL)
  79 #   endif /* FIONREAD */
  80 #   ifdef TIOCOUTQ
  81 #       define GETWRITEQUEUE(fd, int)   ioctl((fd), TIOCOUTQ, &(int))
  82 #   endif /* TIOCOUTQ */
  83 #   if defined(TIOCSBRK) && defined(TIOCCBRK)
  84 /*
  85  * Can't use ?: operator below because that messes up types on either
  86  * Linux or Solaris (the two are mutually exclusive!)
  87  */
  88 #       define SETBREAK(fd, flag) \
  89                 if (flag) {                             \
  90                     ioctl((fd), TIOCSBRK, NULL);        \
  91                 } else {                                \
  92                     ioctl((fd), TIOCCBRK, NULL);        \
  93                 }
  94 #   endif /* TIOCSBRK&TIOCCBRK */
  95 #   if !defined(CRTSCTS) && defined(CNEW_RTSCTS)
  96 #       define CRTSCTS CNEW_RTSCTS
  97 #   endif /* !CRTSCTS&CNEW_RTSCTS */
  98 #else   /* !USE_TERMIOS */
  99
 100 #ifdef USE_TERMIO
 101 #   include <termio.h>
 102 #   define IOSTATE                      struct termio
 103 #   define GETIOSTATE(fd, statePtr)     ioctl((fd), TCGETA, (statePtr))
 104 #   define SETIOSTATE(fd, statePtr)     ioctl((fd), TCSETAW, (statePtr))
 105 #else   /* !USE_TERMIO */
 106
 107 #ifdef USE_SGTTY
 108 #   include <sgtty.h>
 109 #   define IOSTATE                      struct sgttyb
 110 #   define GETIOSTATE(fd, statePtr)     ioctl((fd), TIOCGETP, (statePtr))
 111 #   define SETIOSTATE(fd, statePtr)     ioctl((fd), TIOCSETP, (statePtr))
 112 #else   /* !USE_SGTTY */
 113 #   undef SUPPORTS_TTY
 114 #endif  /* !USE_SGTTY */
 115
 116 #endif  /* !USE_TERMIO */
 117 #endif  /* !USE_TERMIOS */
 118
 119 /*
 120  * This structure describes per-instance state of a file based channel.
 121  */
 122
 123 typedef struct FileState {
 124     Tcl_Channel channel;        /* Channel associated with this file. */
 125     int fd;                     /* File handle. */
 126     int validMask;              /* OR'ed combination of TCL_READABLE,
 127                                  * TCL_WRITABLE, or TCL_EXCEPTION: indicates
 128                                  * which operations are valid on the file. */
 129 #ifdef DEPRECATED
 130     struct FileState *nextPtr;  /* Pointer to next file in list of all
 131                                  * file channels. */
 132 #endif /* DEPRECATED */
 133 } FileState;
 134
 135 #ifdef SUPPORTS_TTY
 136
 137 /*
 138  * The following structure describes per-instance state of a tty-based
 139  * channel.
 140  */
 141
 142 typedef struct TtyState {
 143     FileState fs;               /* Per-instance state of the file
 144                                  * descriptor.  Must be the first field. */
 145     int stateUpdated;           /* Flag to say if the state has been
 146                                  * modified and needs resetting. */
 147     IOSTATE savedState;         /* Initial state of device.  Used to reset
 148                                  * state when device closed. */
 149 } TtyState;
 150
 151 /*
 152  * The following structure is used to set or get the serial port
 153  * attributes in a platform-independant manner.
 154  */
 155
 156 typedef struct TtyAttrs {
 157     int baud;
 158     int parity;
 159     int data;
 160     int stop;
 161 } TtyAttrs;
 162
 163 #endif  /* !SUPPORTS_TTY */
 164
 165 #define UNSUPPORTED_OPTION(detail) \
 166         if (interp) {                                                   \
 167             Tcl_AppendResult(interp, (detail),                          \
 168                     " not supported for this platform", (char *) NULL); \
 169         }
 170
 171 #ifdef DEPRECATED
 172 typedef struct ThreadSpecificData {
 173     /*
 174      * List of all file channels currently open.  This is per thread and is
 175      * used to match up fd's to channels, which rarely occurs.
 176      */
 177
 178     FileState *firstFilePtr;
 179 } ThreadSpecificData;
 180
 181 static Tcl_ThreadDataKey dataKey;
 182 #endif /* DEPRECATED */
 183
 184 /*
 185  * This structure describes per-instance state of a tcp based channel.
 186  */
 187
 188 typedef struct TcpState {
 189     Tcl_Channel channel;        /* Channel associated with this file. */
 190     int fd;                     /* The socket itself. */
 191     int flags;                  /* ORed combination of the bitfields
 192                                  * defined below. */
 193     Tcl_TcpAcceptProc *acceptProc;
 194                                 /* Proc to call on accept. */
 195     ClientData acceptProcData;  /* The data for the accept proc. */
 196 } TcpState;
 197
 198 /*
 199  * These bits may be ORed together into the "flags" field of a TcpState
 200  * structure.
 201  */
 202
 203 #define TCP_ASYNC_SOCKET        (1<<0)  /* Asynchronous socket. */
 204 #define TCP_ASYNC_CONNECT       (1<<1)  /* Async connect in progress. */
 205
 206 /*
 207  * The following defines the maximum length of the listen queue. This is
 208  * the number of outstanding yet-to-be-serviced requests for a connection
 209  * on a server socket, more than this number of outstanding requests and
 210  * the connection request will fail.
 211  */
 212
 213 #ifndef SOMAXCONN
 214 #   define SOMAXCONN    100
 215 #endif /* SOMAXCONN */
 216
 217 #if (SOMAXCONN < 100)
 218 #   undef  SOMAXCONN
 219 #   define SOMAXCONN    100
 220 #endif /* SOMAXCONN < 100 */
 221
 222 /*
 223  * The following defines how much buffer space the kernel should maintain
 224  * for a socket.
 225  */
 226
 227 #define SOCKET_BUFSIZE  4096
 228
 229 /*
 230  * Static routines for this file:
 231  */
 232
 233 static TcpState *       CreateSocket _ANSI_ARGS_((Tcl_Interp *interp,
 234                             int port, CONST char *host, int server,
 235                             CONST char *myaddr, int myport, int async));
 236 static int              CreateSocketAddress _ANSI_ARGS_(
 237                             (struct sockaddr_in *sockaddrPtr,
 238                             CONST char *host, int port));
 239 static int              FileBlockModeProc _ANSI_ARGS_((
 240                             ClientData instanceData, int mode));
 241 static int              FileCloseProc _ANSI_ARGS_((ClientData instanceData,
 242                             Tcl_Interp *interp));
 243 static int              FileGetHandleProc _ANSI_ARGS_((ClientData instanceData,
 244                             int direction, ClientData *handlePtr));
 245 static int              FileInputProc _ANSI_ARGS_((ClientData instanceData,
 246                             char *buf, int toRead, int *errorCode));
 247 static int              FileOutputProc _ANSI_ARGS_((
 248                             ClientData instanceData, CONST char *buf,
 249                             int toWrite, int *errorCode));
 250 static int              FileSeekProc _ANSI_ARGS_((ClientData instanceData,
 251                             long offset, int mode, int *errorCode));
 252 static Tcl_WideInt      FileWideSeekProc _ANSI_ARGS_((ClientData instanceData,
 253                             Tcl_WideInt offset, int mode, int *errorCode));
 254 static void             FileWatchProc _ANSI_ARGS_((ClientData instanceData,
 255                             int mask));
 256 static void             TcpAccept _ANSI_ARGS_((ClientData data, int mask));
 257 static int              TcpBlockModeProc _ANSI_ARGS_((ClientData data,
 258                             int mode));
 259 static int              TcpCloseProc _ANSI_ARGS_((ClientData instanceData,
 260                             Tcl_Interp *interp));
 261 static int              TcpGetHandleProc _ANSI_ARGS_((ClientData instanceData,
 262                             int direction, ClientData *handlePtr));
 263 static int              TcpGetOptionProc _ANSI_ARGS_((ClientData instanceData,
 264                             Tcl_Interp *interp, CONST char *optionName,
 265                             Tcl_DString *dsPtr));
 266 static int              TcpInputProc _ANSI_ARGS_((ClientData instanceData,
 267                             char *buf, int toRead,  int *errorCode));
 268 static int              TcpOutputProc _ANSI_ARGS_((ClientData instanceData,
 269                             CONST char *buf, int toWrite, int *errorCode));
 270 static void             TcpWatchProc _ANSI_ARGS_((ClientData instanceData,
 271                             int mask));
 272 #ifdef SUPPORTS_TTY
 273 static int              TtyCloseProc _ANSI_ARGS_((ClientData instanceData,
 274                             Tcl_Interp *interp));
 275 static void             TtyGetAttributes _ANSI_ARGS_((int fd,
 276                             TtyAttrs *ttyPtr));
 277 static int              TtyGetOptionProc _ANSI_ARGS_((ClientData instanceData,
 278                             Tcl_Interp *interp, CONST char *optionName,
 279                             Tcl_DString *dsPtr));
 280 static FileState *      TtyInit _ANSI_ARGS_((int fd, int initialize));
 281 #if BAD_TIP35_FLUSH
 282 static int              TtyOutputProc _ANSI_ARGS_((ClientData instanceData,
 283                             CONST char *buf, int toWrite, int *errorCode));
 284 #endif /* BAD_TIP35_FLUSH */
 285 static int              TtyParseMode _ANSI_ARGS_((Tcl_Interp *interp,
 286                             CONST char *mode, int *speedPtr, int *parityPtr,
 287                             int *dataPtr, int *stopPtr));
 288 static void             TtySetAttributes _ANSI_ARGS_((int fd,
 289                             TtyAttrs *ttyPtr));
 290 static int              TtySetOptionProc _ANSI_ARGS_((ClientData instanceData,
 291                             Tcl_Interp *interp, CONST char *optionName,
 292                             CONST char *value));
 293 #endif  /* SUPPORTS_TTY */
 294 static int              WaitForConnect _ANSI_ARGS_((TcpState *statePtr,
 295                             int *errorCodePtr));
 296
 297 /*
 298  * This structure describes the channel type structure for file based IO:
 299  */
 300
 301 static Tcl_ChannelType fileChannelType = {
 302     "file",                     /* Type name. */
 303     TCL_CHANNEL_VERSION_3,      /* v3 channel */
 304     FileCloseProc,              /* Close proc. */
 305     FileInputProc,              /* Input proc. */
 306     FileOutputProc,             /* Output proc. */
 307     FileSeekProc,               /* Seek proc. */
 308     NULL,                       /* Set option proc. */
 309     NULL,                       /* Get option proc. */
 310     FileWatchProc,              /* Initialize notifier. */
 311     FileGetHandleProc,          /* Get OS handles out of channel. */
 312     NULL,                       /* close2proc. */
 313     FileBlockModeProc,          /* Set blocking or non-blocking mode.*/
 314     NULL,                       /* flush proc. */
 315     NULL,                       /* handler proc. */
 316     FileWideSeekProc,           /* wide seek proc. */
 317 };
 318
 319 #ifdef SUPPORTS_TTY
 320 /*
 321  * This structure describes the channel type structure for serial IO.
 322  * Note that this type is a subclass of the "file" type.
 323  */
 324
 325 static Tcl_ChannelType ttyChannelType = {
 326     "tty",                      /* Type name. */
 327     TCL_CHANNEL_VERSION_2,      /* v2 channel */
 328     TtyCloseProc,               /* Close proc. */
 329     FileInputProc,              /* Input proc. */
 330 #if BAD_TIP35_FLUSH
 331     TtyOutputProc,              /* Output proc. */
 332 #else /* !BAD_TIP35_FLUSH */
 333     FileOutputProc,             /* Output proc. */
 334 #endif /* BAD_TIP35_FLUSH */
 335     NULL,                       /* Seek proc. */
 336     TtySetOptionProc,           /* Set option proc. */
 337     TtyGetOptionProc,           /* Get option proc. */
 338     FileWatchProc,              /* Initialize notifier. */
 339     FileGetHandleProc,          /* Get OS handles out of channel. */
 340     NULL,                       /* close2proc. */
 341     FileBlockModeProc,          /* Set blocking or non-blocking mode.*/
 342     NULL,                       /* flush proc. */
 343     NULL,                       /* handler proc. */
 344 };
 345 #endif  /* SUPPORTS_TTY */
 346
 347 /*
 348  * This structure describes the channel type structure for TCP socket
 349  * based IO:
 350  */
 351
 352 static Tcl_ChannelType tcpChannelType = {
 353     "tcp",                      /* Type name. */
 354     TCL_CHANNEL_VERSION_2,      /* v2 channel */
 355     TcpCloseProc,               /* Close proc. */
 356     TcpInputProc,               /* Input proc. */
 357     TcpOutputProc,              /* Output proc. */
 358     NULL,                       /* Seek proc. */
 359     NULL,                       /* Set option proc. */
 360     TcpGetOptionProc,           /* Get option proc. */
 361     TcpWatchProc,               /* Initialize notifier. */
 362     TcpGetHandleProc,           /* Get OS handles out of channel. */
 363     NULL,                       /* close2proc. */
 364     TcpBlockModeProc,           /* Set blocking or non-blocking mode.*/
 365     NULL,                       /* flush proc. */
 366     NULL,                       /* handler proc. */
 367 };
 368
 369 \f
 370 /*
 371  *----------------------------------------------------------------------
 372  *
 373  * FileBlockModeProc --
 374  *
 375  *      Helper procedure to set blocking and nonblocking modes on a
 376  *      file based channel. Invoked by generic IO level code.
 377  *
 378  * Results:
 379  *      0 if successful, errno when failed.
 380  *
 381  * Side effects:
 382  *      Sets the device into blocking or non-blocking mode.
 383  *
 384  *----------------------------------------------------------------------
 385  */
 386
 387         /* ARGSUSED */
 388 static int
 389 FileBlockModeProc(instanceData, mode)
 390     ClientData instanceData;            /* File state. */
 391     int mode;                           /* The mode to set. Can be one of
 392                                          * TCL_MODE_BLOCKING or
 393                                          * TCL_MODE_NONBLOCKING. */
 394 {
 395     FileState *fsPtr = (FileState *) instanceData;
 396     int curStatus;
 397
 398 #ifndef USE_FIONBIO
 399     curStatus = fcntl(fsPtr->fd, F_GETFL);
 400     if (mode == TCL_MODE_BLOCKING) {
 401         curStatus &= (~(O_NONBLOCK));
 402     } else {
 403         curStatus |= O_NONBLOCK;
 404     }
 405     if (fcntl(fsPtr->fd, F_SETFL, curStatus) < 0) {
 406         return errno;
 407     }
 408     curStatus = fcntl(fsPtr->fd, F_GETFL);
 409 #else /* USE_FIONBIO */
 410     if (mode == TCL_MODE_BLOCKING) {
 411         curStatus = 0;
 412     } else {
 413         curStatus = 1;
 414     }
 415     if (ioctl(fsPtr->fd, (int) FIONBIO, &curStatus) < 0) {
 416         return errno;
 417     }
 418 #endif /* !USE_FIONBIO */
 419     return 0;
 420 }
 421 \f
 422 /*
 423  *----------------------------------------------------------------------
 424  *
 425  * FileInputProc --
 426  *
 427  *      This procedure is invoked from the generic IO level to read
 428  *      input from a file based channel.
 429  *
 430  * Results:
 431  *      The number of bytes read is returned or -1 on error. An output
 432  *      argument contains a POSIX error code if an error occurs, or zero.
 433  *
 434  * Side effects:
 435  *      Reads input from the input device of the channel.
 436  *
 437  *----------------------------------------------------------------------
 438  */
 439
 440 static int
 441 FileInputProc(instanceData, buf, toRead, errorCodePtr)
 442     ClientData instanceData;            /* File state. */
 443     char *buf;                          /* Where to store data read. */
 444     int toRead;                         /* How much space is available
 445                                          * in the buffer? */
 446     int *errorCodePtr;                  /* Where to store error code. */
 447 {
 448     FileState *fsPtr = (FileState *) instanceData;
 449     int bytesRead;                      /* How many bytes were actually
 450                                          * read from the input device? */
 451
 452     *errorCodePtr = 0;
 453
 454     /*
 455      * Assume there is always enough input available. This will block
 456      * appropriately, and read will unblock as soon as a short read is
 457      * possible, if the channel is in blocking mode. If the channel is
 458      * nonblocking, the read will never block.
 459      */
 460
 461     bytesRead = read(fsPtr->fd, buf, (size_t) toRead);
 462     if (bytesRead > -1) {
 463         return bytesRead;
 464     }
 465     *errorCodePtr = errno;
 466     return -1;
 467 }
 468 \f
 469 /*
 470  *----------------------------------------------------------------------
 471  *
 472  * FileOutputProc--
 473  *
 474  *      This procedure is invoked from the generic IO level to write
 475  *      output to a file channel.
 476  *
 477  * Results:
 478  *      The number of bytes written is returned or -1 on error. An
 479  *      output argument contains a POSIX error code if an error occurred,
 480  *      or zero.
 481  *
 482  * Side effects:
 483  *      Writes output on the output device of the channel.
 484  *
 485  *----------------------------------------------------------------------
 486  */
 487
 488 static int
 489 FileOutputProc(instanceData, buf, toWrite, errorCodePtr)
 490     ClientData instanceData;            /* File state. */
 491     CONST char *buf;                    /* The data buffer. */
 492     int toWrite;                        /* How many bytes to write? */
 493     int *errorCodePtr;                  /* Where to store error code. */
 494 {
 495     FileState *fsPtr = (FileState *) instanceData;
 496     int written;
 497
 498     *errorCodePtr = 0;
 499
 500     if (toWrite == 0) {
 501         /*
 502          * SF Tcl Bug 465765.
 503          * Do not try to write nothing into a file. STREAM based
 504          * implementations will considers this as EOF (if there is a
 505          * pipe behind the file).
 506          */
 507
 508         return 0;
 509     }
 510     written = write(fsPtr->fd, buf, (size_t) toWrite);
 511     if (written > -1) {
 512         return written;
 513     }
 514     *errorCodePtr = errno;
 515     return -1;
 516 }
 517 \f
 518 /*
 519  *----------------------------------------------------------------------
 520  *
 521  * FileCloseProc --
 522  *
 523  *      This procedure is called from the generic IO level to perform
 524  *      channel-type-specific cleanup when a file based channel is closed.
 525  *
 526  * Results:
 527  *      0 if successful, errno if failed.
 528  *
 529  * Side effects:
 530  *      Closes the device of the channel.
 531  *
 532  *----------------------------------------------------------------------
 533  */
 534
 535 static int
 536 FileCloseProc(instanceData, interp)
 537     ClientData instanceData;    /* File state. */
 538     Tcl_Interp *interp;         /* For error reporting - unused. */
 539 {
 540     FileState *fsPtr = (FileState *) instanceData;
 541     int errorCode = 0;
 542 #ifdef DEPRECATED
 543     FileState **nextPtrPtr;
 544     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
 545 #endif /* DEPRECATED */
 546     Tcl_DeleteFileHandler(fsPtr->fd);
 547
 548     /*
 549      * Do not close standard channels while in thread-exit.
 550      */
 551
 552     if (!TclInExit()
 553             || ((fsPtr->fd != 0) && (fsPtr->fd != 1) && (fsPtr->fd != 2))) {
 554         if (close(fsPtr->fd) < 0) {
 555             errorCode = errno;
 556         }
 557     }
 558 #ifdef DEPRECATED
 559     for (nextPtrPtr = &(tsdPtr->firstFilePtr); (*nextPtrPtr) != NULL;
 560          nextPtrPtr = &((*nextPtrPtr)->nextPtr)) {
 561         if ((*nextPtrPtr) == fsPtr) {
 562             (*nextPtrPtr) = fsPtr->nextPtr;
 563             break;
 564         }
 565     }
 566 #endif /* DEPRECATED */
 567     ckfree((char *) fsPtr);
 568     return errorCode;
 569 }
 570 \f
 571 /*
 572  *----------------------------------------------------------------------
 573  *
 574  * FileSeekProc --
 575  *
 576  *      This procedure is called by the generic IO level to move the
 577  *      access point in a file based channel.
 578  *
 579  * Results:
 580  *      -1 if failed, the new position if successful. An output
 581  *      argument contains the POSIX error code if an error occurred,
 582  *      or zero.
 583  *
 584  * Side effects:
 585  *      Moves the location at which the channel will be accessed in
 586  *      future operations.
 587  *
 588  *----------------------------------------------------------------------
 589  */
 590
 591 static int
 592 FileSeekProc(instanceData, offset, mode, errorCodePtr)
 593     ClientData instanceData;    /* File state. */
 594     long offset;                /* Offset to seek to. */
 595     int mode;                   /* Relative to where should we seek? Can be
 596                                  * one of SEEK_START, SEEK_SET or SEEK_END. */
 597     int *errorCodePtr;          /* To store error code. */
 598 {
 599     FileState *fsPtr = (FileState *) instanceData;
 600     Tcl_WideInt oldLoc, newLoc;
 601
 602     /*
 603      * Save our current place in case we need to roll-back the seek.
 604      */
 605     oldLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) 0, SEEK_CUR);
 606     if (oldLoc == Tcl_LongAsWide(-1)) {
 607         /*
 608          * Bad things are happening.  Error out...
 609          */
 610         *errorCodePtr = errno;
 611         return -1;
 612     }
 613
 614     newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
 615
 616     /*
 617      * Check for expressability in our return type, and roll-back otherwise.
 618      */
 619     if (newLoc > Tcl_LongAsWide(INT_MAX)) {
 620         *errorCodePtr = EOVERFLOW;
 621         TclOSseek(fsPtr->fd, (Tcl_SeekOffset) oldLoc, SEEK_SET);
 622         return -1;
 623     } else {
 624         *errorCodePtr = (newLoc == Tcl_LongAsWide(-1)) ? errno : 0;
 625     }
 626     return (int) Tcl_WideAsLong(newLoc);
 627 }
 628 \f
 629 /*
 630  *----------------------------------------------------------------------
 631  *
 632  * FileWideSeekProc --
 633  *
 634  *      This procedure is called by the generic IO level to move the
 635  *      access point in a file based channel, with offsets expressed
 636  *      as wide integers.
 637  *
 638  * Results:
 639  *      -1 if failed, the new position if successful. An output
 640  *      argument contains the POSIX error code if an error occurred,
 641  *      or zero.
 642  *
 643  * Side effects:
 644  *      Moves the location at which the channel will be accessed in
 645  *      future operations.
 646  *
 647  *----------------------------------------------------------------------
 648  */
 649
 650 static Tcl_WideInt
 651 FileWideSeekProc(instanceData, offset, mode, errorCodePtr)
 652     ClientData instanceData;    /* File state. */
 653     Tcl_WideInt offset;         /* Offset to seek to. */
 654     int mode;                   /* Relative to where should we seek? Can be
 655                                  * one of SEEK_START, SEEK_CUR or SEEK_END. */
 656     int *errorCodePtr;          /* To store error code. */
 657 {
 658     FileState *fsPtr = (FileState *) instanceData;
 659     Tcl_WideInt newLoc;
 660
 661     newLoc = TclOSseek(fsPtr->fd, (Tcl_SeekOffset) offset, mode);
 662
 663     *errorCodePtr = (newLoc == -1) ? errno : 0;
 664     return newLoc;
 665 }
 666 \f
 667 /*
 668  *----------------------------------------------------------------------
 669  *
 670  * FileWatchProc --
 671  *
 672  *      Initialize the notifier to watch the fd from this channel.
 673  *
 674  * Results:
 675  *      None.
 676  *
 677  * Side effects:
 678  *      Sets up the notifier so that a future event on the channel will
 679  *      be seen by Tcl.
 680  *
 681  *----------------------------------------------------------------------
 682  */
 683
 684 static void
 685 FileWatchProc(instanceData, mask)
 686     ClientData instanceData;            /* The file state. */
 687     int mask;                           /* Events of interest; an OR-ed
 688                                          * combination of TCL_READABLE,
 689                                          * TCL_WRITABLE and TCL_EXCEPTION. */
 690 {
 691     FileState *fsPtr = (FileState *) instanceData;
 692
 693     /*
 694      * Make sure we only register for events that are valid on this file.
 695      * Note that we are passing Tcl_NotifyChannel directly to
 696      * Tcl_CreateFileHandler with the channel pointer as the client data.
 697      */
 698
 699     mask &= fsPtr->validMask;
 700     if (mask) {
 701         Tcl_CreateFileHandler(fsPtr->fd, mask,
 702                 (Tcl_FileProc *) Tcl_NotifyChannel,
 703                 (ClientData) fsPtr->channel);
 704     } else {
 705         Tcl_DeleteFileHandler(fsPtr->fd);
 706     }
 707 }
 708 \f
 709 /*
 710  *----------------------------------------------------------------------
 711  *
 712  * FileGetHandleProc --
 713  *
 714  *      Called from Tcl_GetChannelHandle to retrieve OS handles from
 715  *      a file based channel.
 716  *
 717  * Results:
 718  *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
 719  *      there is no handle for the specified direction.
 720  *
 721  * Side effects:
 722  *      None.
 723  *
 724  *----------------------------------------------------------------------
 725  */
 726
 727 static int
 728 FileGetHandleProc(instanceData, direction, handlePtr)
 729     ClientData instanceData;    /* The file state. */
 730     int direction;              /* TCL_READABLE or TCL_WRITABLE */
 731     ClientData *handlePtr;      /* Where to store the handle.  */
 732 {
 733     FileState *fsPtr = (FileState *) instanceData;
 734
 735     if (direction & fsPtr->validMask) {
 736         *handlePtr = (ClientData) fsPtr->fd;
 737         return TCL_OK;
 738     } else {
 739         return TCL_ERROR;
 740     }
 741 }
 742
 743 #ifdef SUPPORTS_TTY
 744 \f
 745 /*
 746  *----------------------------------------------------------------------
 747  *
 748  * TtyCloseProc --
 749  *
 750  *      This procedure is called from the generic IO level to perform
 751  *      channel-type-specific cleanup when a tty based channel is closed.
 752  *
 753  * Results:
 754  *      0 if successful, errno if failed.
 755  *
 756  * Side effects:
 757  *      Closes the device of the channel.
 758  *
 759  *----------------------------------------------------------------------
 760  */
 761 static int
 762 TtyCloseProc(instanceData, interp)
 763     ClientData instanceData;    /* Tty state. */
 764     Tcl_Interp *interp;         /* For error reporting - unused. */
 765 {
 766 #if BAD_TIP35_FLUSH
 767     TtyState *ttyPtr = (TtyState *) instanceData;
 768 #endif /* BAD_TIP35_FLUSH */
 769 #ifdef TTYFLUSH
 770     TTYFLUSH(ttyPtr->fs.fd);
 771 #endif /* TTYFLUSH */
 772 #if 0
 773     /*
 774      * TIP#35 agreed to remove the unsave so that TCL could be used as a
 775      * simple stty.
 776      * It would be cleaner to remove all the stuff related to
 777      *    TtyState.stateUpdated
 778      *    TtyState.savedState
 779      * Then the structure TtyState would be the same as FileState.
 780      * IMO this cleanup could better be done for the final 8.4 release
 781      * after nobody complained about the missing unsave. -- schroedter
 782      */
 783     if (ttyPtr->stateUpdated) {
 784         SETIOSTATE(ttyPtr->fs.fd, &ttyPtr->savedState);
 785     }
 786 #endif
 787     return FileCloseProc(instanceData, interp);
 788 }
 789 \f
 790 /*
 791  *----------------------------------------------------------------------
 792  *
 793  * TtyOutputProc--
 794  *
 795  *      This procedure is invoked from the generic IO level to write
 796  *      output to a TTY channel.
 797  *
 798  * Results:
 799  *      The number of bytes written is returned or -1 on error. An
 800  *      output argument contains a POSIX error code if an error occurred,
 801  *      or zero.
 802  *
 803  * Side effects:
 804  *      Writes output on the output device of the channel
 805  *      if the channel is not designated to be closed.
 806  *
 807  *----------------------------------------------------------------------
 808  */
 809
 810 #if BAD_TIP35_FLUSH
 811 static int
 812 TtyOutputProc(instanceData, buf, toWrite, errorCodePtr)
 813     ClientData instanceData;            /* File state. */
 814     CONST char *buf;                    /* The data buffer. */
 815     int toWrite;                        /* How many bytes to write? */
 816     int *errorCodePtr;                  /* Where to store error code. */
 817 {
 818     if (TclInExit()) {
 819         /*
 820          * Do not write data during Tcl exit.
 821          * Serial port may block preventing Tcl from exit.
 822          */
 823         return toWrite;
 824     } else {
 825         return FileOutputProc(instanceData, buf, toWrite, errorCodePtr);
 826     }
 827 }
 828 #endif /* BAD_TIP35_FLUSH */
 829 \f
 830 #ifdef USE_TERMIOS
 831 /*
 832  *----------------------------------------------------------------------
 833  *
 834  * TtyModemStatusStr --
 835  *
 836  *  Converts a RS232 modem status list of readable flags
 837  *
 838  *----------------------------------------------------------------------
 839  */
 840 static void
 841 TtyModemStatusStr(status, dsPtr)
 842     int status;            /* RS232 modem status */
 843     Tcl_DString *dsPtr;    /* Where to store string */
 844 {
 845 #ifdef TIOCM_CTS
 846     Tcl_DStringAppendElement(dsPtr, "CTS");
 847     Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CTS) ? "1" : "0");
 848 #endif /* TIOCM_CTS */
 849 #ifdef TIOCM_DSR
 850     Tcl_DStringAppendElement(dsPtr, "DSR");
 851     Tcl_DStringAppendElement(dsPtr, (status & TIOCM_DSR) ? "1" : "0");
 852 #endif /* TIOCM_DSR */
 853 #ifdef TIOCM_RNG
 854     Tcl_DStringAppendElement(dsPtr, "RING");
 855     Tcl_DStringAppendElement(dsPtr, (status & TIOCM_RNG) ? "1" : "0");
 856 #endif /* TIOCM_RNG */
 857 #ifdef TIOCM_CD
 858     Tcl_DStringAppendElement(dsPtr, "DCD");
 859     Tcl_DStringAppendElement(dsPtr, (status & TIOCM_CD) ? "1" : "0");
 860 #endif /* TIOCM_CD */
 861 }
 862 #endif /* USE_TERMIOS */
 863 \f
 864 /*
 865  *----------------------------------------------------------------------
 866  *
 867  * TtySetOptionProc --
 868  *
 869  *      Sets an option on a channel.
 870  *
 871  * Results:
 872  *      A standard Tcl result. Also sets the interp's result on error if
 873  *      interp is not NULL.
 874  *
 875  * Side effects:
 876  *      May modify an option on a device.
 877  *      Sets Error message if needed (by calling Tcl_BadChannelOption).
 878  *
 879  *----------------------------------------------------------------------
 880  */
 881
 882 static int
 883 TtySetOptionProc(instanceData, interp, optionName, value)
 884     ClientData instanceData;    /* File state. */
 885     Tcl_Interp *interp;         /* For error reporting - can be NULL. */
 886     CONST char *optionName;     /* Which option to set? */
 887     CONST char *value;          /* New value for option. */
 888 {
 889     FileState *fsPtr = (FileState *) instanceData;
 890     unsigned int len, vlen;
 891     TtyAttrs tty;
 892 #ifdef USE_TERMIOS
 893     int flag, control, argc;
 894     CONST char **argv;
 895     IOSTATE iostate;
 896 #endif /* USE_TERMIOS */
 897
 898     len = strlen(optionName);
 899     vlen = strlen(value);
 900
 901     /*
 902      * Option -mode baud,parity,databits,stopbits
 903      */
 904     if ((len > 2) && (strncmp(optionName, "-mode", len) == 0)) {
 905         if (TtyParseMode(interp, value, &tty.baud, &tty.parity, &tty.data,
 906                 &tty.stop) != TCL_OK) {
 907             return TCL_ERROR;
 908         }
 909         /*
 910          * system calls results should be checked there. -- dl
 911          */
 912
 913         TtySetAttributes(fsPtr->fd, &tty);
 914         ((TtyState *) fsPtr)->stateUpdated = 1;
 915         return TCL_OK;
 916     }
 917
 918 #ifdef USE_TERMIOS
 919
 920     /*
 921      * Option -handshake none|xonxoff|rtscts|dtrdsr
 922      */
 923     if ((len > 1) && (strncmp(optionName, "-handshake", len) == 0)) {
 924         /*
 925          * Reset all handshake options
 926          * DTR and RTS are ON by default
 927          */
 928         GETIOSTATE(fsPtr->fd, &iostate);
 929         iostate.c_iflag &= ~(IXON | IXOFF | IXANY);
 930 #ifdef CRTSCTS
 931         iostate.c_cflag &= ~CRTSCTS;
 932 #endif /* CRTSCTS */
 933         if (strncasecmp(value, "NONE", vlen) == 0) {
 934             /* leave all handshake options disabled */
 935         } else if (strncasecmp(value, "XONXOFF", vlen) == 0) {
 936             iostate.c_iflag |= (IXON | IXOFF | IXANY);
 937         } else if (strncasecmp(value, "RTSCTS", vlen) == 0) {
 938 #ifdef CRTSCTS
 939             iostate.c_cflag |= CRTSCTS;
 940 #else /* !CRTSTS */
 941             UNSUPPORTED_OPTION("-handshake RTSCTS");
 942             return TCL_ERROR;
 943 #endif /* CRTSCTS */
 944         } else if (strncasecmp(value, "DTRDSR", vlen) == 0) {
 945             UNSUPPORTED_OPTION("-handshake DTRDSR");
 946             return TCL_ERROR;
 947         } else {
 948             if (interp) {
 949                 Tcl_AppendResult(interp, "bad value for -handshake: ",
 950                         "must be one of xonxoff, rtscts, dtrdsr or none",
 951                         (char *) NULL);
 952             }
 953             return TCL_ERROR;
 954         }
 955         SETIOSTATE(fsPtr->fd, &iostate);
 956         return TCL_OK;
 957     }
 958
 959     /*
 960      * Option -xchar {\x11 \x13}
 961      */
 962     if ((len > 1) && (strncmp(optionName, "-xchar", len) == 0)) {
 963         GETIOSTATE(fsPtr->fd, &iostate);
 964         if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
 965             return TCL_ERROR;
 966         }
 967         if (argc == 2) {
 968             iostate.c_cc[VSTART] = argv[0][0];
 969             iostate.c_cc[VSTOP]  = argv[1][0];
 970         } else {
 971             if (interp) {
 972                 Tcl_AppendResult(interp,
 973                     "bad value for -xchar: should be a list of two elements",
 974                     (char *) NULL);
 975             }
 976             return TCL_ERROR;
 977         }
 978         SETIOSTATE(fsPtr->fd, &iostate);
 979         return TCL_OK;
 980     }
 981
 982     /*
 983      * Option -timeout msec
 984      */
 985     if ((len > 2) && (strncmp(optionName, "-timeout", len) == 0)) {
 986         int msec;
 987
 988         GETIOSTATE(fsPtr->fd, &iostate);
 989         if (Tcl_GetInt(interp, value, &msec) != TCL_OK) {
 990             return TCL_ERROR;
 991         }
 992         iostate.c_cc[VMIN]  = 0;
 993         iostate.c_cc[VTIME] = (msec == 0) ? 0 : (msec < 100) ? 1 : (msec+50)/100;
 994         SETIOSTATE(fsPtr->fd, &iostate);
 995         return TCL_OK;
 996     }
 997
 998     /*
 999      * Option -ttycontrol {DTR 1 RTS 0 BREAK 0}
1000      */
1001     if ((len > 4) && (strncmp(optionName, "-ttycontrol", len) == 0)) {
1002         if (Tcl_SplitList(interp, value, &argc, &argv) == TCL_ERROR) {
1003             return TCL_ERROR;
1004         }
1005         if ((argc % 2) == 1) {
1006             if (interp) {
1007                 Tcl_AppendResult(interp,
1008                         "bad value for -ttycontrol: should be a list of",
1009                         "signal,value pairs", (char *) NULL);
1010             }
1011             return TCL_ERROR;
1012         }
1013
1014         GETCONTROL(fsPtr->fd, &control);
1015         while (argc > 1) {
1016             if (Tcl_GetBoolean(interp, argv[1], &flag) == TCL_ERROR) {
1017                 return TCL_ERROR;
1018             }
1019             if (strncasecmp(argv[0], "DTR", strlen(argv[0])) == 0) {
1020 #ifdef TIOCM_DTR
1021                 if (flag) {
1022                     control |= TIOCM_DTR;
1023                 } else {
1024                     control &= ~TIOCM_DTR;
1025                 }
1026 #else /* !TIOCM_DTR */
1027                 UNSUPPORTED_OPTION("-ttycontrol DTR");
1028                 return TCL_ERROR;
1029 #endif /* TIOCM_DTR */
1030             } else if (strncasecmp(argv[0], "RTS", strlen(argv[0])) == 0) {
1031 #ifdef TIOCM_RTS
1032                 if (flag) {
1033                     control |= TIOCM_RTS;
1034                 } else {
1035                     control &= ~TIOCM_RTS;
1036                 }
1037 #else /* !TIOCM_RTS*/
1038                 UNSUPPORTED_OPTION("-ttycontrol RTS");
1039                 return TCL_ERROR;
1040 #endif /* TIOCM_RTS*/
1041             } else if (strncasecmp(argv[0], "BREAK", strlen(argv[0])) == 0) {
1042 #ifdef SETBREAK
1043                 SETBREAK(fsPtr->fd, flag);
1044 #else /* !SETBREAK */
1045                 UNSUPPORTED_OPTION("-ttycontrol BREAK");
1046                 return TCL_ERROR;
1047 #endif /* SETBREAK */
1048             } else {
1049                 if (interp) {
1050                     Tcl_AppendResult(interp,
1051                             "bad signal for -ttycontrol: must be ",
1052                             "DTR, RTS or BREAK", (char *) NULL);
1053                 }
1054                 return TCL_ERROR;
1055             }
1056             argc -= 2, argv += 2;
1057         } /* while (argc > 1) */
1058
1059         SETCONTROL(fsPtr->fd, &control);
1060         return TCL_OK;
1061     }
1062
1063     return Tcl_BadChannelOption(interp, optionName,
1064             "mode handshake timeout ttycontrol xchar ");
1065
1066 #else /* !USE_TERMIOS */
1067     return Tcl_BadChannelOption(interp, optionName, "mode");
1068 #endif /* USE_TERMIOS */
1069 }
1070 \f
1071 /*
1072  *----------------------------------------------------------------------
1073  *
1074  * TtyGetOptionProc --
1075  *
1076  *      Gets a mode associated with an IO channel. If the optionName arg
1077  *      is non NULL, retrieves the value of that option. If the optionName
1078  *      arg is NULL, retrieves a list of alternating option names and
1079  *      values for the given channel.
1080  *
1081  * Results:
1082  *      A standard Tcl result. Also sets the supplied DString to the
1083  *      string value of the option(s) returned.
1084  *
1085  * Side effects:
1086  *      The string returned by this function is in static storage and
1087  *      may be reused at any time subsequent to the call.
1088  *      Sets Error message if needed (by calling Tcl_BadChannelOption).
1089  *
1090  *----------------------------------------------------------------------
1091  */
1092
1093 static int
1094 TtyGetOptionProc(instanceData, interp, optionName, dsPtr)
1095     ClientData instanceData;    /* File state. */
1096     Tcl_Interp *interp;         /* For error reporting - can be NULL. */
1097     CONST char *optionName;     /* Option to get. */
1098     Tcl_DString *dsPtr;         /* Where to store value(s). */
1099 {
1100     FileState *fsPtr = (FileState *) instanceData;
1101     unsigned int len;
1102     char buf[3 * TCL_INTEGER_SPACE + 16];
1103     TtyAttrs tty;
1104     int valid = 0;  /* flag if valid option parsed */
1105
1106     if (optionName == NULL) {
1107         len = 0;
1108     } else {
1109         len = strlen(optionName);
1110     }
1111     if (len == 0) {
1112         Tcl_DStringAppendElement(dsPtr, "-mode");
1113     }
1114     if (len==0 || (len>2 && strncmp(optionName, "-mode", len)==0)) {
1115         valid = 1;
1116         TtyGetAttributes(fsPtr->fd, &tty);
1117         sprintf(buf, "%d,%c,%d,%d", tty.baud, tty.parity, tty.data, tty.stop);
1118         Tcl_DStringAppendElement(dsPtr, buf);
1119     }
1120
1121 #ifdef USE_TERMIOS
1122     /*
1123      * get option -xchar
1124      */
1125     if (len == 0) {
1126         Tcl_DStringAppendElement(dsPtr, "-xchar");
1127         Tcl_DStringStartSublist(dsPtr);
1128     }
1129     if (len==0 || (len>1 && strncmp(optionName, "-xchar", len)==0)) {
1130         IOSTATE iostate;
1131         valid = 1;
1132
1133         GETIOSTATE(fsPtr->fd, &iostate);
1134         sprintf(buf, "%c", iostate.c_cc[VSTART]);
1135         Tcl_DStringAppendElement(dsPtr, buf);
1136         sprintf(buf, "%c", iostate.c_cc[VSTOP]);
1137         Tcl_DStringAppendElement(dsPtr, buf);
1138     }
1139     if (len == 0) {
1140         Tcl_DStringEndSublist(dsPtr);
1141     }
1142
1143     /*
1144      * get option -queue
1145      * option is readonly and returned by [fconfigure chan -queue]
1146      * but not returned by unnamed [fconfigure chan]
1147      */
1148     if ((len > 1) && (strncmp(optionName, "-queue", len) == 0)) {
1149         int inQueue=0, outQueue=0;
1150         int inBuffered, outBuffered;
1151         valid = 1;
1152 #ifdef GETREADQUEUE
1153         GETREADQUEUE(fsPtr->fd, inQueue);
1154 #endif /* GETREADQUEUE */
1155 #ifdef GETWRITEQUEUE
1156         GETWRITEQUEUE(fsPtr->fd, outQueue);
1157 #endif /* GETWRITEQUEUE */
1158         inBuffered  = Tcl_InputBuffered(fsPtr->channel);
1159         outBuffered = Tcl_OutputBuffered(fsPtr->channel);
1160
1161         sprintf(buf, "%d", inBuffered+inQueue);
1162         Tcl_DStringAppendElement(dsPtr, buf);
1163         sprintf(buf, "%d", outBuffered+outQueue);
1164         Tcl_DStringAppendElement(dsPtr, buf);
1165     }
1166
1167     /*
1168      * get option -ttystatus
1169      * option is readonly and returned by [fconfigure chan -ttystatus]
1170      * but not returned by unnamed [fconfigure chan]
1171      */
1172     if ((len > 4) && (strncmp(optionName, "-ttystatus", len) == 0)) {
1173         int status;
1174         valid = 1;
1175         GETCONTROL(fsPtr->fd, &status);
1176         TtyModemStatusStr(status, dsPtr);
1177     }
1178 #endif /* USE_TERMIOS */
1179
1180     if (valid) {
1181         return TCL_OK;
1182     } else {
1183         return Tcl_BadChannelOption(interp, optionName,
1184 #ifdef USE_TERMIOS
1185             "mode queue ttystatus xchar");
1186 #else /* !USE_TERMIOS */
1187             "mode");
1188 #endif /* USE_TERMIOS */
1189     }
1190 }
1191 \f
1192 #undef DIRECT_BAUD
1193 #ifdef B4800
1194 #   if (B4800 == 4800)
1195 #       define DIRECT_BAUD
1196 #   endif /* B4800 == 4800 */
1197 #endif /* B4800 */
1198
1199 #ifdef DIRECT_BAUD
1200 #   define TtyGetSpeed(baud)   ((unsigned) (baud))
1201 #   define TtyGetBaud(speed)   ((int) (speed))
1202 #else /* !DIRECT_BAUD */
1203
1204 static struct {int baud; unsigned long speed;} speeds[] = {
1205 #ifdef B0
1206     {0, B0},
1207 #endif
1208 #ifdef B50
1209     {50, B50},
1210 #endif
1211 #ifdef B75
1212     {75, B75},
1213 #endif
1214 #ifdef B110
1215     {110, B110},
1216 #endif
1217 #ifdef B134
1218     {134, B134},
1219 #endif
1220 #ifdef B150
1221     {150, B150},
1222 #endif
1223 #ifdef B200
1224     {200, B200},
1225 #endif
1226 #ifdef B300
1227     {300, B300},
1228 #endif
1229 #ifdef B600
1230     {600, B600},
1231 #endif
1232 #ifdef B1200
1233     {1200, B1200},
1234 #endif
1235 #ifdef B1800
1236     {1800, B1800},
1237 #endif
1238 #ifdef B2400
1239     {2400, B2400},
1240 #endif
1241 #ifdef B4800
1242     {4800, B4800},
1243 #endif
1244 #ifdef B9600
1245     {9600, B9600},
1246 #endif
1247 #ifdef B14400
1248     {14400, B14400},
1249 #endif
1250 #ifdef B19200
1251     {19200, B19200},
1252 #endif
1253 #ifdef EXTA
1254     {19200, EXTA},
1255 #endif
1256 #ifdef B28800
1257     {28800, B28800},
1258 #endif
1259 #ifdef B38400
1260     {38400, B38400},
1261 #endif
1262 #ifdef EXTB
1263     {38400, EXTB},
1264 #endif
1265 #ifdef B57600
1266     {57600, B57600},
1267 #endif
1268 #ifdef _B57600
1269     {57600, _B57600},
1270 #endif
1271 #ifdef B76800
1272     {76800, B76800},
1273 #endif
1274 #ifdef B115200
1275     {115200, B115200},
1276 #endif
1277 #ifdef _B115200
1278     {115200, _B115200},
1279 #endif
1280 #ifdef B153600
1281     {153600, B153600},
1282 #endif
1283 #ifdef B230400
1284     {230400, B230400},
1285 #endif
1286 #ifdef B307200
1287     {307200, B307200},
1288 #endif
1289 #ifdef B460800
1290     {460800, B460800},
1291 #endif
1292     {-1, 0}
1293 };
1294
1295 /*
1296  *---------------------------------------------------------------------------
1297  *
1298  * TtyGetSpeed --
1299  *
1300  *      Given a baud rate, get the mask value that should be stored in
1301  *      the termios, termio, or sgttyb structure in order to select that
1302  *      baud rate.
1303  *
1304  * Results:
1305  *      As above.
1306  *
1307  * Side effects:
1308  *      None.
1309  *
1310  *---------------------------------------------------------------------------
1311  */
1312
1313 static unsigned long
1314 TtyGetSpeed(baud)
1315     int baud;                   /* The baud rate to look up. */
1316 {
1317     int bestIdx, bestDiff, i, diff;
1318
1319     bestIdx = 0;
1320     bestDiff = 1000000;
1321
1322     /*
1323      * If the baud rate does not correspond to one of the known mask values,
1324      * choose the mask value whose baud rate is closest to the specified
1325      * baud rate.
1326      */
1327
1328     for (i = 0; speeds[i].baud >= 0; i++) {
1329         diff = speeds[i].baud - baud;
1330         if (diff < 0) {
1331             diff = -diff;
1332         }
1333         if (diff < bestDiff) {
1334             bestIdx = i;
1335             bestDiff = diff;
1336         }
1337     }
1338     return speeds[bestIdx].speed;
1339 }
1340 \f
1341 /*
1342  *---------------------------------------------------------------------------
1343  *
1344  * TtyGetBaud --
1345  *
1346  *      Given a speed mask value from a termios, termio, or sgttyb
1347  *      structure, get the baus rate that corresponds to that mask value.
1348  *
1349  * Results:
1350  *      As above.  If the mask value was not recognized, 0 is returned.
1351  *
1352  * Side effects:
1353  *      None.
1354  *
1355  *---------------------------------------------------------------------------
1356  */
1357
1358 static int
1359 TtyGetBaud(speed)
1360     unsigned long speed;        /* Speed mask value to look up. */
1361 {
1362     int i;
1363
1364     for (i = 0; speeds[i].baud >= 0; i++) {
1365         if (speeds[i].speed == speed) {
1366             return speeds[i].baud;
1367         }
1368     }
1369     return 0;
1370 }
1371
1372 #endif /* !DIRECT_BAUD */
1373
1374 \f
1375 /*
1376  *---------------------------------------------------------------------------
1377  *
1378  * TtyGetAttributes --
1379  *
1380  *      Get the current attributes of the specified serial device.
1381  *
1382  * Results:
1383  *      None.
1384  *
1385  * Side effects:
1386  *      None.
1387  *
1388  *---------------------------------------------------------------------------
1389  */
1390
1391 static void
1392 TtyGetAttributes(fd, ttyPtr)
1393     int fd;                     /* Open file descriptor for serial port to
1394                                  * be queried. */
1395     TtyAttrs *ttyPtr;           /* Buffer filled with serial port
1396                                  * attributes. */
1397 {
1398     IOSTATE iostate;
1399     int baud, parity, data, stop;
1400
1401     GETIOSTATE(fd, &iostate);
1402
1403 #ifdef USE_TERMIOS
1404     baud = TtyGetBaud(cfgetospeed(&iostate));
1405
1406     parity = 'n';
1407 #ifdef PAREXT
1408     switch ((int) (iostate.c_cflag & (PARENB | PARODD | PAREXT))) {
1409         case PARENB                   : parity = 'e'; break;
1410         case PARENB | PARODD          : parity = 'o'; break;
1411         case PARENB |          PAREXT : parity = 's'; break;
1412         case PARENB | PARODD | PAREXT : parity = 'm'; break;
1413     }
1414 #else /* !PAREXT */
1415     switch ((int) (iostate.c_cflag & (PARENB | PARODD))) {
1416         case PARENB                   : parity = 'e'; break;
1417         case PARENB | PARODD          : parity = 'o'; break;
1418     }
1419 #endif /* !PAREXT */
1420
1421     data = iostate.c_cflag & CSIZE;
1422     data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
1423
1424     stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
1425 #endif /* USE_TERMIOS */
1426
1427 #ifdef USE_TERMIO
1428     baud = TtyGetBaud(iostate.c_cflag & CBAUD);
1429
1430     parity = 'n';
1431     switch (iostate.c_cflag & (PARENB | PARODD | PAREXT)) {
1432         case PARENB                   : parity = 'e'; break;
1433         case PARENB | PARODD          : parity = 'o'; break;
1434         case PARENB |          PAREXT : parity = 's'; break;
1435         case PARENB | PARODD | PAREXT : parity = 'm'; break;
1436     }
1437
1438     data = iostate.c_cflag & CSIZE;
1439     data = (data == CS5) ? 5 : (data == CS6) ? 6 : (data == CS7) ? 7 : 8;
1440
1441     stop = (iostate.c_cflag & CSTOPB) ? 2 : 1;
1442 #endif /* USE_TERMIO */
1443
1444 #ifdef USE_SGTTY
1445     baud = TtyGetBaud(iostate.sg_ospeed);
1446
1447     parity = 'n';
1448     if (iostate.sg_flags & EVENP) {
1449         parity = 'e';
1450     } else if (iostate.sg_flags & ODDP) {
1451         parity = 'o';
1452     }
1453
1454     data = (iostate.sg_flags & (EVENP | ODDP)) ? 7 : 8;
1455
1456     stop = 1;
1457 #endif /* USE_SGTTY */
1458
1459     ttyPtr->baud    = baud;
1460     ttyPtr->parity  = parity;
1461     ttyPtr->data    = data;
1462     ttyPtr->stop    = stop;
1463 }
1464 \f
1465 /*
1466  *---------------------------------------------------------------------------
1467  *
1468  * TtySetAttributes --
1469  *
1470  *      Set the current attributes of the specified serial device.
1471  *
1472  * Results:
1473  *      None.
1474  *
1475  * Side effects:
1476  *      None.
1477  *
1478  *---------------------------------------------------------------------------
1479  */
1480
1481 static void
1482 TtySetAttributes(fd, ttyPtr)
1483     int fd;                     /* Open file descriptor for serial port to
1484                                  * be modified. */
1485     TtyAttrs *ttyPtr;           /* Buffer containing new attributes for
1486                                  * serial port. */
1487 {
1488     IOSTATE iostate;
1489
1490 #ifdef USE_TERMIOS
1491     int parity, data, flag;
1492
1493     GETIOSTATE(fd, &iostate);
1494     cfsetospeed(&iostate, TtyGetSpeed(ttyPtr->baud));
1495     cfsetispeed(&iostate, TtyGetSpeed(ttyPtr->baud));
1496
1497     flag = 0;
1498     parity = ttyPtr->parity;
1499     if (parity != 'n') {
1500         flag |= PARENB;
1501 #ifdef PAREXT
1502         iostate.c_cflag &= ~PAREXT;
1503         if ((parity == 'm') || (parity == 's')) {
1504             flag |= PAREXT;
1505         }
1506 #endif /* PAREXT */
1507         if ((parity == 'm') || (parity == 'o')) {
1508             flag |= PARODD;
1509         }
1510     }
1511     data = ttyPtr->data;
1512     flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8;
1513     if (ttyPtr->stop == 2) {
1514         flag |= CSTOPB;
1515     }
1516
1517     iostate.c_cflag &= ~(PARENB | PARODD | CSIZE | CSTOPB);
1518     iostate.c_cflag |= flag;
1519
1520 #endif  /* USE_TERMIOS */
1521
1522 #ifdef USE_TERMIO
1523     int parity, data, flag;
1524
1525     GETIOSTATE(fd, &iostate);
1526     iostate.c_cflag &= ~CBAUD;
1527     iostate.c_cflag |= TtyGetSpeed(ttyPtr->baud);
1528
1529     flag = 0;
1530     parity = ttyPtr->parity;
1531     if (parity != 'n') {
1532         flag |= PARENB;
1533         if ((parity == 'm') || (parity == 's')) {
1534             flag |= PAREXT;
1535         }
1536         if ((parity == 'm') || (parity == 'o')) {
1537             flag |= PARODD;
1538         }
1539     }
1540     data = ttyPtr->data;
1541     flag |= (data == 5) ? CS5 : (data == 6) ? CS6 : (data == 7) ? CS7 : CS8;
1542     if (ttyPtr->stop == 2) {
1543         flag |= CSTOPB;
1544     }
1545
1546     iostate.c_cflag &= ~(PARENB | PARODD | PAREXT | CSIZE | CSTOPB);
1547     iostate.c_cflag |= flag;
1548
1549 #endif  /* USE_TERMIO */
1550
1551 #ifdef USE_SGTTY
1552     int parity;
1553
1554     GETIOSTATE(fd, &iostate);
1555     iostate.sg_ospeed = TtyGetSpeed(ttyPtr->baud);
1556     iostate.sg_ispeed = TtyGetSpeed(ttyPtr->baud);
1557
1558     parity = ttyPtr->parity;
1559     if (parity == 'e') {
1560         iostate.sg_flags &= ~ODDP;
1561         iostate.sg_flags |= EVENP;
1562     } else if (parity == 'o') {
1563         iostate.sg_flags &= ~EVENP;
1564         iostate.sg_flags |= ODDP;
1565     }
1566 #endif  /* USE_SGTTY */
1567
1568     SETIOSTATE(fd, &iostate);
1569 }
1570 \f
1571 /*
1572  *---------------------------------------------------------------------------
1573  *
1574  * TtyParseMode --
1575  *
1576  *      Parse the "-mode" argument to the fconfigure command.  The argument
1577  *      is of the form baud,parity,data,stop.
1578  *
1579  * Results:
1580  *      The return value is TCL_OK if the argument was successfully
1581  *      parsed, TCL_ERROR otherwise.  If TCL_ERROR is returned, an
1582  *      error message is left in the interp's result (if interp is non-NULL).
1583  *
1584  * Side effects:
1585  *      None.
1586  *
1587  *---------------------------------------------------------------------------
1588  */
1589
1590 static int
1591 TtyParseMode(interp, mode, speedPtr, parityPtr, dataPtr, stopPtr)
1592     Tcl_Interp *interp;         /* If non-NULL, interp for error return. */
1593     CONST char *mode;           /* Mode string to be parsed. */
1594     int *speedPtr;              /* Filled with baud rate from mode string. */
1595     int *parityPtr;             /* Filled with parity from mode string. */
1596     int *dataPtr;               /* Filled with data bits from mode string. */
1597     int *stopPtr;               /* Filled with stop bits from mode string. */
1598 {
1599     int i, end;
1600     char parity;
1601     static char *bad = "bad value for -mode";
1602
1603     i = sscanf(mode, "%d,%c,%d,%d%n", speedPtr, &parity, dataPtr,
1604             stopPtr, &end);
1605     if ((i != 4) || (mode[end] != '\0')) {
1606         if (interp != NULL) {
1607             Tcl_AppendResult(interp, bad, ": should be baud,parity,data,stop",
1608                     NULL);
1609         }
1610         return TCL_ERROR;
1611     }
1612     /*
1613      * Only allow setting mark/space parity on platforms that support it
1614      * Make sure to allow for the case where strchr is a macro.
1615      * [Bug: 5089]
1616      */
1617     if (
1618 #if defined(PAREXT) || defined(USE_TERMIO)
1619         strchr("noems", parity) == NULL
1620 #else
1621         strchr("noe", parity) == NULL
1622 #endif /* PAREXT|USE_TERMIO */
1623         ) {
1624         if (interp != NULL) {
1625             Tcl_AppendResult(interp, bad,
1626 #if defined(PAREXT) || defined(USE_TERMIO)
1627                     " parity: should be n, o, e, m, or s",
1628 #else
1629                     " parity: should be n, o, or e",
1630 #endif /* PAREXT|USE_TERMIO */
1631                     NULL);
1632         }
1633         return TCL_ERROR;
1634     }
1635     *parityPtr = parity;
1636     if ((*dataPtr < 5) || (*dataPtr > 8)) {
1637         if (interp != NULL) {
1638             Tcl_AppendResult(interp, bad, " data: should be 5, 6, 7, or 8",
1639                     NULL);
1640         }
1641         return TCL_ERROR;
1642     }
1643     if ((*stopPtr < 0) || (*stopPtr > 2)) {
1644         if (interp != NULL) {
1645             Tcl_AppendResult(interp, bad, " stop: should be 1 or 2", NULL);
1646         }
1647         return TCL_ERROR;
1648     }
1649     return TCL_OK;
1650 }
1651 \f
1652 /*
1653  *---------------------------------------------------------------------------
1654  *
1655  * TtyInit --
1656  *
1657  *      Given file descriptor that refers to a serial port,
1658  *      initialize the serial port to a set of sane values so that
1659  *      Tcl can talk to a device located on the serial port.
1660  *      Note that no initialization happens if the initialize flag
1661  *      is not set; this is necessary for the correct handling of
1662  *      UNIX console TTYs at startup.
1663  *
1664  * Results:
1665  *      A pointer to a FileState suitable for use with Tcl_CreateChannel
1666  *      and the ttyChannelType structure.
1667  *
1668  * Side effects:
1669  *      Serial device initialized to non-blocking raw mode, similar to
1670  *      sockets (if initialize flag is non-zero.)  All other modes can
1671  *      be simulated on top of this in Tcl.
1672  *
1673  *---------------------------------------------------------------------------
1674  */
1675
1676 static FileState *
1677 TtyInit(fd, initialize)
1678     int fd;                     /* Open file descriptor for serial port to
1679                                  * be initialized. */
1680     int initialize;
1681 {
1682     TtyState *ttyPtr;
1683
1684     ttyPtr = (TtyState *) ckalloc((unsigned) sizeof(TtyState));
1685     GETIOSTATE(fd, &ttyPtr->savedState);
1686     ttyPtr->stateUpdated = 0;
1687     if (initialize) {
1688         IOSTATE iostate = ttyPtr->savedState;
1689
1690 #if defined(USE_TERMIOS) || defined(USE_TERMIO)
1691         if (iostate.c_iflag != IGNBRK ||
1692                 iostate.c_oflag != 0 ||
1693                 iostate.c_lflag != 0 ||
1694                 iostate.c_cflag & CREAD ||
1695                 iostate.c_cc[VMIN] != 1 ||
1696                 iostate.c_cc[VTIME] != 0) {
1697             ttyPtr->stateUpdated = 1;
1698         }
1699         iostate.c_iflag = IGNBRK;
1700         iostate.c_oflag = 0;
1701         iostate.c_lflag = 0;
1702         iostate.c_cflag |= CREAD;
1703         iostate.c_cc[VMIN] = 1;
1704         iostate.c_cc[VTIME] = 0;
1705 #endif  /* USE_TERMIOS|USE_TERMIO */
1706
1707 #ifdef USE_SGTTY
1708         if ((iostate.sg_flags & (EVENP | ODDP)) ||
1709                 !(iostate.sg_flags & RAW)) {
1710             ttyPtr->stateUpdated = 1;
1711         }
1712         iostate.sg_flags &= (EVENP | ODDP);
1713         iostate.sg_flags |= RAW;
1714 #endif  /* USE_SGTTY */
1715
1716         /*
1717          * Only update if we're changing anything to avoid possible
1718          * blocking.
1719          */
1720         if (ttyPtr->stateUpdated) {
1721             SETIOSTATE(fd, &iostate);
1722         }
1723     }
1724
1725     return &ttyPtr->fs;
1726 }
1727 #endif  /* SUPPORTS_TTY */
1728 \f
1729 /*
1730  *----------------------------------------------------------------------
1731  *
1732  * TclpOpenFileChannel --
1733  *
1734  *      Open an file based channel on Unix systems.
1735  *
1736  * Results:
1737  *      The new channel or NULL. If NULL, the output argument
1738  *      errorCodePtr is set to a POSIX error and an error message is
1739  *      left in the interp's result if interp is not NULL.
1740  *
1741  * Side effects:
1742  *      May open the channel and may cause creation of a file on the
1743  *      file system.
1744  *
1745  *----------------------------------------------------------------------
1746  */
1747
1748 Tcl_Channel
1749 TclpOpenFileChannel(interp, pathPtr, mode, permissions)
1750     Tcl_Interp *interp;                 /* Interpreter for error reporting;
1751                                          * can be NULL. */
1752     Tcl_Obj *pathPtr;                   /* Name of file to open. */
1753     int mode;                           /* POSIX open mode. */
1754     int permissions;                    /* If the open involves creating a
1755                                          * file, with what modes to create
1756                                          * it? */
1757 {
1758     int fd, channelPermissions;
1759     FileState *fsPtr;
1760     CONST char *native, *translation;
1761     char channelName[16 + TCL_INTEGER_SPACE];
1762     Tcl_ChannelType *channelTypePtr;
1763 #ifdef SUPPORTS_TTY
1764     int ctl_tty;
1765 #endif /* SUPPORTS_TTY */
1766 #ifdef DEPRECATED
1767     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1768 #endif /* DEPRECATED */
1769
1770     switch (mode & (O_RDONLY | O_WRONLY | O_RDWR)) {
1771         case O_RDONLY:
1772             channelPermissions = TCL_READABLE;
1773             break;
1774         case O_WRONLY:
1775             channelPermissions = TCL_WRITABLE;
1776             break;
1777         case O_RDWR:
1778             channelPermissions = (TCL_READABLE | TCL_WRITABLE);
1779             break;
1780         default:
1781             /*
1782              * This may occurr if modeString was "", for example.
1783              */
1784             panic("TclpOpenFileChannel: invalid mode value");
1785             return NULL;
1786     }
1787
1788     native = Tcl_FSGetNativePath(pathPtr);
1789     if (native == NULL) {
1790         return NULL;
1791     }
1792     fd = TclOSopen(native, mode, permissions);
1793 #ifdef SUPPORTS_TTY
1794     ctl_tty = (strcmp (native, "/dev/tty") == 0);
1795 #endif /* SUPPORTS_TTY */
1796
1797     if (fd < 0) {
1798         if (interp != (Tcl_Interp *) NULL) {
1799             Tcl_AppendResult(interp, "couldn't open \"",
1800                     Tcl_GetString(pathPtr), "\": ",
1801                     Tcl_PosixError(interp), (char *) NULL);
1802         }
1803         return NULL;
1804     }
1805
1806     /*
1807      * Set close-on-exec flag on the fd so that child processes will not
1808      * inherit this fd.
1809      */
1810
1811     fcntl(fd, F_SETFD, FD_CLOEXEC);
1812
1813     sprintf(channelName, "file%d", fd);
1814
1815 #ifdef SUPPORTS_TTY
1816     if (!ctl_tty && isatty(fd)) {
1817         /*
1818          * Initialize the serial port to a set of sane parameters.
1819          * Especially important if the remote device is set to echo and
1820          * the serial port driver was also set to echo -- as soon as a char
1821          * were sent to the serial port, the remote device would echo it,
1822          * then the serial driver would echo it back to the device, etc.
1823          */
1824
1825         translation = "auto crlf";
1826         channelTypePtr = &ttyChannelType;
1827         fsPtr = TtyInit(fd, 1);
1828     } else
1829 #endif  /* SUPPORTS_TTY */
1830     {
1831         translation = NULL;
1832         channelTypePtr = &fileChannelType;
1833         fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
1834     }
1835
1836 #ifdef DEPRECATED
1837     fsPtr->nextPtr = tsdPtr->firstFilePtr;
1838     tsdPtr->firstFilePtr = fsPtr;
1839 #endif /* DEPRECATED */
1840     fsPtr->validMask = channelPermissions | TCL_EXCEPTION;
1841     fsPtr->fd = fd;
1842
1843     fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
1844             (ClientData) fsPtr, channelPermissions);
1845
1846     if (translation != NULL) {
1847         /*
1848          * Gotcha.  Most modems need a "\r" at the end of the command
1849          * sequence.  If you just send "at\n", the modem will not respond
1850          * with "OK" because it never got a "\r" to actually invoke the
1851          * command.  So, by default, newlines are translated to "\r\n" on
1852          * output to avoid "bug" reports that the serial port isn't working.
1853          */
1854
1855         if (Tcl_SetChannelOption(interp, fsPtr->channel, "-translation",
1856                 translation) != TCL_OK) {
1857             Tcl_Close(NULL, fsPtr->channel);
1858             return NULL;
1859         }
1860     }
1861
1862     return fsPtr->channel;
1863 }
1864 \f
1865 /*
1866  *----------------------------------------------------------------------
1867  *
1868  * Tcl_MakeFileChannel --
1869  *
1870  *      Makes a Tcl_Channel from an existing OS level file handle.
1871  *
1872  * Results:
1873  *      The Tcl_Channel created around the preexisting OS level file handle.
1874  *
1875  * Side effects:
1876  *      None.
1877  *
1878  *----------------------------------------------------------------------
1879  */
1880
1881 Tcl_Channel
1882 Tcl_MakeFileChannel(handle, mode)
1883     ClientData handle;          /* OS level handle. */
1884     int mode;                   /* ORed combination of TCL_READABLE and
1885                                  * TCL_WRITABLE to indicate file mode. */
1886 {
1887     FileState *fsPtr;
1888     char channelName[16 + TCL_INTEGER_SPACE];
1889     int fd = (int) handle;
1890     Tcl_ChannelType *channelTypePtr;
1891 #ifdef DEPRECATED
1892     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
1893 #endif /* DEPRECATED */
1894     int socketType = 0;
1895     socklen_t argLength = sizeof(int);
1896
1897     if (mode == 0) {
1898         return NULL;
1899     }
1900
1901
1902     /*
1903      * Look to see if a channel with this fd and the same mode already exists.
1904      * If the fd is used, but the mode doesn't match, return NULL.
1905      */
1906
1907 #ifdef DEPRECATED
1908     for (fsPtr = tsdPtr->firstFilePtr; fsPtr != NULL; fsPtr = fsPtr->nextPtr) {
1909         if (fsPtr->fd == fd) {
1910             return ((mode|TCL_EXCEPTION) == fsPtr->validMask) ?
1911                     fsPtr->channel : NULL;
1912         }
1913     }
1914 #endif /* DEPRECATED */
1915
1916 #ifdef SUPPORTS_TTY
1917     if (isatty(fd)) {
1918         fsPtr = TtyInit(fd, 0);
1919         channelTypePtr = &ttyChannelType;
1920         sprintf(channelName, "serial%d", fd);
1921     } else
1922 #endif /* SUPPORTS_TTY */
1923     if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (VOID *)&socketType,
1924                    &argLength) == 0  &&  socketType == SOCK_STREAM) {
1925         /*
1926          * The mode parameter gets lost here, unfortunately.
1927          */
1928         return Tcl_MakeTcpClientChannel((ClientData) fd);
1929     } else {
1930         channelTypePtr = &fileChannelType;
1931         fsPtr = (FileState *) ckalloc((unsigned) sizeof(FileState));
1932         sprintf(channelName, "file%d", fd);
1933     }
1934
1935 #ifdef DEPRECATED
1936     fsPtr->nextPtr = tsdPtr->firstFilePtr;
1937     tsdPtr->firstFilePtr = fsPtr;
1938 #endif /* DEPRECATED */
1939     fsPtr->fd = fd;
1940     fsPtr->validMask = mode | TCL_EXCEPTION;
1941     fsPtr->channel = Tcl_CreateChannel(channelTypePtr, channelName,
1942             (ClientData) fsPtr, mode);
1943
1944     return fsPtr->channel;
1945 }
1946 \f
1947 /*
1948  *----------------------------------------------------------------------
1949  *
1950  * TcpBlockModeProc --
1951  *
1952  *      This procedure is invoked by the generic IO level to set blocking
1953  *      and nonblocking mode on a TCP socket based channel.
1954  *
1955  * Results:
1956  *      0 if successful, errno when failed.
1957  *
1958  * Side effects:
1959  *      Sets the device into blocking or nonblocking mode.
1960  *
1961  *----------------------------------------------------------------------
1962  */
1963
1964         /* ARGSUSED */
1965 static int
1966 TcpBlockModeProc(instanceData, mode)
1967     ClientData instanceData;            /* Socket state. */
1968     int mode;                           /* The mode to set. Can be one of
1969                                          * TCL_MODE_BLOCKING or
1970                                          * TCL_MODE_NONBLOCKING. */
1971 {
1972     TcpState *statePtr = (TcpState *) instanceData;
1973     int setting;
1974
1975 #ifndef USE_FIONBIO
1976     setting = fcntl(statePtr->fd, F_GETFL);
1977     if (mode == TCL_MODE_BLOCKING) {
1978         statePtr->flags &= (~(TCP_ASYNC_SOCKET));
1979         setting &= (~(O_NONBLOCK));
1980     } else {
1981         statePtr->flags |= TCP_ASYNC_SOCKET;
1982         setting |= O_NONBLOCK;
1983     }
1984     if (fcntl(statePtr->fd, F_SETFL, setting) < 0) {
1985         return errno;
1986     }
1987 #else /* USE_FIONBIO */
1988     if (mode == TCL_MODE_BLOCKING) {
1989         statePtr->flags &= (~(TCP_ASYNC_SOCKET));
1990         setting = 0;
1991         if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
1992             return errno;
1993         }
1994     } else {
1995         statePtr->flags |= TCP_ASYNC_SOCKET;
1996         setting = 1;
1997         if (ioctl(statePtr->fd, (int) FIONBIO, &setting) == -1) {
1998             return errno;
1999         }
2000     }
2001 #endif /* !USE_FIONBIO */
2002
2003     return 0;
2004 }
2005 \f
2006 /*
2007  *----------------------------------------------------------------------
2008  *
2009  * WaitForConnect --
2010  *
2011  *      Waits for a connection on an asynchronously opened socket to
2012  *      be completed.
2013  *
2014  * Results:
2015  *      None.
2016  *
2017  * Side effects:
2018  *      The socket is connected after this function returns.
2019  *
2020  *----------------------------------------------------------------------
2021  */
2022
2023 static int
2024 WaitForConnect(statePtr, errorCodePtr)
2025     TcpState *statePtr;         /* State of the socket. */
2026     int *errorCodePtr;          /* Where to store errors? */
2027 {
2028     int timeOut;                /* How long to wait. */
2029     int state;                  /* Of calling TclWaitForFile. */
2030     int flags;                  /* fcntl flags for the socket. */
2031
2032     /*
2033      * If an asynchronous connect is in progress, attempt to wait for it
2034      * to complete before reading.
2035      */
2036
2037     if (statePtr->flags & TCP_ASYNC_CONNECT) {
2038         if (statePtr->flags & TCP_ASYNC_SOCKET) {
2039             timeOut = 0;
2040         } else {
2041             timeOut = -1;
2042         }
2043         errno = 0;
2044         state = TclUnixWaitForFile(statePtr->fd,
2045                 TCL_WRITABLE | TCL_EXCEPTION, timeOut);
2046         if (!(statePtr->flags & TCP_ASYNC_SOCKET)) {
2047 #ifndef USE_FIONBIO
2048             flags = fcntl(statePtr->fd, F_GETFL);
2049             flags &= (~(O_NONBLOCK));
2050             (void) fcntl(statePtr->fd, F_SETFL, flags);
2051 #else /* USE_FIONBIO */
2052             flags = 0;
2053             (void) ioctl(statePtr->fd, FIONBIO, &flags);
2054 #endif /* !USE_FIONBIO */
2055         }
2056         if (state & TCL_EXCEPTION) {
2057             return -1;
2058         }
2059         if (state & TCL_WRITABLE) {
2060             statePtr->flags &= (~(TCP_ASYNC_CONNECT));
2061         } else if (timeOut == 0) {
2062             *errorCodePtr = errno = EWOULDBLOCK;
2063             return -1;
2064         }
2065     }
2066     return 0;
2067 }
2068 \f
2069 /*
2070  *----------------------------------------------------------------------
2071  *
2072  * TcpInputProc --
2073  *
2074  *      This procedure is invoked by the generic IO level to read input
2075  *      from a TCP socket based channel.
2076  *
2077  *      NOTE: We cannot share code with FilePipeInputProc because here
2078  *      we must use recv to obtain the input from the channel, not read.
2079  *
2080  * Results:
2081  *      The number of bytes read is returned or -1 on error. An output
2082  *      argument contains the POSIX error code on error, or zero if no
2083  *      error occurred.
2084  *
2085  * Side effects:
2086  *      Reads input from the input device of the channel.
2087  *
2088  *----------------------------------------------------------------------
2089  */
2090
2091         /* ARGSUSED */
2092 static int
2093 TcpInputProc(instanceData, buf, bufSize, errorCodePtr)
2094     ClientData instanceData;            /* Socket state. */
2095     char *buf;                          /* Where to store data read. */
2096     int bufSize;                        /* How much space is available
2097                                          * in the buffer? */
2098     int *errorCodePtr;                  /* Where to store error code. */
2099 {
2100     TcpState *statePtr = (TcpState *) instanceData;
2101     int bytesRead, state;
2102
2103     *errorCodePtr = 0;
2104     state = WaitForConnect(statePtr, errorCodePtr);
2105     if (state != 0) {
2106         return -1;
2107     }
2108     bytesRead = recv(statePtr->fd, buf, (size_t) bufSize, 0);
2109     if (bytesRead > -1) {
2110         return bytesRead;
2111     }
2112     if (errno == ECONNRESET) {
2113         /*
2114          * Turn ECONNRESET into a soft EOF condition.
2115          */
2116
2117         return 0;
2118     }
2119     *errorCodePtr = errno;
2120     return -1;
2121 }
2122 \f
2123 /*
2124  *----------------------------------------------------------------------
2125  *
2126  * TcpOutputProc --
2127  *
2128  *      This procedure is invoked by the generic IO level to write output
2129  *      to a TCP socket based channel.
2130  *
2131  *      NOTE: We cannot share code with FilePipeOutputProc because here
2132  *      we must use send, not write, to get reliable error reporting.
2133  *
2134  * Results:
2135  *      The number of bytes written is returned. An output argument is
2136  *      set to a POSIX error code if an error occurred, or zero.
2137  *
2138  * Side effects:
2139  *      Writes output on the output device of the channel.
2140  *
2141  *----------------------------------------------------------------------
2142  */
2143
2144 static int
2145 TcpOutputProc(instanceData, buf, toWrite, errorCodePtr)
2146     ClientData instanceData;            /* Socket state. */
2147     CONST char *buf;                    /* The data buffer. */
2148     int toWrite;                        /* How many bytes to write? */
2149     int *errorCodePtr;                  /* Where to store error code. */
2150 {
2151     TcpState *statePtr = (TcpState *) instanceData;
2152     int written;
2153     int state;                          /* Of waiting for connection. */
2154
2155     *errorCodePtr = 0;
2156     state = WaitForConnect(statePtr, errorCodePtr);
2157     if (state != 0) {
2158         return -1;
2159     }
2160     written = send(statePtr->fd, buf, (size_t) toWrite, 0);
2161     if (written > -1) {
2162         return written;
2163     }
2164     *errorCodePtr = errno;
2165     return -1;
2166 }
2167 \f
2168 /*
2169  *----------------------------------------------------------------------
2170  *
2171  * TcpCloseProc --
2172  *
2173  *      This procedure is invoked by the generic IO level to perform
2174  *      channel-type-specific cleanup when a TCP socket based channel
2175  *      is closed.
2176  *
2177  * Results:
2178  *      0 if successful, the value of errno if failed.
2179  *
2180  * Side effects:
2181  *      Closes the socket of the channel.
2182  *
2183  *----------------------------------------------------------------------
2184  */
2185
2186         /* ARGSUSED */
2187 static int
2188 TcpCloseProc(instanceData, interp)
2189     ClientData instanceData;    /* The socket to close. */
2190     Tcl_Interp *interp;         /* For error reporting - unused. */
2191 {
2192     TcpState *statePtr = (TcpState *) instanceData;
2193     int errorCode = 0;
2194
2195     /*
2196      * Delete a file handler that may be active for this socket if this
2197      * is a server socket - the file handler was created automatically
2198      * by Tcl as part of the mechanism to accept new client connections.
2199      * Channel handlers are already deleted in the generic IO channel
2200      * closing code that called this function, so we do not have to
2201      * delete them here.
2202      */
2203
2204     Tcl_DeleteFileHandler(statePtr->fd);
2205
2206     if (close(statePtr->fd) < 0) {
2207         errorCode = errno;
2208     }
2209     ckfree((char *) statePtr);
2210
2211     return errorCode;
2212 }
2213 \f
2214 /*
2215  *----------------------------------------------------------------------
2216  *
2217  * TcpGetOptionProc --
2218  *
2219  *      Computes an option value for a TCP socket based channel, or a
2220  *      list of all options and their values.
2221  *
2222  *      Note: This code is based on code contributed by John Haxby.
2223  *
2224  * Results:
2225  *      A standard Tcl result. The value of the specified option or a
2226  *      list of all options and their values is returned in the
2227  *      supplied DString. Sets Error message if needed.
2228  *
2229  * Side effects:
2230  *      None.
2231  *
2232  *----------------------------------------------------------------------
2233  */
2234
2235 static int
2236 TcpGetOptionProc(instanceData, interp, optionName, dsPtr)
2237     ClientData instanceData;     /* Socket state. */
2238     Tcl_Interp *interp;          /* For error reporting - can be NULL. */
2239     CONST char *optionName;      /* Name of the option to
2240                                   * retrieve the value for, or
2241                                   * NULL to get all options and
2242                                   * their values. */
2243     Tcl_DString *dsPtr;          /* Where to store the computed
2244                                   * value; initialized by caller. */
2245 {
2246     TcpState *statePtr = (TcpState *) instanceData;
2247     struct sockaddr_in sockname;
2248     struct sockaddr_in peername;
2249     struct hostent *hostEntPtr;
2250     socklen_t size = sizeof(struct sockaddr_in);
2251     size_t len = 0;
2252     char buf[TCL_INTEGER_SPACE];
2253
2254     if (optionName != (char *) NULL) {
2255         len = strlen(optionName);
2256     }
2257
2258     if ((len > 1) && (optionName[1] == 'e') &&
2259             (strncmp(optionName, "-error", len) == 0)) {
2260         socklen_t optlen = sizeof(int);
2261         int err, ret;
2262
2263         ret = getsockopt(statePtr->fd, SOL_SOCKET, SO_ERROR,
2264                 (char *)&err, &optlen);
2265         if (ret < 0) {
2266             err = errno;
2267         }
2268         if (err != 0) {
2269             Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(err), -1);
2270         }
2271         return TCL_OK;
2272     }
2273
2274     if ((len == 0) ||
2275             ((len > 1) && (optionName[1] == 'p') &&
2276                     (strncmp(optionName, "-peername", len) == 0))) {
2277         if (getpeername(statePtr->fd, (struct sockaddr *) &peername,
2278                 &size) >= 0) {
2279             if (len == 0) {
2280                 Tcl_DStringAppendElement(dsPtr, "-peername");
2281                 Tcl_DStringStartSublist(dsPtr);
2282             }
2283             Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
2284             hostEntPtr = gethostbyaddr(                 /* INTL: Native. */
2285                     (char *) &peername.sin_addr,
2286                     sizeof(peername.sin_addr), AF_INET);
2287             if (hostEntPtr != NULL) {
2288                 Tcl_DString ds;
2289
2290                 Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
2291                 Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
2292             } else {
2293                 Tcl_DStringAppendElement(dsPtr, inet_ntoa(peername.sin_addr));
2294             }
2295             TclFormatInt(buf, ntohs(peername.sin_port));
2296             Tcl_DStringAppendElement(dsPtr, buf);
2297             if (len == 0) {
2298                 Tcl_DStringEndSublist(dsPtr);
2299             } else {
2300                 return TCL_OK;
2301             }
2302         } else {
2303             /*
2304              * getpeername failed - but if we were asked for all the options
2305              * (len==0), don't flag an error at that point because it could
2306              * be an fconfigure request on a server socket. (which have
2307              * no peer). same must be done on win&mac.
2308              */
2309
2310             if (len) {
2311                 if (interp) {
2312                     Tcl_AppendResult(interp, "can't get peername: ",
2313                             Tcl_PosixError(interp), (char *) NULL);
2314                 }
2315                 return TCL_ERROR;
2316             }
2317         }
2318     }
2319
2320     if ((len == 0) ||
2321             ((len > 1) && (optionName[1] == 's') &&
2322             (strncmp(optionName, "-sockname", len) == 0))) {
2323         if (getsockname(statePtr->fd, (struct sockaddr *) &sockname,
2324                 &size) >= 0) {
2325             if (len == 0) {
2326                 Tcl_DStringAppendElement(dsPtr, "-sockname");
2327                 Tcl_DStringStartSublist(dsPtr);
2328             }
2329             Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
2330             hostEntPtr = gethostbyaddr(                 /* INTL: Native. */
2331                     (char *) &sockname.sin_addr,
2332                     sizeof(sockname.sin_addr), AF_INET);
2333             if (hostEntPtr != (struct hostent *) NULL) {
2334                 Tcl_DString ds;
2335
2336                 Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
2337                 Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
2338             } else {
2339                 Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
2340             }
2341             TclFormatInt(buf, ntohs(sockname.sin_port));
2342             Tcl_DStringAppendElement(dsPtr, buf);
2343             if (len == 0) {
2344                 Tcl_DStringEndSublist(dsPtr);
2345             } else {
2346                 return TCL_OK;
2347             }
2348         } else {
2349             if (interp) {
2350                 Tcl_AppendResult(interp, "can't get sockname: ",
2351                         Tcl_PosixError(interp), (char *) NULL);
2352             }
2353             return TCL_ERROR;
2354         }
2355     }
2356
2357     if (len > 0) {
2358         return Tcl_BadChannelOption(interp, optionName, "peername sockname");
2359     }
2360
2361     return TCL_OK;
2362 }
2363 \f
2364 /*
2365  *----------------------------------------------------------------------
2366  *
2367  * TcpWatchProc --
2368  *
2369  *      Initialize the notifier to watch the fd from this channel.
2370  *
2371  * Results:
2372  *      None.
2373  *
2374  * Side effects:
2375  *      Sets up the notifier so that a future event on the channel will
2376  *      be seen by Tcl.
2377  *
2378  *----------------------------------------------------------------------
2379  */
2380
2381 static void
2382 TcpWatchProc(instanceData, mask)
2383     ClientData instanceData;            /* The socket state. */
2384     int mask;                           /* Events of interest; an OR-ed
2385                                          * combination of TCL_READABLE,
2386                                          * TCL_WRITABLE and TCL_EXCEPTION. */
2387 {
2388     TcpState *statePtr = (TcpState *) instanceData;
2389
2390     /*
2391      * Make sure we don't mess with server sockets since they will never
2392      * be readable or writable at the Tcl level.  This keeps Tcl scripts
2393      * from interfering with the -accept behavior.
2394      */
2395
2396     if (!statePtr->acceptProc) {
2397         if (mask) {
2398             Tcl_CreateFileHandler(statePtr->fd, mask,
2399                     (Tcl_FileProc *) Tcl_NotifyChannel,
2400                     (ClientData) statePtr->channel);
2401         } else {
2402             Tcl_DeleteFileHandler(statePtr->fd);
2403         }
2404     }
2405 }
2406 \f
2407 /*
2408  *----------------------------------------------------------------------
2409  *
2410  * TcpGetHandleProc --
2411  *
2412  *      Called from Tcl_GetChannelHandle to retrieve OS handles from inside
2413  *      a TCP socket based channel.
2414  *
2415  * Results:
2416  *      Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if
2417  *      there is no handle for the specified direction.
2418  *
2419  * Side effects:
2420  *      None.
2421  *
2422  *----------------------------------------------------------------------
2423  */
2424
2425         /* ARGSUSED */
2426 static int
2427 TcpGetHandleProc(instanceData, direction, handlePtr)
2428     ClientData instanceData;    /* The socket state. */
2429     int direction;              /* Not used. */
2430     ClientData *handlePtr;      /* Where to store the handle.  */
2431 {
2432     TcpState *statePtr = (TcpState *) instanceData;
2433
2434     *handlePtr = (ClientData)statePtr->fd;
2435     return TCL_OK;
2436 }
2437 \f
2438 /*
2439  *----------------------------------------------------------------------
2440  *
2441  * CreateSocket --
2442  *
2443  *      This function opens a new socket in client or server mode
2444  *      and initializes the TcpState structure.
2445  *
2446  * Results:
2447  *      Returns a new TcpState, or NULL with an error in the interp's
2448  *      result, if interp is not NULL.
2449  *
2450  * Side effects:
2451  *      Opens a socket.
2452  *
2453  *----------------------------------------------------------------------
2454  */
2455
2456 static TcpState *
2457 CreateSocket(interp, port, host, server, myaddr, myport, async)
2458     Tcl_Interp *interp;         /* For error reporting; can be NULL. */
2459     int port;                   /* Port number to open. */
2460     CONST char *host;           /* Name of host on which to open port.
2461                                  * NULL implies INADDR_ANY */
2462     int server;                 /* 1 if socket should be a server socket,
2463                                  * else 0 for a client socket. */
2464     CONST char *myaddr;         /* Optional client-side address */
2465     int myport;                 /* Optional client-side port */
2466     int async;                  /* If nonzero and creating a client socket,
2467                                  * attempt to do an async connect. Otherwise
2468                                  * do a synchronous connect or bind. */
2469 {
2470     int status, sock, asyncConnect, curState, origState;
2471     struct sockaddr_in sockaddr;        /* socket address */
2472     struct sockaddr_in mysockaddr;      /* Socket address for client */
2473     TcpState *statePtr;
2474
2475     sock = -1;
2476     origState = 0;
2477     if (! CreateSocketAddress(&sockaddr, host, port)) {
2478         goto addressError;
2479     }
2480     if ((myaddr != NULL || myport != 0) &&
2481             ! CreateSocketAddress(&mysockaddr, myaddr, myport)) {
2482         goto addressError;
2483     }
2484
2485     sock = socket(AF_INET, SOCK_STREAM, 0);
2486     if (sock < 0) {
2487         goto addressError;
2488     }
2489
2490     /*
2491      * Set the close-on-exec flag so that the socket will not get
2492      * inherited by child processes.
2493      */
2494
2495     fcntl(sock, F_SETFD, FD_CLOEXEC);
2496
2497     /*
2498      * Set kernel space buffering
2499      */
2500
2501     TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
2502
2503     asyncConnect = 0;
2504     status = 0;
2505     if (server) {
2506         /*
2507          * Set up to reuse server addresses automatically and bind to the
2508          * specified port.
2509          */
2510
2511         status = 1;
2512         (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
2513                 sizeof(status));
2514         status = bind(sock, (struct sockaddr *) &sockaddr,
2515                 sizeof(struct sockaddr));
2516         if (status != -1) {
2517             status = listen(sock, SOMAXCONN);
2518         }
2519     } else {
2520         if (myaddr != NULL || myport != 0) {
2521             curState = 1;
2522             (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
2523                     (char *) &curState, sizeof(curState));
2524             status = bind(sock, (struct sockaddr *) &mysockaddr,
2525                     sizeof(struct sockaddr));
2526             if (status < 0) {
2527                 goto bindError;
2528             }
2529         }
2530
2531         /*
2532          * Attempt to connect. The connect may fail at present with an
2533          * EINPROGRESS but at a later time it will complete. The caller
2534          * will set up a file handler on the socket if she is interested in
2535          * being informed when the connect completes.
2536          */
2537
2538         if (async) {
2539 #ifndef USE_FIONBIO
2540             origState = fcntl(sock, F_GETFL);
2541             curState = origState | O_NONBLOCK;
2542             status = fcntl(sock, F_SETFL, curState);
2543 #else /* USE_FIONBIO */
2544             curState = 1;
2545             status = ioctl(sock, FIONBIO, &curState);
2546 #endif /* !USE_FIONBIO */
2547         } else {
2548             status = 0;
2549         }
2550         if (status > -1) {
2551             status = connect(sock, (struct sockaddr *) &sockaddr,
2552                     sizeof(sockaddr));
2553             if (status < 0) {
2554                 if (errno == EINPROGRESS) {
2555                     asyncConnect = 1;
2556                     status = 0;
2557                 }
2558             } else {
2559                 /*
2560                  * Here we are if the connect succeeds. In case of an
2561                  * asynchronous connect we have to reset the channel to
2562                  * blocking mode.  This appears to happen not very often,
2563                  * but e.g. on a HP 9000/800 under HP-UX B.11.00 we enter
2564                  * this stage. [Bug: 4388]
2565                  */
2566                 if (async) {
2567 #ifndef USE_FIONBIO
2568                     origState = fcntl(sock, F_GETFL);
2569                     curState = origState & ~(O_NONBLOCK);
2570                     status = fcntl(sock, F_SETFL, curState);
2571 #else /* USE_FIONBIO */
2572                     curState = 0;
2573                     status = ioctl(sock, FIONBIO, &curState);
2574 #endif /* !USE_FIONBIO */
2575                 }
2576             }
2577         }
2578     }
2579
2580 bindError:
2581     if (status < 0) {
2582         if (interp != NULL) {
2583             Tcl_AppendResult(interp, "couldn't open socket: ",
2584                     Tcl_PosixError(interp), (char *) NULL);
2585         }
2586         if (sock != -1) {
2587             close(sock);
2588         }
2589         return NULL;
2590     }
2591
2592     /*
2593      * Allocate a new TcpState for this socket.
2594      */
2595
2596     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2597     statePtr->flags = 0;
2598     if (asyncConnect) {
2599         statePtr->flags = TCP_ASYNC_CONNECT;
2600     }
2601     statePtr->fd = sock;
2602
2603     return statePtr;
2604
2605 addressError:
2606     if (sock != -1) {
2607         close(sock);
2608     }
2609     if (interp != NULL) {
2610         Tcl_AppendResult(interp, "couldn't open socket: ",
2611                 Tcl_PosixError(interp), (char *) NULL);
2612     }
2613     return NULL;
2614 }
2615 \f
2616 /*
2617  *----------------------------------------------------------------------
2618  *
2619  * CreateSocketAddress --
2620  *
2621  *      This function initializes a sockaddr structure for a host and port.
2622  *
2623  * Results:
2624  *      1 if the host was valid, 0 if the host could not be converted to
2625  *      an IP address.
2626  *
2627  * Side effects:
2628  *      Fills in the *sockaddrPtr structure.
2629  *
2630  *----------------------------------------------------------------------
2631  */
2632
2633 static int
2634 CreateSocketAddress(sockaddrPtr, host, port)
2635     struct sockaddr_in *sockaddrPtr;    /* Socket address */
2636     CONST char *host;                   /* Host.  NULL implies INADDR_ANY */
2637     int port;                           /* Port number */
2638 {
2639     struct hostent *hostent;            /* Host database entry */
2640     struct in_addr addr;                /* For 64/32 bit madness */
2641
2642     (void) memset((VOID *) sockaddrPtr, '\0', sizeof(struct sockaddr_in));
2643     sockaddrPtr->sin_family = AF_INET;
2644     sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
2645     if (host == NULL) {
2646         addr.s_addr = INADDR_ANY;
2647     } else {
2648         Tcl_DString ds;
2649         CONST char *native;
2650
2651         if (host == NULL) {
2652             native = NULL;
2653         } else {
2654             native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
2655         }
2656         addr.s_addr = inet_addr(native);                /* INTL: Native. */
2657         /*
2658          * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1
2659          * on either 32 or 64 bits systems.
2660          */
2661         if (addr.s_addr == 0xFFFFFFFF) {
2662             hostent = gethostbyname(native);            /* INTL: Native. */
2663             if (hostent != NULL) {
2664                 memcpy((VOID *) &addr,
2665                         (VOID *) hostent->h_addr_list[0],
2666                         (size_t) hostent->h_length);
2667             } else {
2668 #ifdef  EHOSTUNREACH
2669                 errno = EHOSTUNREACH;
2670 #else /* !EHOSTUNREACH */
2671 #ifdef ENXIO
2672                 errno = ENXIO;
2673 #endif /* ENXIO */
2674 #endif /* EHOSTUNREACH */
2675                 if (native != NULL) {
2676                     Tcl_DStringFree(&ds);
2677                 }
2678                 return 0;       /* error */
2679             }
2680         }
2681         if (native != NULL) {
2682             Tcl_DStringFree(&ds);
2683         }
2684     }
2685
2686     /*
2687      * NOTE: On 64 bit machines the assignment below is rumored to not
2688      * do the right thing. Please report errors related to this if you
2689      * observe incorrect behavior on 64 bit machines such as DEC Alphas.
2690      * Should we modify this code to do an explicit memcpy?
2691      */
2692
2693     sockaddrPtr->sin_addr.s_addr = addr.s_addr;
2694     return 1;   /* Success. */
2695 }
2696 \f
2697 /*
2698  *----------------------------------------------------------------------
2699  *
2700  * Tcl_OpenTcpClient --
2701  *
2702  *      Opens a TCP client socket and creates a channel around it.
2703  *
2704  * Results:
2705  *      The channel or NULL if failed.  An error message is returned
2706  *      in the interpreter on failure.
2707  *
2708  * Side effects:
2709  *      Opens a client socket and creates a new channel.
2710  *
2711  *----------------------------------------------------------------------
2712  */
2713
2714 Tcl_Channel
2715 Tcl_OpenTcpClient(interp, port, host, myaddr, myport, async)
2716     Tcl_Interp *interp;                 /* For error reporting; can be NULL. */
2717     int port;                           /* Port number to open. */
2718     CONST char *host;                   /* Host on which to open port. */
2719     CONST char *myaddr;                 /* Client-side address */
2720     int myport;                         /* Client-side port */
2721     int async;                          /* If nonzero, attempt to do an
2722                                          * asynchronous connect. Otherwise
2723                                          * we do a blocking connect. */
2724 {
2725     TcpState *statePtr;
2726     char channelName[16 + TCL_INTEGER_SPACE];
2727
2728     /*
2729      * Create a new client socket and wrap it in a channel.
2730      */
2731
2732     statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
2733     if (statePtr == NULL) {
2734         return NULL;
2735     }
2736
2737     statePtr->acceptProc = NULL;
2738     statePtr->acceptProcData = (ClientData) NULL;
2739
2740     sprintf(channelName, "sock%d", statePtr->fd);
2741
2742     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2743             (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
2744     if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
2745             "auto crlf") == TCL_ERROR) {
2746         Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
2747         return NULL;
2748     }
2749     return statePtr->channel;
2750 }
2751 \f
2752 /*
2753  *----------------------------------------------------------------------
2754  *
2755  * Tcl_MakeTcpClientChannel --
2756  *
2757  *      Creates a Tcl_Channel from an existing client TCP socket.
2758  *
2759  * Results:
2760  *      The Tcl_Channel wrapped around the preexisting TCP socket.
2761  *
2762  * Side effects:
2763  *      None.
2764  *
2765  *----------------------------------------------------------------------
2766  */
2767
2768 Tcl_Channel
2769 Tcl_MakeTcpClientChannel(sock)
2770     ClientData sock;            /* The socket to wrap up into a channel. */
2771 {
2772     TcpState *statePtr;
2773     char channelName[16 + TCL_INTEGER_SPACE];
2774
2775     statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2776     statePtr->fd = (int) sock;
2777     statePtr->flags = 0;
2778     statePtr->acceptProc = NULL;
2779     statePtr->acceptProcData = (ClientData) NULL;
2780
2781     sprintf(channelName, "sock%d", statePtr->fd);
2782
2783     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2784             (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
2785     if (Tcl_SetChannelOption((Tcl_Interp *) NULL, statePtr->channel,
2786             "-translation", "auto crlf") == TCL_ERROR) {
2787         Tcl_Close((Tcl_Interp *) NULL, statePtr->channel);
2788         return NULL;
2789     }
2790     return statePtr->channel;
2791 }
2792 \f
2793 /*
2794  *----------------------------------------------------------------------
2795  *
2796  * Tcl_OpenTcpServer --
2797  *
2798  *      Opens a TCP server socket and creates a channel around it.
2799  *
2800  * Results:
2801  *      The channel or NULL if failed. If an error occurred, an
2802  *      error message is left in the interp's result if interp is
2803  *      not NULL.
2804  *
2805  * Side effects:
2806  *      Opens a server socket and creates a new channel.
2807  *
2808  *----------------------------------------------------------------------
2809  */
2810
2811 Tcl_Channel
2812 Tcl_OpenTcpServer(interp, port, myHost, acceptProc, acceptProcData)
2813     Tcl_Interp *interp;                 /* For error reporting - may be
2814                                          * NULL. */
2815     int port;                           /* Port number to open. */
2816     CONST char *myHost;                 /* Name of local host. */
2817     Tcl_TcpAcceptProc *acceptProc;      /* Callback for accepting connections
2818                                          * from new clients. */
2819     ClientData acceptProcData;          /* Data for the callback. */
2820 {
2821     TcpState *statePtr;
2822     char channelName[16 + TCL_INTEGER_SPACE];
2823
2824     /*
2825      * Create a new client socket and wrap it in a channel.
2826      */
2827
2828     statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
2829     if (statePtr == NULL) {
2830         return NULL;
2831     }
2832
2833     statePtr->acceptProc = acceptProc;
2834     statePtr->acceptProcData = acceptProcData;
2835
2836     /*
2837      * Set up the callback mechanism for accepting connections
2838      * from new clients.
2839      */
2840
2841     Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
2842             (ClientData) statePtr);
2843     sprintf(channelName, "sock%d", statePtr->fd);
2844     statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2845             (ClientData) statePtr, 0);
2846     return statePtr->channel;
2847 }
2848 \f
2849 /*
2850  *----------------------------------------------------------------------
2851  *
2852  * TcpAccept --
2853  *      Accept a TCP socket connection.  This is called by the event loop.
2854  *
2855  * Results:
2856  *      None.
2857  *
2858  * Side effects:
2859  *      Creates a new connection socket. Calls the registered callback
2860  *      for the connection acceptance mechanism.
2861  *
2862  *----------------------------------------------------------------------
2863  */
2864
2865         /* ARGSUSED */
2866 static void
2867 TcpAccept(data, mask)
2868     ClientData data;                    /* Callback token. */
2869     int mask;                           /* Not used. */
2870 {
2871     TcpState *sockState;                /* Client data of server socket. */
2872     int newsock;                        /* The new client socket */
2873     TcpState *newSockState;             /* State for new socket. */
2874     struct sockaddr_in addr;            /* The remote address */
2875     socklen_t len;                              /* For accept interface */
2876     char channelName[16 + TCL_INTEGER_SPACE];
2877
2878     sockState = (TcpState *) data;
2879
2880     len = sizeof(struct sockaddr_in);
2881     newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
2882     if (newsock < 0) {
2883         return;
2884     }
2885
2886     /*
2887      * Set close-on-exec flag to prevent the newly accepted socket from
2888      * being inherited by child processes.
2889      */
2890
2891     (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
2892
2893     newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2894
2895     newSockState->flags = 0;
2896     newSockState->fd = newsock;
2897     newSockState->acceptProc = NULL;
2898     newSockState->acceptProcData = NULL;
2899
2900     sprintf(channelName, "sock%d", newsock);
2901     newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2902             (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
2903
2904     Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
2905             "auto crlf");
2906
2907     if (sockState->acceptProc != NULL) {
2908         (*sockState->acceptProc)(sockState->acceptProcData,
2909                 newSockState->channel, inet_ntoa(addr.sin_addr),
2910                 ntohs(addr.sin_port));
2911     }
2912 }
2913 \f
2914 /*
2915  *----------------------------------------------------------------------
2916  *
2917  * TclpGetDefaultStdChannel --
2918  *
2919  *      Creates channels for standard input, standard output or standard
2920  *      error output if they do not already exist.
2921  *
2922  * Results:
2923  *      Returns the specified default standard channel, or NULL.
2924  *
2925  * Side effects:
2926  *      May cause the creation of a standard channel and the underlying
2927  *      file.
2928  *
2929  *----------------------------------------------------------------------
2930  */
2931
2932 Tcl_Channel
2933 TclpGetDefaultStdChannel(type)
2934     int type;                   /* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
2935 {
2936     Tcl_Channel channel = NULL;
2937     int fd = 0;                 /* Initializations needed to prevent */
2938     int mode = 0;               /* compiler warning (used before set). */
2939     char *bufMode = NULL;
2940
2941     /*
2942      * Some #def's to make the code a little clearer!
2943      */
2944 #define ZERO_OFFSET     ((Tcl_SeekOffset) 0)
2945 #define ERROR_OFFSET    ((Tcl_SeekOffset) -1)
2946
2947     switch (type) {
2948         case TCL_STDIN:
2949             if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
2950                     && (errno == EBADF)) {
2951                 return (Tcl_Channel) NULL;
2952             }
2953             fd = 0;
2954             mode = TCL_READABLE;
2955             bufMode = "line";
2956             break;
2957         case TCL_STDOUT:
2958             if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
2959                     && (errno == EBADF)) {
2960                 return (Tcl_Channel) NULL;
2961             }
2962             fd = 1;
2963             mode = TCL_WRITABLE;
2964             bufMode = "line";
2965             break;
2966         case TCL_STDERR:
2967             if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
2968                     && (errno == EBADF)) {
2969                 return (Tcl_Channel) NULL;
2970             }
2971             fd = 2;
2972             mode = TCL_WRITABLE;
2973             bufMode = "none";
2974             break;
2975         default:
2976             panic("TclGetDefaultStdChannel: Unexpected channel type");
2977             break;
2978     }
2979
2980 #undef ZERO_OFFSET
2981 #undef ERROR_OFFSET
2982
2983     channel = Tcl_MakeFileChannel((ClientData) fd, mode);
2984     if (channel == NULL) {
2985         return NULL;
2986     }
2987
2988     /*
2989      * Set up the normal channel options for stdio handles.
2990      */
2991
2992     if (Tcl_GetChannelType(channel) == &fileChannelType) {
2993         Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
2994     } else {
2995         Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf");
2996     }
2997     Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
2998     return channel;
2999 }
3000 \f
3001 /*
3002  *----------------------------------------------------------------------
3003  *
3004  * Tcl_GetOpenFile --
3005  *
3006  *      Given a name of a channel registered in the given interpreter,
3007  *      returns a FILE * for it.
3008  *
3009  * Results:
3010  *      A standard Tcl result. If the channel is registered in the given
3011  *      interpreter and it is managed by the "file" channel driver, and
3012  *      it is open for the requested mode, then the output parameter
3013  *      filePtr is set to a FILE * for the underlying file. On error, the
3014  *      filePtr is not set, TCL_ERROR is returned and an error message is
3015  *      left in the interp's result.
3016  *
3017  * Side effects:
3018  *      May invoke fdopen to create the FILE * for the requested file.
3019  *
3020  *----------------------------------------------------------------------
3021  */
3022
3023 int
3024 Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
3025     Tcl_Interp *interp;         /* Interpreter in which to find file. */
3026     CONST char *string;         /* String that identifies file. */
3027     int forWriting;             /* 1 means the file is going to be used
3028                                  * for writing, 0 means for reading. */
3029     int checkUsage;             /* 1 means verify that the file was opened
3030                                  * in a mode that allows the access specified
3031                                  * by "forWriting". Ignored, we always
3032                                  * check that the channel is open for the
3033                                  * requested mode. */
3034     ClientData *filePtr;        /* Store pointer to FILE structure here. */
3035 {
3036     Tcl_Channel chan;
3037     int chanMode;
3038     Tcl_ChannelType *chanTypePtr;
3039     ClientData data;
3040     int fd;
3041     FILE *f;
3042
3043     chan = Tcl_GetChannel(interp, string, &chanMode);
3044     if (chan == (Tcl_Channel) NULL) {
3045         return TCL_ERROR;
3046     }
3047     if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
3048         Tcl_AppendResult(interp,
3049                 "\"", string, "\" wasn't opened for writing", (char *) NULL);
3050         return TCL_ERROR;
3051     } else if ((!(forWriting)) && ((chanMode & TCL_READABLE) == 0)) {
3052         Tcl_AppendResult(interp,
3053                 "\"", string, "\" wasn't opened for reading", (char *) NULL);
3054         return TCL_ERROR;
3055     }
3056
3057     /*
3058      * We allow creating a FILE * out of file based, pipe based and socket
3059      * based channels. We currently do not allow any other channel types,
3060      * because it is likely that stdio will not know what to do with them.
3061      */
3062
3063     chanTypePtr = Tcl_GetChannelType(chan);
3064     if ((chanTypePtr == &fileChannelType)
3065 #ifdef SUPPORTS_TTY
3066             || (chanTypePtr == &ttyChannelType)
3067 #endif /* SUPPORTS_TTY */
3068             || (chanTypePtr == &tcpChannelType)
3069             || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
3070         if (Tcl_GetChannelHandle(chan,
3071                 (forWriting ? TCL_WRITABLE : TCL_READABLE),
3072                 (ClientData*) &data) == TCL_OK) {
3073             fd = (int) data;
3074
3075             /*
3076              * The call to fdopen below is probably dangerous, since it will
3077              * truncate an existing file if the file is being opened
3078              * for writing....
3079              */
3080
3081             f = fdopen(fd, (forWriting ? "w" : "r"));
3082             if (f == NULL) {
3083                 Tcl_AppendResult(interp, "cannot get a FILE * for \"", string,
3084                         "\"", (char *) NULL);
3085                 return TCL_ERROR;
3086             }
3087             *filePtr = (ClientData) f;
3088             return TCL_OK;
3089         }
3090     }
3091
3092     Tcl_AppendResult(interp, "\"", string,
3093             "\" cannot be used to get a FILE *", (char *) NULL);
3094     return TCL_ERROR;
3095 }
3096 \f
3097 /*
3098  *----------------------------------------------------------------------
3099  *
3100  * TclUnixWaitForFile --
3101  *
3102  *      This procedure waits synchronously for a file to become readable
3103  *      or writable, with an optional timeout.
3104  *
3105  * Results:
3106  *      The return value is an OR'ed combination of TCL_READABLE,
3107  *      TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions
3108  *      that are present on file at the time of the return.  This
3109  *      procedure will not return until either "timeout" milliseconds
3110  *      have elapsed or at least one of the conditions given by mask
3111  *      has occurred for file (a return value of 0 means that a timeout
3112  *      occurred).  No normal events will be serviced during the
3113  *      execution of this procedure.
3114  *
3115  * Side effects:
3116  *      Time passes.
3117  *
3118  *----------------------------------------------------------------------
3119  */
3120
3121 int
3122 TclUnixWaitForFile(fd, mask, timeout)
3123     int fd;                     /* Handle for file on which to wait. */
3124     int mask;                   /* What to wait for: OR'ed combination of
3125                                  * TCL_READABLE, TCL_WRITABLE, and
3126                                  * TCL_EXCEPTION. */
3127     int timeout;                /* Maximum amount of time to wait for one
3128                                  * of the conditions in mask to occur, in
3129                                  * milliseconds.  A value of 0 means don't
3130                                  * wait at all, and a value of -1 means
3131                                  * wait forever. */
3132 {
3133     Tcl_Time abortTime, now;
3134     struct timeval blockTime, *timeoutPtr;
3135     int index, bit, numFound, result = 0;
3136     fd_mask readyMasks[3*MASK_SIZE];
3137                                 /* This array reflects the readable/writable
3138                                  * conditions that were found to exist by the
3139                                  * last call to select. */
3140
3141     /*
3142      * If there is a non-zero finite timeout, compute the time when
3143      * we give up.
3144      */
3145
3146     if (timeout > 0) {
3147         Tcl_GetTime(&now);
3148         abortTime.sec = now.sec + timeout/1000;
3149         abortTime.usec = now.usec + (timeout%1000)*1000;
3150         if (abortTime.usec >= 1000000) {
3151             abortTime.usec -= 1000000;
3152             abortTime.sec += 1;
3153         }
3154         timeoutPtr = &blockTime;
3155     } else if (timeout == 0) {
3156         timeoutPtr = &blockTime;
3157         blockTime.tv_sec = 0;
3158         blockTime.tv_usec = 0;
3159     } else {
3160         timeoutPtr = NULL;
3161     }
3162
3163     /*
3164      * Initialize the ready masks and compute the mask offsets.
3165      */
3166
3167     if (fd >= FD_SETSIZE) {
3168         panic("TclWaitForFile can't handle file id %d", fd);
3169     }
3170     memset((VOID *) readyMasks, 0, 3*MASK_SIZE*sizeof(fd_mask));
3171     index = fd/(NBBY*sizeof(fd_mask));
3172     bit = 1 << (fd%(NBBY*sizeof(fd_mask)));
3173
3174     /*
3175      * Loop in a mini-event loop of our own, waiting for either the
3176      * file to become ready or a timeout to occur.
3177      */
3178
3179     while (1) {
3180         if (timeout > 0) {
3181             blockTime.tv_sec = abortTime.sec - now.sec;
3182             blockTime.tv_usec = abortTime.usec - now.usec;
3183             if (blockTime.tv_usec < 0) {
3184                 blockTime.tv_sec -= 1;
3185                 blockTime.tv_usec += 1000000;
3186             }
3187             if (blockTime.tv_sec < 0) {
3188                 blockTime.tv_sec = 0;
3189                 blockTime.tv_usec = 0;
3190             }
3191         }
3192
3193         /*
3194          * Set the appropriate bit in the ready masks for the fd.
3195          */
3196
3197         if (mask & TCL_READABLE) {
3198             readyMasks[index] |= bit;
3199         }
3200         if (mask & TCL_WRITABLE) {
3201             (readyMasks+MASK_SIZE)[index] |= bit;
3202         }
3203         if (mask & TCL_EXCEPTION) {
3204             (readyMasks+2*(MASK_SIZE))[index] |= bit;
3205         }
3206
3207         /*
3208          * Wait for the event or a timeout.
3209          */
3210
3211         numFound = select(fd+1, (SELECT_MASK *) &readyMasks[0],
3212                 (SELECT_MASK *) &readyMasks[MASK_SIZE],
3213                 (SELECT_MASK *) &readyMasks[2*MASK_SIZE], timeoutPtr);
3214         if (numFound == 1) {
3215             if (readyMasks[index] & bit) {
3216                 result |= TCL_READABLE;
3217             }
3218             if ((readyMasks+MASK_SIZE)[index] & bit) {
3219                 result |= TCL_WRITABLE;
3220             }
3221             if ((readyMasks+2*(MASK_SIZE))[index] & bit) {
3222                 result |= TCL_EXCEPTION;
3223             }
3224             result &= mask;
3225             if (result) {
3226                 break;
3227             }
3228         }
3229         if (timeout == 0) {
3230             break;
3231         }
3232
3233         /*
3234          * The select returned early, so we need to recompute the timeout.
3235          */
3236
3237         Tcl_GetTime(&now);
3238         if ((abortTime.sec < now.sec)
3239                 || ((abortTime.sec == now.sec)
3240                 && (abortTime.usec <= now.usec))) {
3241             break;
3242         }
3243     }
3244     return result;
3245 }