Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/unix/tclUnixChan.c @ 52

Last change on this file since 52 was 25, checked in by landauf, 17 years ago

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