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.2.5 2010/03/01 15:25:27 ferrieux 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            if (sockname.sin_addr.s_addr == INADDR_ANY) {
2142		/*
2143		 * We don't want to resolve INADDR_ANY; it can sometimes cause
2144		 * problems (and never has a name).
2145		 */
2146
2147                hostEntPtr = NULL;
2148            } else {
2149                hostEntPtr = TclpGetHostByAddr(		/* INTL: Native. */
2150                                               (char *) &sockname.sin_addr,
2151                                               sizeof(sockname.sin_addr), AF_INET);
2152            }
2153	    if (hostEntPtr != NULL) {
2154		Tcl_DString ds;
2155
2156		Tcl_ExternalToUtfDString(NULL, hostEntPtr->h_name, -1, &ds);
2157		Tcl_DStringAppendElement(dsPtr, Tcl_DStringValue(&ds));
2158		Tcl_DStringFree(&ds);
2159	    } else {
2160		Tcl_DStringAppendElement(dsPtr, inet_ntoa(sockname.sin_addr));
2161	    }
2162	    TclFormatInt(buf, ntohs(sockname.sin_port));
2163	    Tcl_DStringAppendElement(dsPtr, buf);
2164	    if (len == 0) {
2165		Tcl_DStringEndSublist(dsPtr);
2166	    } else {
2167		return TCL_OK;
2168	    }
2169	} else {
2170	    if (interp) {
2171		Tcl_AppendResult(interp, "can't get sockname: ",
2172			Tcl_PosixError(interp), NULL);
2173	    }
2174	    return TCL_ERROR;
2175	}
2176    }
2177
2178    if (len > 0) {
2179	return Tcl_BadChannelOption(interp, optionName, "peername sockname");
2180    }
2181
2182    return TCL_OK;
2183}
2184
2185/*
2186 *----------------------------------------------------------------------
2187 *
2188 * TcpWatchProc --
2189 *
2190 *	Initialize the notifier to watch the fd from this channel.
2191 *
2192 * Results:
2193 *	None.
2194 *
2195 * Side effects:
2196 *	Sets up the notifier so that a future event on the channel will be
2197 *	seen by Tcl.
2198 *
2199 *----------------------------------------------------------------------
2200 */
2201
2202static void
2203TcpWatchProc(
2204    ClientData instanceData,	/* The socket state. */
2205    int mask)			/* Events of interest; an OR-ed combination of
2206				 * TCL_READABLE, TCL_WRITABLE and
2207				 * TCL_EXCEPTION. */
2208{
2209    TcpState *statePtr = (TcpState *) instanceData;
2210
2211    /*
2212     * Make sure we don't mess with server sockets since they will never be
2213     * readable or writable at the Tcl level. This keeps Tcl scripts from
2214     * interfering with the -accept behavior.
2215     */
2216
2217    if (!statePtr->acceptProc) {
2218	if (mask) {
2219	    Tcl_CreateFileHandler(statePtr->fd, mask,
2220		    (Tcl_FileProc *) Tcl_NotifyChannel,
2221		    (ClientData) statePtr->channel);
2222	} else {
2223	    Tcl_DeleteFileHandler(statePtr->fd);
2224	}
2225    }
2226}
2227
2228/*
2229 *----------------------------------------------------------------------
2230 *
2231 * TcpGetHandleProc --
2232 *
2233 *	Called from Tcl_GetChannelHandle to retrieve OS handles from inside a
2234 *	TCP socket based channel.
2235 *
2236 * Results:
2237 *	Returns TCL_OK with the fd in handlePtr, or TCL_ERROR if there is no
2238 *	handle for the specified direction.
2239 *
2240 * Side effects:
2241 *	None.
2242 *
2243 *----------------------------------------------------------------------
2244 */
2245
2246	/* ARGSUSED */
2247static int
2248TcpGetHandleProc(
2249    ClientData instanceData,	/* The socket state. */
2250    int direction,		/* Not used. */
2251    ClientData *handlePtr)	/* Where to store the handle. */
2252{
2253    TcpState *statePtr = (TcpState *) instanceData;
2254
2255    *handlePtr = (ClientData) INT2PTR(statePtr->fd);
2256    return TCL_OK;
2257}
2258
2259/*
2260 *----------------------------------------------------------------------
2261 *
2262 * CreateSocket --
2263 *
2264 *	This function opens a new socket in client or server mode and
2265 *	initializes the TcpState structure.
2266 *
2267 * Results:
2268 *	Returns a new TcpState, or NULL with an error in the interp's result,
2269 *	if interp is not NULL.
2270 *
2271 * Side effects:
2272 *	Opens a socket.
2273 *
2274 *----------------------------------------------------------------------
2275 */
2276
2277static TcpState *
2278CreateSocket(
2279    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
2280    int port,			/* Port number to open. */
2281    const char *host,		/* Name of host on which to open port. NULL
2282				 * implies INADDR_ANY */
2283    int server,			/* 1 if socket should be a server socket, else
2284				 * 0 for a client socket. */
2285    const char *myaddr,		/* Optional client-side address */
2286    int myport,			/* Optional client-side port */
2287    int async)			/* If nonzero and creating a client socket,
2288				 * attempt to do an async connect. Otherwise
2289				 * do a synchronous connect or bind. */
2290{
2291    int status, sock, asyncConnect, curState;
2292    struct sockaddr_in sockaddr;	/* socket address */
2293    struct sockaddr_in mysockaddr;	/* Socket address for client */
2294    TcpState *statePtr;
2295    const char *errorMsg = NULL;
2296
2297    sock = -1;
2298    if (!CreateSocketAddress(&sockaddr, host, port, 0, &errorMsg)) {
2299	goto addressError;
2300    }
2301    if ((myaddr != NULL || myport != 0) &&
2302	    !CreateSocketAddress(&mysockaddr, myaddr, myport, 1, &errorMsg)) {
2303	goto addressError;
2304    }
2305
2306    sock = socket(AF_INET, SOCK_STREAM, 0);
2307    if (sock < 0) {
2308	goto addressError;
2309    }
2310
2311    /*
2312     * Set the close-on-exec flag so that the socket will not get inherited by
2313     * child processes.
2314     */
2315
2316    fcntl(sock, F_SETFD, FD_CLOEXEC);
2317
2318    /*
2319     * Set kernel space buffering
2320     */
2321
2322    TclSockMinimumBuffers(sock, SOCKET_BUFSIZE);
2323
2324    asyncConnect = 0;
2325    status = 0;
2326    if (server) {
2327	/*
2328	 * Set up to reuse server addresses automatically and bind to the
2329	 * specified port.
2330	 */
2331
2332	status = 1;
2333	(void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR, (char *) &status,
2334		sizeof(status));
2335	status = bind(sock, (struct sockaddr *) &sockaddr,
2336		sizeof(struct sockaddr));
2337	if (status != -1) {
2338	    status = listen(sock, SOMAXCONN);
2339	}
2340    } else {
2341	if (myaddr != NULL || myport != 0) {
2342	    curState = 1;
2343	    (void) setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
2344		    (char *) &curState, sizeof(curState));
2345	    status = bind(sock, (struct sockaddr *) &mysockaddr,
2346		    sizeof(struct sockaddr));
2347	    if (status < 0) {
2348		goto bindError;
2349	    }
2350	}
2351
2352	/*
2353	 * Attempt to connect. The connect may fail at present with an
2354	 * EINPROGRESS but at a later time it will complete. The caller will
2355	 * set up a file handler on the socket if she is interested in being
2356	 * informed when the connect completes.
2357	 */
2358
2359	if (async) {
2360	    status = TclUnixSetBlockingMode(sock, TCL_MODE_NONBLOCKING);
2361	} else {
2362	    status = 0;
2363	}
2364	if (status > -1) {
2365	    status = connect(sock, (struct sockaddr *) &sockaddr,
2366		    sizeof(sockaddr));
2367	    if (status < 0) {
2368		if (errno == EINPROGRESS) {
2369		    asyncConnect = 1;
2370		    status = 0;
2371		}
2372	    } else {
2373		/*
2374		 * Here we are if the connect succeeds. In case of an
2375		 * asynchronous connect we have to reset the channel to
2376		 * blocking mode. This appears to happen not very often, but
2377		 * e.g. on a HP 9000/800 under HP-UX B.11.00 we enter this
2378		 * stage. [Bug: 4388]
2379		 */
2380
2381		if (async) {
2382		    status = TclUnixSetBlockingMode(sock, TCL_MODE_BLOCKING);
2383		}
2384	    }
2385	}
2386    }
2387
2388  bindError:
2389    if (status < 0) {
2390	if (interp != NULL) {
2391	    Tcl_AppendResult(interp, "couldn't open socket: ",
2392		    Tcl_PosixError(interp), NULL);
2393	}
2394	if (sock != -1) {
2395	    close(sock);
2396	}
2397	return NULL;
2398    }
2399
2400    /*
2401     * Allocate a new TcpState for this socket.
2402     */
2403
2404    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2405    statePtr->flags = 0;
2406    if (asyncConnect) {
2407	statePtr->flags = TCP_ASYNC_CONNECT;
2408    }
2409    statePtr->fd = sock;
2410
2411    return statePtr;
2412
2413  addressError:
2414    if (sock != -1) {
2415	close(sock);
2416    }
2417    if (interp != NULL) {
2418	Tcl_AppendResult(interp, "couldn't open socket: ",
2419		Tcl_PosixError(interp), NULL);
2420	if (errorMsg != NULL) {
2421	    Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
2422	}
2423    }
2424    return NULL;
2425}
2426
2427/*
2428 *----------------------------------------------------------------------
2429 *
2430 * CreateSocketAddress --
2431 *
2432 *	This function initializes a sockaddr structure for a host and port.
2433 *
2434 * Results:
2435 *	1 if the host was valid, 0 if the host could not be converted to an IP
2436 *	address.
2437 *
2438 * Side effects:
2439 *	Fills in the *sockaddrPtr structure.
2440 *
2441 *----------------------------------------------------------------------
2442 */
2443
2444static int
2445CreateSocketAddress(
2446    struct sockaddr_in *sockaddrPtr,	/* Socket address */
2447    const char *host,			/* Host. NULL implies INADDR_ANY */
2448    int port,				/* Port number */
2449    int willBind,			/* Is this an address to bind() to or
2450					 * to connect() to? */
2451    const char **errorMsgPtr)		/* Place to store the error message
2452					 * detail, if available. */
2453{
2454#ifdef HAVE_GETADDRINFO
2455    struct addrinfo hints, *resPtr = NULL;
2456    char *native;
2457    Tcl_DString ds;
2458    int result;
2459
2460    if (host == NULL) {
2461	sockaddrPtr->sin_family = AF_INET;
2462	sockaddrPtr->sin_addr.s_addr = INADDR_ANY;
2463    addPort:
2464	sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
2465	return 1;
2466    }
2467
2468    (void) memset(&hints, 0, sizeof(struct addrinfo));
2469    hints.ai_family = AF_INET;
2470    hints.ai_socktype = SOCK_STREAM;
2471    if (willBind) {
2472	hints.ai_flags |= AI_PASSIVE;
2473    }
2474
2475    /*
2476     * Note that getaddrinfo() *is* thread-safe. If a platform doesn't get
2477     * that right, it shouldn't use this part of the code.
2478     */
2479
2480    native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
2481    result = getaddrinfo(native, NULL, &hints, &resPtr);
2482    Tcl_DStringFree(&ds);
2483    if (result == 0) {
2484	memcpy(sockaddrPtr, resPtr->ai_addr, sizeof(struct sockaddr_in));
2485	freeaddrinfo(resPtr);
2486	goto addPort;
2487    }
2488
2489    /*
2490     * Ought to use gai_strerror() here...
2491     */
2492
2493    switch (result) {
2494    case EAI_NONAME:
2495    case EAI_SERVICE:
2496#if defined(EAI_ADDRFAMILY) && EAI_ADDRFAMILY != EAI_NONAME
2497    case EAI_ADDRFAMILY:
2498#endif
2499#if defined(EAI_NODATA) && EAI_NODATA != EAI_NONAME
2500    case EAI_NODATA:
2501#endif
2502	*errorMsgPtr = gai_strerror(result);
2503	errno = EHOSTUNREACH;
2504	return 0;
2505    case EAI_SYSTEM:
2506	return 0;
2507    default:
2508	*errorMsgPtr = gai_strerror(result);
2509	errno = ENXIO;
2510	return 0;
2511    }
2512#else /* !HAVE_GETADDRINFO */
2513    struct in_addr addr;		/* For 64/32 bit madness */
2514
2515    (void) memset(sockaddrPtr, '\0', sizeof(struct sockaddr_in));
2516    sockaddrPtr->sin_family = AF_INET;
2517    sockaddrPtr->sin_port = htons((unsigned short) (port & 0xFFFF));
2518    if (host == NULL) {
2519	addr.s_addr = INADDR_ANY;
2520    } else {
2521	struct hostent *hostent;	/* Host database entry */
2522	Tcl_DString ds;
2523	const char *native;
2524
2525	if (host == NULL) {
2526	    native = NULL;
2527	} else {
2528	    native = Tcl_UtfToExternalDString(NULL, host, -1, &ds);
2529	}
2530	addr.s_addr = inet_addr(native);		/* INTL: Native. */
2531
2532	/*
2533	 * This is 0xFFFFFFFF to ensure that it compares as a 32bit -1 on
2534	 * either 32 or 64 bits systems.
2535	 */
2536
2537	if (addr.s_addr == 0xFFFFFFFF) {
2538	    hostent = TclpGetHostByName(native);	/* INTL: Native. */
2539	    if (hostent != NULL) {
2540		memcpy(&addr, hostent->h_addr_list[0],
2541			(size_t) hostent->h_length);
2542	    } else {
2543#ifdef	EHOSTUNREACH
2544		errno = EHOSTUNREACH;
2545#else /* !EHOSTUNREACH */
2546#ifdef ENXIO
2547		errno = ENXIO;
2548#endif /* ENXIO */
2549#endif /* EHOSTUNREACH */
2550		if (native != NULL) {
2551		    Tcl_DStringFree(&ds);
2552		}
2553		return 0;	/* Error. */
2554	    }
2555	}
2556	if (native != NULL) {
2557	    Tcl_DStringFree(&ds);
2558	}
2559    }
2560
2561    /*
2562     * NOTE: On 64 bit machines the assignment below is rumored to not do the
2563     * right thing. Please report errors related to this if you observe
2564     * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
2565     * modify this code to do an explicit memcpy?
2566     */
2567
2568    sockaddrPtr->sin_addr.s_addr = addr.s_addr;
2569    return 1;			/* Success. */
2570#endif /* HAVE_GETADDRINFO */
2571}
2572
2573/*
2574 *----------------------------------------------------------------------
2575 *
2576 * Tcl_OpenTcpClient --
2577 *
2578 *	Opens a TCP client socket and creates a channel around it.
2579 *
2580 * Results:
2581 *	The channel or NULL if failed. An error message is returned in the
2582 *	interpreter on failure.
2583 *
2584 * Side effects:
2585 *	Opens a client socket and creates a new channel.
2586 *
2587 *----------------------------------------------------------------------
2588 */
2589
2590Tcl_Channel
2591Tcl_OpenTcpClient(
2592    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
2593    int port,			/* Port number to open. */
2594    const char *host,		/* Host on which to open port. */
2595    const char *myaddr,		/* Client-side address */
2596    int myport,			/* Client-side port */
2597    int async)			/* If nonzero, attempt to do an asynchronous
2598				 * connect. Otherwise we do a blocking
2599				 * connect. */
2600{
2601    TcpState *statePtr;
2602    char channelName[16 + TCL_INTEGER_SPACE];
2603
2604    /*
2605     * Create a new client socket and wrap it in a channel.
2606     */
2607
2608    statePtr = CreateSocket(interp, port, host, 0, myaddr, myport, async);
2609    if (statePtr == NULL) {
2610	return NULL;
2611    }
2612
2613    statePtr->acceptProc = NULL;
2614    statePtr->acceptProcData = NULL;
2615
2616    sprintf(channelName, "sock%d", statePtr->fd);
2617
2618    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2619	    (ClientData) statePtr, (TCL_READABLE | TCL_WRITABLE));
2620    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
2621	    "auto crlf") == TCL_ERROR) {
2622	Tcl_Close(NULL, statePtr->channel);
2623	return NULL;
2624    }
2625    return statePtr->channel;
2626}
2627
2628/*
2629 *----------------------------------------------------------------------
2630 *
2631 * Tcl_MakeTcpClientChannel --
2632 *
2633 *	Creates a Tcl_Channel from an existing client TCP socket.
2634 *
2635 * Results:
2636 *	The Tcl_Channel wrapped around the preexisting TCP socket.
2637 *
2638 * Side effects:
2639 *	None.
2640 *
2641 *----------------------------------------------------------------------
2642 */
2643
2644Tcl_Channel
2645Tcl_MakeTcpClientChannel(
2646    ClientData sock)		/* The socket to wrap up into a channel. */
2647{
2648    return MakeTcpClientChannelMode(sock, (TCL_READABLE | TCL_WRITABLE));
2649}
2650
2651/*
2652 *----------------------------------------------------------------------
2653 *
2654 * MakeTcpClientChannelMode --
2655 *
2656 *	Creates a Tcl_Channel from an existing client TCP socket
2657 *	with given mode.
2658 *
2659 * Results:
2660 *	The Tcl_Channel wrapped around the preexisting TCP socket.
2661 *
2662 * Side effects:
2663 *	None.
2664 *
2665 *----------------------------------------------------------------------
2666 */
2667
2668static Tcl_Channel
2669MakeTcpClientChannelMode(
2670    ClientData sock,		/* The socket to wrap up into a channel. */
2671    int mode)			/* ORed combination of TCL_READABLE and
2672				 * TCL_WRITABLE to indicate file mode. */
2673{
2674    TcpState *statePtr;
2675    char channelName[16 + TCL_INTEGER_SPACE];
2676
2677    statePtr = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2678    statePtr->fd = PTR2INT(sock);
2679    statePtr->flags = 0;
2680    statePtr->acceptProc = NULL;
2681    statePtr->acceptProcData = NULL;
2682
2683    sprintf(channelName, "sock%d", statePtr->fd);
2684
2685    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2686	    (ClientData) statePtr, mode);
2687    if (Tcl_SetChannelOption(NULL, statePtr->channel, "-translation",
2688	    "auto crlf") == TCL_ERROR) {
2689	Tcl_Close(NULL, statePtr->channel);
2690	return NULL;
2691    }
2692    return statePtr->channel;
2693}
2694
2695/*
2696 *----------------------------------------------------------------------
2697 *
2698 * Tcl_OpenTcpServer --
2699 *
2700 *	Opens a TCP server socket and creates a channel around it.
2701 *
2702 * Results:
2703 *	The channel or NULL if failed. If an error occurred, an error message
2704 *	is left in the interp's result if interp is not NULL.
2705 *
2706 * Side effects:
2707 *	Opens a server socket and creates a new channel.
2708 *
2709 *----------------------------------------------------------------------
2710 */
2711
2712Tcl_Channel
2713Tcl_OpenTcpServer(
2714    Tcl_Interp *interp,		/* For error reporting - may be NULL. */
2715    int port,			/* Port number to open. */
2716    const char *myHost,		/* Name of local host. */
2717    Tcl_TcpAcceptProc *acceptProc,
2718				/* Callback for accepting connections from new
2719				 * clients. */
2720    ClientData acceptProcData)	/* Data for the callback. */
2721{
2722    TcpState *statePtr;
2723    char channelName[16 + TCL_INTEGER_SPACE];
2724
2725    /*
2726     * Create a new client socket and wrap it in a channel.
2727     */
2728
2729    statePtr = CreateSocket(interp, port, myHost, 1, NULL, 0, 0);
2730    if (statePtr == NULL) {
2731	return NULL;
2732    }
2733
2734    statePtr->acceptProc = acceptProc;
2735    statePtr->acceptProcData = acceptProcData;
2736
2737    /*
2738     * Set up the callback mechanism for accepting connections from new
2739     * clients.
2740     */
2741
2742    Tcl_CreateFileHandler(statePtr->fd, TCL_READABLE, TcpAccept,
2743	    (ClientData) statePtr);
2744    sprintf(channelName, "sock%d", statePtr->fd);
2745    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2746	    (ClientData) statePtr, 0);
2747    return statePtr->channel;
2748}
2749
2750/*
2751 *----------------------------------------------------------------------
2752 *
2753 * TcpAccept --
2754 *	Accept a TCP socket connection.	 This is called by the event loop.
2755 *
2756 * Results:
2757 *	None.
2758 *
2759 * Side effects:
2760 *	Creates a new connection socket. Calls the registered callback for the
2761 *	connection acceptance mechanism.
2762 *
2763 *----------------------------------------------------------------------
2764 */
2765
2766	/* ARGSUSED */
2767static void
2768TcpAccept(
2769    ClientData data,		/* Callback token. */
2770    int mask)			/* Not used. */
2771{
2772    TcpState *sockState;	/* Client data of server socket. */
2773    int newsock;		/* The new client socket */
2774    TcpState *newSockState;	/* State for new socket. */
2775    struct sockaddr_in addr;	/* The remote address */
2776    socklen_t len;		/* For accept interface */
2777    char channelName[16 + TCL_INTEGER_SPACE];
2778
2779    sockState = (TcpState *) data;
2780
2781    len = sizeof(struct sockaddr_in);
2782    newsock = accept(sockState->fd, (struct sockaddr *) &addr, &len);
2783    if (newsock < 0) {
2784	return;
2785    }
2786
2787    /*
2788     * Set close-on-exec flag to prevent the newly accepted socket from being
2789     * inherited by child processes.
2790     */
2791
2792    (void) fcntl(newsock, F_SETFD, FD_CLOEXEC);
2793
2794    newSockState = (TcpState *) ckalloc((unsigned) sizeof(TcpState));
2795
2796    newSockState->flags = 0;
2797    newSockState->fd = newsock;
2798    newSockState->acceptProc = NULL;
2799    newSockState->acceptProcData = NULL;
2800
2801    sprintf(channelName, "sock%d", newsock);
2802    newSockState->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
2803	    (ClientData) newSockState, (TCL_READABLE | TCL_WRITABLE));
2804
2805    Tcl_SetChannelOption(NULL, newSockState->channel, "-translation",
2806	    "auto crlf");
2807
2808    if (sockState->acceptProc != NULL) {
2809	(*sockState->acceptProc)(sockState->acceptProcData,
2810		newSockState->channel, inet_ntoa(addr.sin_addr),
2811		ntohs(addr.sin_port));
2812    }
2813}
2814
2815/*
2816 *----------------------------------------------------------------------
2817 *
2818 * TclpGetDefaultStdChannel --
2819 *
2820 *	Creates channels for standard input, standard output or standard error
2821 *	output if they do not already exist.
2822 *
2823 * Results:
2824 *	Returns the specified default standard channel, or NULL.
2825 *
2826 * Side effects:
2827 *	May cause the creation of a standard channel and the underlying file.
2828 *
2829 *----------------------------------------------------------------------
2830 */
2831
2832Tcl_Channel
2833TclpGetDefaultStdChannel(
2834    int type)			/* One of TCL_STDIN, TCL_STDOUT, TCL_STDERR. */
2835{
2836    Tcl_Channel channel = NULL;
2837    int fd = 0;			/* Initializations needed to prevent */
2838    int mode = 0;		/* compiler warning (used before set). */
2839    char *bufMode = NULL;
2840
2841    /*
2842     * Some #def's to make the code a little clearer!
2843     */
2844
2845#define ZERO_OFFSET	((Tcl_SeekOffset) 0)
2846#define ERROR_OFFSET	((Tcl_SeekOffset) -1)
2847
2848    switch (type) {
2849    case TCL_STDIN:
2850	if ((TclOSseek(0, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
2851		&& (errno == EBADF)) {
2852	    return NULL;
2853	}
2854	fd = 0;
2855	mode = TCL_READABLE;
2856	bufMode = "line";
2857	break;
2858    case TCL_STDOUT:
2859	if ((TclOSseek(1, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
2860		&& (errno == EBADF)) {
2861	    return NULL;
2862	}
2863	fd = 1;
2864	mode = TCL_WRITABLE;
2865	bufMode = "line";
2866	break;
2867    case TCL_STDERR:
2868	if ((TclOSseek(2, ZERO_OFFSET, SEEK_CUR) == ERROR_OFFSET)
2869		&& (errno == EBADF)) {
2870	    return NULL;
2871	}
2872	fd = 2;
2873	mode = TCL_WRITABLE;
2874	bufMode = "none";
2875	break;
2876    default:
2877	Tcl_Panic("TclGetDefaultStdChannel: Unexpected channel type");
2878	break;
2879    }
2880
2881#undef ZERO_OFFSET
2882#undef ERROR_OFFSET
2883
2884    channel = Tcl_MakeFileChannel((ClientData) INT2PTR(fd), mode);
2885    if (channel == NULL) {
2886	return NULL;
2887    }
2888
2889    /*
2890     * Set up the normal channel options for stdio handles.
2891     */
2892
2893    if (Tcl_GetChannelType(channel) == &fileChannelType) {
2894	Tcl_SetChannelOption(NULL, channel, "-translation", "auto");
2895    } else {
2896	Tcl_SetChannelOption(NULL, channel, "-translation", "auto crlf");
2897    }
2898    Tcl_SetChannelOption(NULL, channel, "-buffering", bufMode);
2899    return channel;
2900}
2901
2902/*
2903 *----------------------------------------------------------------------
2904 *
2905 * Tcl_GetOpenFile --
2906 *
2907 *	Given a name of a channel registered in the given interpreter, returns
2908 *	a FILE * for it.
2909 *
2910 * Results:
2911 *	A standard Tcl result. If the channel is registered in the given
2912 *	interpreter and it is managed by the "file" channel driver, and it is
2913 *	open for the requested mode, then the output parameter filePtr is set
2914 *	to a FILE * for the underlying file. On error, the filePtr is not set,
2915 *	TCL_ERROR is returned and an error message is left in the interp's
2916 *	result.
2917 *
2918 * Side effects:
2919 *	May invoke fdopen to create the FILE * for the requested file.
2920 *
2921 *----------------------------------------------------------------------
2922 */
2923
2924int
2925Tcl_GetOpenFile(
2926    Tcl_Interp *interp,		/* Interpreter in which to find file. */
2927    const char *chanID,		/* String that identifies file. */
2928    int forWriting,		/* 1 means the file is going to be used for
2929				 * writing, 0 means for reading. */
2930    int checkUsage,		/* 1 means verify that the file was opened in
2931				 * a mode that allows the access specified by
2932				 * "forWriting". Ignored, we always check that
2933				 * the channel is open for the requested
2934				 * mode. */
2935    ClientData *filePtr)	/* Store pointer to FILE structure here. */
2936{
2937    Tcl_Channel chan;
2938    int chanMode, fd;
2939    const Tcl_ChannelType *chanTypePtr;
2940    ClientData data;
2941    FILE *f;
2942
2943    chan = Tcl_GetChannel(interp, chanID, &chanMode);
2944    if (chan == (Tcl_Channel) NULL) {
2945	return TCL_ERROR;
2946    }
2947    if ((forWriting) && ((chanMode & TCL_WRITABLE) == 0)) {
2948	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for writing",
2949		NULL);
2950	return TCL_ERROR;
2951    } else if ((!forWriting) && ((chanMode & TCL_READABLE) == 0)) {
2952	Tcl_AppendResult(interp, "\"", chanID, "\" wasn't opened for reading",
2953		NULL);
2954	return TCL_ERROR;
2955    }
2956
2957    /*
2958     * We allow creating a FILE * out of file based, pipe based and socket
2959     * based channels. We currently do not allow any other channel types,
2960     * because it is likely that stdio will not know what to do with them.
2961     */
2962
2963    chanTypePtr = Tcl_GetChannelType(chan);
2964    if ((chanTypePtr == &fileChannelType)
2965#ifdef SUPPORTS_TTY
2966	    || (chanTypePtr == &ttyChannelType)
2967#endif /* SUPPORTS_TTY */
2968	    || (chanTypePtr == &tcpChannelType)
2969	    || (strcmp(chanTypePtr->typeName, "pipe") == 0)) {
2970	if (Tcl_GetChannelHandle(chan,
2971		(forWriting ? TCL_WRITABLE : TCL_READABLE),
2972		(ClientData*) &data) == TCL_OK) {
2973	    fd = PTR2INT(data);
2974
2975	    /*
2976	     * The call to fdopen below is probably dangerous, since it will
2977	     * truncate an existing file if the file is being opened for
2978	     * writing....
2979	     */
2980
2981	    f = fdopen(fd, (forWriting ? "w" : "r"));
2982	    if (f == NULL) {
2983		Tcl_AppendResult(interp, "cannot get a FILE * for \"", chanID,
2984			"\"", NULL);
2985		return TCL_ERROR;
2986	    }
2987	    *filePtr = (ClientData) f;
2988	    return TCL_OK;
2989	}
2990    }
2991
2992    Tcl_AppendResult(interp, "\"", chanID,
2993	    "\" cannot be used to get a FILE *", NULL);
2994    return TCL_ERROR;
2995}
2996
2997#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
2998				 * in tclMacOSXNotify.c */
2999/*
3000 *----------------------------------------------------------------------
3001 *
3002 * TclUnixWaitForFile --
3003 *
3004 *	This function waits synchronously for a file to become readable or
3005 *	writable, with an optional timeout.
3006 *
3007 * Results:
3008 *	The return value is an OR'ed combination of TCL_READABLE,
3009 *	TCL_WRITABLE, and TCL_EXCEPTION, indicating the conditions that are
3010 *	present on file at the time of the return. This function will not
3011 *	return until either "timeout" milliseconds have elapsed or at least
3012 *	one of the conditions given by mask has occurred for file (a return
3013 *	value of 0 means that a timeout occurred). No normal events will be
3014 *	serviced during the execution of this function.
3015 *
3016 * Side effects:
3017 *	Time passes.
3018 *
3019 *----------------------------------------------------------------------
3020 */
3021
3022int
3023TclUnixWaitForFile(
3024    int fd,			/* Handle for file on which to wait. */
3025    int mask,			/* What to wait for: OR'ed combination of
3026				 * TCL_READABLE, TCL_WRITABLE, and
3027				 * TCL_EXCEPTION. */
3028    int timeout)		/* Maximum amount of time to wait for one of
3029				 * the conditions in mask to occur, in
3030				 * milliseconds. A value of 0 means don't wait
3031				 * at all, and a value of -1 means wait
3032				 * forever. */
3033{
3034    Tcl_Time abortTime = {0, 0}, now; /* silence gcc 4 warning */
3035    struct timeval blockTime, *timeoutPtr;
3036    int numFound, result = 0;
3037    fd_set readableMask;
3038    fd_set writableMask;
3039    fd_set exceptionalMask;
3040
3041#ifndef _DARWIN_C_SOURCE
3042    /*
3043     * Sanity check fd.
3044     */
3045
3046    if (fd >= FD_SETSIZE) {
3047	Tcl_Panic("TclUnixWaitForFile can't handle file id %d", fd);
3048	/* must never get here, or select masks overrun will occur below */
3049    }
3050#endif
3051
3052    /*
3053     * If there is a non-zero finite timeout, compute the time when we give
3054     * up.
3055     */
3056
3057    if (timeout > 0) {
3058	Tcl_GetTime(&now);
3059	abortTime.sec = now.sec + timeout/1000;
3060	abortTime.usec = now.usec + (timeout%1000)*1000;
3061	if (abortTime.usec >= 1000000) {
3062	    abortTime.usec -= 1000000;
3063	    abortTime.sec += 1;
3064	}
3065	timeoutPtr = &blockTime;
3066    } else if (timeout == 0) {
3067	timeoutPtr = &blockTime;
3068	blockTime.tv_sec = 0;
3069	blockTime.tv_usec = 0;
3070    } else {
3071	timeoutPtr = NULL;
3072    }
3073
3074    /*
3075     * Initialize the select masks.
3076     */
3077
3078    FD_ZERO(&readableMask);
3079    FD_ZERO(&writableMask);
3080    FD_ZERO(&exceptionalMask);
3081
3082    /*
3083     * Loop in a mini-event loop of our own, waiting for either the file to
3084     * become ready or a timeout to occur.
3085     */
3086
3087    while (1) {
3088	if (timeout > 0) {
3089	    blockTime.tv_sec = abortTime.sec - now.sec;
3090	    blockTime.tv_usec = abortTime.usec - now.usec;
3091	    if (blockTime.tv_usec < 0) {
3092		blockTime.tv_sec -= 1;
3093		blockTime.tv_usec += 1000000;
3094	    }
3095	    if (blockTime.tv_sec < 0) {
3096		blockTime.tv_sec = 0;
3097		blockTime.tv_usec = 0;
3098	    }
3099	}
3100
3101	/*
3102	 * Setup the select masks for the fd.
3103	 */
3104
3105	if (mask & TCL_READABLE)  {
3106	    FD_SET(fd, &readableMask);
3107	}
3108	if (mask & TCL_WRITABLE)  {
3109	    FD_SET(fd, &writableMask);
3110	}
3111	if (mask & TCL_EXCEPTION) {
3112	    FD_SET(fd, &exceptionalMask);
3113	}
3114
3115	/*
3116	 * Wait for the event or a timeout.
3117	 */
3118
3119	numFound = select(fd + 1, &readableMask, &writableMask,
3120		&exceptionalMask, timeoutPtr);
3121	if (numFound == 1) {
3122	    if (FD_ISSET(fd, &readableMask))   {
3123		SET_BITS(result, TCL_READABLE);
3124	    }
3125	    if (FD_ISSET(fd, &writableMask))  {
3126		SET_BITS(result, TCL_WRITABLE);
3127	    }
3128	    if (FD_ISSET(fd, &exceptionalMask)) {
3129		SET_BITS(result, TCL_EXCEPTION);
3130	    }
3131	    result &= mask;
3132	    if (result) {
3133		break;
3134	    }
3135	}
3136	if (timeout == 0) {
3137	    break;
3138	}
3139	if (timeout < 0) {
3140	    continue;
3141	}
3142
3143	/*
3144	 * The select returned early, so we need to recompute the timeout.
3145	 */
3146
3147	Tcl_GetTime(&now);
3148	if ((abortTime.sec < now.sec)
3149		|| (abortTime.sec==now.sec && abortTime.usec<=now.usec)) {
3150	    break;
3151	}
3152    }
3153    return result;
3154}
3155#endif /* HAVE_COREFOUNDATION */
3156
3157/*
3158 *----------------------------------------------------------------------
3159 *
3160 * FileTruncateProc --
3161 *
3162 *	Truncates a file to a given length.
3163 *
3164 * Results:
3165 *	0 if the operation succeeded, and -1 if it failed (in which case
3166 *	*errorCodePtr will be set to errno).
3167 *
3168 * Side effects:
3169 *	The underlying file is potentially truncated. This can have a wide
3170 *	variety of side effects, including moving file pointers that point at
3171 *	places later in the file than the truncate point.
3172 *
3173 *----------------------------------------------------------------------
3174 */
3175
3176static int
3177FileTruncateProc(
3178    ClientData instanceData,
3179    Tcl_WideInt length)
3180{
3181    FileState *fsPtr = (FileState *) instanceData;
3182    int result;
3183
3184#ifdef HAVE_TYPE_OFF64_T
3185    /*
3186     * We assume this goes with the type for now...
3187     */
3188
3189    result = ftruncate64(fsPtr->fd, (off64_t) length);
3190#else
3191    result = ftruncate(fsPtr->fd, (off_t) length);
3192#endif
3193    if (result) {
3194	return errno;
3195    }
3196    return 0;
3197}
3198
3199/*
3200 * Local Variables:
3201 * mode: c
3202 * c-basic-offset: 4
3203 * fill-column: 78
3204 * tab-width: 8
3205 * indent-tabs-mode: nil
3206 * End:
3207 */
3208