io.c

Go to the documentation of this file.

/*
 * io.c --- routines for dealing with input and output and records
 */

/* 
 * Copyright (C) 1986, 1988, 1989, 1991-2003 the Free Software Foundation, Inc.
 * 
 * This file is part of GAWK, the GNU implementation of the
 * AWK Programming Language.
 * 
 * GAWK is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 * 
 * GAWK is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
 */

#include "awk.h"

#ifdef HAVE_SYS_PARAM_H
#undef RE_DUP_MAX       /* avoid spurious conflict w/regex.h */
#include <sys/param.h>
#endif /* HAVE_SYS_PARAM_H */

#ifndef O_RDONLY
#include <fcntl.h>
#endif
#ifndef O_ACCMODE
#define O_ACCMODE       (O_RDONLY|O_WRONLY|O_RDWR)
#endif

#ifdef HAVE_TERMIOS_H
#include <termios.h>
#endif
#ifdef HAVE_STROPTS_H
#include <stropts.h>
#endif

#ifdef HAVE_SOCKETS
#ifdef HAVE_SYS_SOCKET_H
#include <sys/socket.h>
#else
#include <socket.h>
#endif /* HAVE_SYS_SOCKET_H */
#ifdef HAVE_NETINET_IN_H
#include <netinet/in.h>
#else
#include <in.h>
#endif /* HAVE_NETINET_IN_H */
#ifdef HAVE_NETDB_H
#include <netdb.h>
#endif /* HAVE_NETDB_H */
#endif /* HAVE_SOCKETS */

#ifdef __EMX__
#include <process.h>
#endif

#ifndef ENFILE
#define ENFILE EMFILE
#endif

extern int MRL;

#ifdef HAVE_SOCKETS
enum inet_prot { INET_NONE, INET_TCP, INET_UDP, INET_RAW };

#ifndef SHUT_RD
#define SHUT_RD         0
#endif

#ifndef SHUT_WR
#define SHUT_WR         1
#endif

#ifndef SHUT_RDWR
#define SHUT_RDWR       2
#endif

#endif /* HAVE_SOCKETS */

#ifdef atarist
#include <stddef.h>
#endif

#if defined(GAWK_AIX)
#undef TANDEM   /* AIX defines this in one of its header files */
#undef MSDOS    /* For good measure, */
#undef WIN32    /* yes, I'm paranoid */
#endif

#if defined(MSDOS) || defined(WIN32) || defined(TANDEM)
#define PIPES_SIMULATED
#endif

typedef enum { CLOSE_ALL, CLOSE_TO, CLOSE_FROM } two_way_close_type;

/* Several macros make the code a bit clearer:                              */
/*                                                                          */
/*                                                                          */
/* <defines and enums>=                                                     */
#define at_eof(iop)     ((iop->flag & IOP_AT_EOF) != 0)
#define has_no_data(iop)        (iop->dataend == NULL)
#define no_data_left(iop)       (iop->off >= iop->dataend)
/* The key point to the design is to split out the code that searches through */
/* a buffer looking for the record and the terminator into separate routines, */
/* with a higher-level routine doing the reading of data and buffer management. */
/* This makes the code easier to manage; the buffering code is the same independent */
/* of how we find a record.  Communication is via the return value:         */
/*                                                                          */
/*                                                                          */
/* <defines and enums>=                                                     */
typedef enum recvalues {
        REC_OK,         /* record and terminator found, recmatch struct filled in */
        NOTERM,         /* no terminator found, give me more input data */
        TERMATEND,      /* found terminator at end of buffer */
        TERMNEAREND,    /* found terminator close to end of buffer, for RE might be bigger */
} RECVALUE;
/* Between calls to a scanning routine, the state is stored in              */
/* an [[enum scanstate]] variable.  Not all states apply to all             */
/* variants, but the higher code doesn't really care.                       */
/*                                                                          */
/*                                                                          */
/* <defines and enums>=                                                     */
typedef enum scanstate {
        NOSTATE,        /* scanning not started yet (all) */
        INLEADER,       /* skipping leading data (RS = "") */
        INDATA,         /* in body of record (all) */
        INTERM,         /* scanning terminator (RS = "", RS = regexp) */
} SCANSTATE;
/* When a record is seen ([[REC_OK]] or [[TERMATEND]]), the following       */
/* structure is filled in.                                                  */
/*                                                                          */
/*                                                                          */
/* <recmatch>=                                                              */
struct recmatch {
        char *start;    /* record start */
        size_t len;     /* length of record */
        char *rt_start; /* start of terminator */
        size_t rt_len;  /* length of terminator */
};

static IOBUF *nextfile P((int skipping));
static int inrec P((IOBUF *iop));
static int iop_close P((IOBUF *iop));
struct redirect *redirect P((NODE *tree, int *errflg));
static void close_one P((void));
static int close_redir P((struct redirect *rp, int exitwarn, two_way_close_type how));
#ifndef PIPES_SIMULATED
static int wait_any P((int interesting));
#endif
static IOBUF *gawk_popen P((const char *cmd, struct redirect *rp));
static IOBUF *iop_open P((const char *file, const char *how, IOBUF *buf));
static IOBUF *iop_alloc P((int fd, const char *name, IOBUF *buf));
static int gawk_pclose P((struct redirect *rp));
static int do_pathopen P((const char *file));
static int str2mode P((const char *mode));
static void spec_setup P((IOBUF *iop, int len, int allocate));
static int specfdopen P((IOBUF *iop, const char *name, const char *mode));
static int pidopen P((IOBUF *iop, const char *name, const char *mode));
static int useropen P((IOBUF *iop, const char *name, const char *mode));
static int two_way_open P((const char *str, struct redirect *rp));
static int pty_vs_pipe P((const char *command));

static RECVALUE rs1scan P((IOBUF *iop, struct recmatch *recm, SCANSTATE *state));
static RECVALUE rsnullscan P((IOBUF *iop, struct recmatch *recm, SCANSTATE *state));
static RECVALUE rsrescan P((IOBUF *iop, struct recmatch *recm, SCANSTATE *state));

static RECVALUE (*matchrec) P((IOBUF *iop, struct recmatch *recm, SCANSTATE *state)) = rs1scan;

static int get_a_record P((char **out, IOBUF *iop, int *errcode));

#if defined(HAVE_POPEN_H)
#include "popen.h"
#endif

static struct redirect *red_head = NULL;
static NODE *RS;
static Regexp *RS_re_yes_case;
static Regexp *RS_re_no_case;
static Regexp *RS_regexp;

int RS_is_null;

extern int output_is_tty;
extern NODE *ARGC_node;
extern NODE *ARGV_node;
extern NODE *ARGIND_node;
extern NODE *ERRNO_node;
extern NODE **fields_arr;

static jmp_buf filebuf;         /* for do_nextfile() */

#if defined(MSDOS) || defined(OS2) || defined(WIN32) \
 || defined(__EMX__) || defined(__CYGWIN__)
static const char *
binmode(const char *mode)
{
        switch (mode[0]) {
        case 'r':
                if ((BINMODE & 1) != 0)
                        mode = "rb";
                break;
        case 'w':
        case 'a':
                if ((BINMODE & 2) != 0)
                        mode = (mode[0] == 'w' ? "wb" : "ab");
                break;
        }
        return mode;
}
#else
#define binmode(mode)   (mode)
#endif

#ifdef VMS
/* File pointers have an extra level of indirection, and there are cases where
   `stdin' can be null.  That can crash gawk if fileno() is used as-is.  */
static int vmsrtl_fileno P((FILE *));
static int vmsrtl_fileno(fp) FILE *fp; { return fileno(fp); }
#undef fileno
#define fileno(FP) (((FP) && *(FP)) ? vmsrtl_fileno(FP) : -1)
#endif  /* VMS */

/* do_nextfile --- implement gawk "nextfile" extension */

void
do_nextfile()
{
        (void) nextfile(TRUE);
        longjmp(filebuf, 1);
}

/* nextfile --- move to the next input data file */

static IOBUF *
nextfile(int skipping)
{
        static long i = 1;
        static int files = 0;
        NODE *arg;
        static IOBUF *curfile = NULL;
        static IOBUF mybuf;
        const char *fname;

        if (skipping) {
                if (curfile != NULL)
                        iop_close(curfile);
                curfile = NULL;
                return NULL;
        }
        if (curfile != NULL) {
                if (at_eof(curfile)) {
                        (void) iop_close(curfile);
                        curfile = NULL;
                } else
                        return curfile;
        }
        for (; i < (long) (ARGC_node->lnode->numbr); i++) {
                arg = *assoc_lookup(ARGV_node, tmp_number((AWKNUM) i), FALSE);
                if (arg->stlen == 0)
                        continue;
                arg->stptr[arg->stlen] = '\0';
                if (! do_traditional) {
                        unref(ARGIND_node->var_value);
                        ARGIND_node->var_value = make_number((AWKNUM) i);
                }
                if (! arg_assign(arg->stptr, FALSE)) {
                        files++;
                        fname = arg->stptr;
                        curfile = iop_open(fname, binmode("r"), &mybuf);
                        if (curfile == NULL)
                                goto give_up;
                        curfile->flag |= IOP_NOFREE_OBJ;
                        /* This is a kludge.  */
                        unref(FILENAME_node->var_value);
                        FILENAME_node->var_value = dupnode(arg);
                        FNR = 0;
                        i++;
                        break;
                }
        }
        if (files == 0) {
                files++;
                /* no args. -- use stdin */
                /* FNR is init'ed to 0 */
                FILENAME_node->var_value = make_string("-", 1);
                fname = "-";
                curfile = iop_open(fname, binmode("r"), &mybuf);
                if (curfile == NULL)
                        goto give_up;
                curfile->flag |= IOP_NOFREE_OBJ;
        }
        return curfile;

 give_up:
        fatal(_("cannot open file `%s' for reading (%s)"),
                fname, strerror(errno));
        /* NOTREACHED */
        return 0;
}

/* set_FNR --- update internal FNR from awk variable */

void
set_FNR()
{
        FNR = (long) FNR_node->var_value->numbr;
}

/* set_NR --- update internal NR from awk variable */

void
set_NR()
{
        NR = (long) NR_node->var_value->numbr;
}

/* inrec --- This reads in a record from the input file */

static int
inrec(IOBUF *iop)
{
        char *begin;
        register int cnt;
        int retval = 0;

        if (at_eof(iop) && no_data_left(iop))
                cnt = EOF;
        else if ((iop->flag & IOP_CLOSED) != 0)
                cnt = EOF;
        else
                cnt = get_a_record(&begin, iop, NULL);

        if (cnt == EOF) {
                cnt = 0;
                retval = 1;
        } else {
                NR += 1;
                FNR += 1;
                set_record(begin, cnt);
        }

        return retval;
}

/* iop_close --- close an open IOP */

static int
iop_close(IOBUF *iop)
{
        int ret;

        if (iop == NULL)
                return 0;
        errno = 0;

        iop->flag &= ~IOP_AT_EOF;
        iop->flag |= IOP_CLOSED;        /* there may be dangling pointers */
        iop->dataend = NULL;
#ifdef _CRAY
        /* Work around bug in UNICOS popen */
        if (iop->fd < 3)
                ret = 0;
        else
#endif
        /* save these for re-use; don't free the storage */
        if ((iop->flag & IOP_IS_INTERNAL) != 0) {
                iop->off = iop->buf;
                iop->end = iop->buf + strlen(iop->buf);
                iop->count = 0;
                return 0;
        }

        /* Don't close standard files or else crufty code elsewhere will lose */
        if (iop->fd == fileno(stdin)
            || iop->fd == fileno(stdout)
            || iop->fd == fileno(stderr))
                ret = 0;
        else
                ret = close(iop->fd);

        if (ret == -1)
                warning(_("close of fd %d (`%s') failed (%s)"), iop->fd,
                                iop->name, strerror(errno));
        if ((iop->flag & IOP_NO_FREE) == 0) {
                /*
                 * Be careful -- $0 may still reference the buffer even though
                 * an explicit close is being done; in the future, maybe we
                 * can do this a bit better.
                 */
                if (iop->buf) {
                        if ((fields_arr[0]->stptr >= iop->buf)
                            && (fields_arr[0]->stptr < (iop->buf + iop->size))) {
                                NODE *t;
        
                                t = make_string(fields_arr[0]->stptr,
                                                fields_arr[0]->stlen);
                                unref(fields_arr[0]);
                                fields_arr[0] = t;
                                /*
                                 * 1/27/2003: This used to be here:
                                 *
                                 * reset_record();
                                 *
                                 * Don't do that; reset_record() throws away all fields,
                                 * saves FS etc.  We just need to make sure memory isn't
                                 * corrupted and that references to $0 and fields work.
                                 */
                        }
                        free(iop->buf);
                        iop->buf = NULL;
                }
                if ((iop->flag & IOP_NOFREE_OBJ) == 0)
                        free((char *) iop);
        }
        return ret == -1 ? 1 : 0;
}

/* do_input --- the main input processing loop */

void
do_input()
{
        IOBUF *iop;
        extern int exiting;
        int rval1, rval2, rval3;

        (void) setjmp(filebuf); /* for `nextfile' */

        while ((iop = nextfile(FALSE)) != NULL) {
                /*
                 * This was:
                if (inrec(iop) == 0)
                        while (interpret(expression_value) && inrec(iop) == 0)
                                continue;
                 * Now expand it out for ease of debugging.
                 */
                rval1 = inrec(iop);
                if (rval1 == 0) {
                        for (;;) {
                                rval2 = rval3 = -1;     /* for debugging */
                                rval2 = interpret(expression_value);
                                if (rval2 != 0)
                                        rval3 = inrec(iop);
                                if (rval2 == 0 || rval3 != 0)
                                        break;
                        }
                }
                if (exiting)
                        break;
        }
}

/* redflags2str --- turn redirection flags into a string, for debugging */

const char *
redflags2str(int flags)
{
        static const struct flagtab redtab[] = {
                { RED_FILE,     "RED_FILE" },
                { RED_PIPE,     "RED_PIPE" },
                { RED_READ,     "RED_READ" },
                { RED_WRITE,    "RED_WRITE" },
                { RED_APPEND,   "RED_APPEND" },
                { RED_NOBUF,    "RED_NOBUF" },
                { RED_EOF,      "RED_EOF" },
                { RED_TWOWAY,   "RED_TWOWAY" },
                { RED_PTY,      "RED_PTY" },
                { RED_SOCKET,   "RED_SOCKET" },
                { RED_TCP,      "RED_TCP" },
                { 0, NULL }
        };

        return genflags2str(flags, redtab);
}

/* redirect --- Redirection for printf and print commands */

struct redirect *
redirect(NODE *tree, int *errflg)
{
        register NODE *tmp;
        register struct redirect *rp;
        register char *str;
        int tflag = 0;
        int outflag = 0;
        const char *direction = "to";
        const char *mode;
        int fd;
        const char *what = NULL;

        switch (tree->type) {
        case Node_redirect_append:
                tflag = RED_APPEND;
                /* FALL THROUGH */
        case Node_redirect_output:
                outflag = (RED_FILE|RED_WRITE);
                tflag |= outflag;
                if (tree->type == Node_redirect_output)
                        what = ">";
                else
                        what = ">>";
                break;
        case Node_redirect_pipe:
                tflag = (RED_PIPE|RED_WRITE);
                what = "|";
                break;
        case Node_redirect_pipein:
                tflag = (RED_PIPE|RED_READ);
                what = "|";
                break;
        case Node_redirect_input:
                tflag = (RED_FILE|RED_READ);
                what = "<";
                break;
        case Node_redirect_twoway:
                tflag = (RED_READ|RED_WRITE|RED_TWOWAY);
                what = "|&";
                break;
        default:
                fatal(_("invalid tree type %s in redirect()"),
                                        nodetype2str(tree->type));
                break;
        }
        tmp = tree_eval(tree->subnode);
        if (do_lint && (tmp->flags & STRCUR) == 0)
                lintwarn(_("expression in `%s' redirection only has numeric value"),
                        what);
        tmp = force_string(tmp);
        str = tmp->stptr;

        if (str == NULL || *str == '\0')
                fatal(_("expression for `%s' redirection has null string value"),
                        what);

        if (do_lint
            && (STREQN(str, "0", tmp->stlen) || STREQN(str, "1", tmp->stlen)))
                lintwarn(_("filename `%s' for `%s' redirection may be result of logical expression"), str, what);

#ifdef HAVE_SOCKETS
        if (STREQN(str, "/inet/", 6)) {
                tflag |= RED_SOCKET;
                if (STREQN(str + 6, "tcp/", 4))
                        tflag |= RED_TCP;       /* use shutdown when closing */
        }
#endif /* HAVE_SOCKETS */

        for (rp = red_head; rp != NULL; rp = rp->next) {
                if (strlen(rp->value) == tmp->stlen
                    && STREQN(rp->value, str, tmp->stlen)
                    && ((rp->flag & ~(RED_NOBUF|RED_EOF|RED_PTY)) == tflag
                        || (outflag != 0
                            && (rp->flag & (RED_FILE|RED_WRITE)) == outflag))) {

                        int rpflag = (rp->flag & ~(RED_NOBUF|RED_EOF|RED_PTY));
                        int newflag = (tflag & ~(RED_NOBUF|RED_EOF|RED_PTY));

                        if (do_lint && rpflag != newflag)
                                lintwarn(
                _("unnecessary mixing of `>' and `>>' for file `%.*s'"),
                                        tmp->stlen, rp->value);

                        break;
                }
        }

        if (rp == NULL) {
                emalloc(rp, struct redirect *, sizeof(struct redirect),
                        "redirect");
                emalloc(str, char *, tmp->stlen+1, "redirect");
                memcpy(str, tmp->stptr, tmp->stlen);
                str[tmp->stlen] = '\0';
                rp->value = str;
                rp->flag = tflag;
                rp->fp = NULL;
                rp->iop = NULL;
                rp->pid = 0;    /* unlikely that we're worried about init */
                rp->status = 0;
                /* maintain list in most-recently-used first order */
                if (red_head != NULL)
                        red_head->prev = rp;
                rp->prev = NULL;
                rp->next = red_head;
                red_head = rp;
        } else
                str = rp->value;        /* get \0 terminated string */

        while (rp->fp == NULL && rp->iop == NULL) {
                if (rp->flag & RED_EOF)
                        /*
                         * encountered EOF on file or pipe -- must be cleared
                         * by explicit close() before reading more
                         */
                        return rp;
                mode = NULL;
                errno = 0;
                switch (tree->type) {
                case Node_redirect_output:
                        mode = binmode("w");
                        if ((rp->flag & RED_USED) != 0)
                                mode = (rp->mode[1] == 'b') ? "ab" : "a";
                        break;
                case Node_redirect_append:
                        mode = binmode("a");
                        break;
                case Node_redirect_pipe:
                        /* synchronize output before new pipe */
                        (void) flush_io();

                        os_restore_mode(fileno(stdin));
                        if ((rp->fp = popen(str, binmode("w"))) == NULL)
                                fatal(_("can't open pipe `%s' for output (%s)"),
                                        str, strerror(errno));
                        /* set close-on-exec */
                        os_close_on_exec(fileno(rp->fp), str, "pipe", "to");
                        rp->flag |= RED_NOBUF;
                        break;
                case Node_redirect_pipein:
                        direction = "from";
                        if (gawk_popen(str, rp) == NULL)
                                fatal(_("can't open pipe `%s' for input (%s)"),
                                        str, strerror(errno));
                        break;
                case Node_redirect_input:
                        direction = "from";
                        rp->iop = iop_open(str, binmode("r"), NULL);
                        break;
                case Node_redirect_twoway:
                        direction = "to/from";
                        if (! two_way_open(str, rp)) {
#ifdef HAVE_SOCKETS
                                /* multiple messages make life easier for translators */
                                if (STREQN(str, "/inet/", 6))
                                        fatal(_("can't open two way socket `%s' for input/output (%s)"),
                                                str, strerror(errno));
                                else
#endif
                                        fatal(_("can't open two way pipe `%s' for input/output (%s)"),
                                                str, strerror(errno));
                        }
                        break;
                default:
                        cant_happen();
                }
                if (mode != NULL) {
                        errno = 0;
                        fd = devopen(str, mode);
                        if (fd > INVALID_HANDLE) {
                                if (fd == fileno(stdin))
                                        rp->fp = stdin;
                                else if (fd == fileno(stdout))
                                        rp->fp = stdout;
                                else if (fd == fileno(stderr))
                                        rp->fp = stderr;
                                else {
#if defined(F_GETFL) && defined(O_APPEND)
                                        int fd_flags;

                                        fd_flags = fcntl(fd, F_GETFL);
                                        if (fd_flags != -1 && (fd_flags & O_APPEND) == O_APPEND)
                                                rp->fp = fdopen(fd, binmode("a"));
                                        else
#endif
                                                rp->fp = fdopen(fd, (const char *) mode);
                                        rp->mode = (const char *) mode;
                                        /* don't leak file descriptors */
                                        if (rp->fp == NULL)
                                                close(fd);
                                }
                                if (rp->fp != NULL && isatty(fd))
                                        rp->flag |= RED_NOBUF;
                                /* Move rp to the head of the list. */
                                if (red_head != rp) {
                                        if ((rp->prev->next = rp->next) != NULL)
                                                rp->next->prev = rp->prev;
                                        red_head->prev = rp;
                                        rp->prev = NULL;
                                        rp->next = red_head;
                                        red_head = rp;
                                }
                        }
                }
                if (rp->fp == NULL && rp->iop == NULL) {
                        /* too many files open -- close one and try again */
                        if (errno == EMFILE || errno == ENFILE)
                                close_one();
#if defined __MINGW32__ || defined __sun
                        else if (errno == 0)    /* HACK! */
                                close_one();
#endif
#ifdef VMS
                        /* Alpha/VMS V7.1's C RTL is returning this instead
                           of EMFILE (haven't tried other post-V6.2 systems) */
#define SS$_EXQUOTA 0x001C
                        else if (errno == EIO && vaxc$errno == SS$_EXQUOTA)
                                close_one();
#endif
                        else {
                                /*
                                 * Some other reason for failure.
                                 *
                                 * On redirection of input from a file,
                                 * just return an error, so e.g. getline
                                 * can return -1.  For output to file,
                                 * complain. The shell will complain on
                                 * a bad command to a pipe.
                                 */
                                if (errflg != NULL)
                                        *errflg = errno;
                                if (tree->type == Node_redirect_output
                                    || tree->type == Node_redirect_append) {
                                        /* multiple messages make life easier for translators */
                                        if (*direction == 'f')
                                                fatal(_("can't redirect from `%s' (%s)"),
                                                        str, strerror(errno));
                                        else
                                                fatal(_("can't redirect to `%s' (%s)"),
                                                        str, strerror(errno));
                                } else {
                                        free_temp(tmp);
                                        return NULL;
                                }
                        }
                }
        }
        free_temp(tmp);
        return rp;
}

/* getredirect --- find the struct redirect for this file or pipe */

struct redirect *
getredirect(const char *str, int len)
{
        struct redirect *rp;

        for (rp = red_head; rp != NULL; rp = rp->next)
                if (strlen(rp->value) == len && STREQN(rp->value, str, len))
                        return rp;

        return NULL;
}

/* close_one --- temporarily close an open file to re-use the fd */

static void
close_one()
{
        register struct redirect *rp;
        register struct redirect *rplast = NULL;

        static short warned = FALSE;

        if (do_lint && ! warned) {
                warned = TRUE;
                lintwarn(_("reached system limit for open files: starting to multiplex file descriptors"));
        }

        /* go to end of list first, to pick up least recently used entry */
        for (rp = red_head; rp != NULL; rp = rp->next)
                rplast = rp;
        /* now work back up through the list */
        for (rp = rplast; rp != NULL; rp = rp->prev)
                if (rp->fp != NULL && (rp->flag & RED_FILE) != 0) {
                        rp->flag |= RED_USED;
                        errno = 0;
                        if (/* do_lint && */ fclose(rp->fp) != 0)
                                warning(_("close of `%s' failed (%s)."),
                                        rp->value, strerror(errno));
                        rp->fp = NULL;
                        break;
                }
        if (rp == NULL)
                /* surely this is the only reason ??? */
                fatal(_("too many pipes or input files open")); 
}

/* do_close --- completely close an open file or pipe */

NODE *
do_close(NODE *tree)
{
        NODE *tmp, *tmp2;
        register struct redirect *rp;
        two_way_close_type how = CLOSE_ALL;     /* default */

        tmp = force_string(tree_eval(tree->lnode));     /* 1st arg: redir to close */

        if (tree->rnode != NULL) {
                /* 2nd arg if present: "to" or "from" for two-way pipe */
                /* DO NOT use _() on the strings here! */
                tmp2 = force_string(tree->rnode->lnode);
                if (strcasecmp(tmp2->stptr, "to") == 0)
                        how = CLOSE_TO;
                else if (strcasecmp(tmp2->stptr, "from") == 0)
                        how = CLOSE_FROM;
                else
                        fatal(_("close: second argument must be `to' or `from'"));
                free_temp(tmp2);
        }

        for (rp = red_head; rp != NULL; rp = rp->next) {
                if (strlen(rp->value) == tmp->stlen
                    && STREQN(rp->value, tmp->stptr, tmp->stlen))
                        break;
        }

        if (rp == NULL) {       /* no match, return -1 */
                char *cp;

                if (do_lint)
                        lintwarn(_("close: `%.*s' is not an open file, pipe or co-process"),
                                tmp->stlen, tmp->stptr);

                /* update ERRNO manually, using errno = ENOENT is a stretch. */
                cp = _("close of redirection that was never opened");
                unref(ERRNO_node->var_value);
                ERRNO_node->var_value = make_string(cp, strlen(cp));

                free_temp(tmp);
                return tmp_number((AWKNUM) -1.0);
        }
        free_temp(tmp);
        fflush(stdout); /* synchronize regular output */
        tmp = tmp_number((AWKNUM) close_redir(rp, FALSE, how));
        rp = NULL;
        /*
         * POSIX says close() returns 0 on success, non-zero otherwise.
         * For POSIX, at this point we just return 0.  Otherwise we
         * return the exit status of the process or of pclose(), depending.
         * This whole business is a mess.
         */
        if (do_posix) {
                free_temp(tmp);
                return tmp_number((AWKNUM) 0);
        }
        return tmp;
}

/* close_redir --- close an open file or pipe */

static int
close_redir(register struct redirect *rp, int exitwarn, two_way_close_type how)
{
        int status = 0;

        if (rp == NULL)
                return 0;
        if (rp->fp == stdout || rp->fp == stderr)
                return 0;

        if (do_lint && (rp->flag & RED_TWOWAY) == 0 && how != CLOSE_ALL)
                lintwarn(_("close: redirection `%s' not opened with `|&', second argument ignored"),
                                rp->value);

        errno = 0;
        if ((rp->flag & RED_TWOWAY) != 0) {     /* two-way pipe */
                /* write end: */
                if ((how == CLOSE_ALL || how == CLOSE_TO) && rp->fp != NULL) {
#ifdef HAVE_SOCKETS
                        if ((rp->flag & RED_TCP) != 0)
                                (void) shutdown(fileno(rp->fp), SHUT_WR);
#endif /* HAVE_SOCKETS */

                        if ((rp->flag & RED_PTY) != 0) {
                                fwrite("\004\n", sizeof("\004\n") - 1, 1, rp->fp);
                                fflush(rp->fp);
                        }
                        status = fclose(rp->fp);
                        rp->fp = NULL;
                }

                /* read end: */
                if (how == CLOSE_ALL || how == CLOSE_FROM) {
                        if ((rp->flag & RED_SOCKET) != 0 && rp->iop != NULL) {
#ifdef HAVE_SOCKETS
                                if ((rp->flag & RED_TCP) != 0)
                                        (void) shutdown(rp->iop->fd, SHUT_RD);
#endif /* HAVE_SOCKETS */
                                (void) iop_close(rp->iop);
                        } else
                                status = gawk_pclose(rp);

                        rp->iop = NULL;
                }
        } else if ((rp->flag & (RED_PIPE|RED_WRITE)) == (RED_PIPE|RED_WRITE)) { /* write to pipe */
                status = pclose(rp->fp);
                if ((BINMODE & 1) != 0)
                        os_setbinmode(fileno(stdin), O_BINARY);

                rp->fp = NULL;
        } else if (rp->fp != NULL) {    /* write to file */
                status = fclose(rp->fp);
                rp->fp = NULL;
        } else if (rp->iop != NULL) {   /* read from pipe/file */
                if ((rp->flag & RED_PIPE) != 0)         /* read from pipe */
                        status = gawk_pclose(rp);
                        /* gawk_pclose sets rp->iop to null */
                else {                                  /* read from file */
                        status = iop_close(rp->iop);
                        rp->iop = NULL;
                }
        }

        /* SVR4 awk checks and warns about status of close */
        if (status != 0) {
                char *s = strerror(errno);

                /*
                 * Too many people have complained about this.
                 * As of 2.15.6, it is now under lint control.
                 */
                if (do_lint) {
                        if ((rp->flag & RED_PIPE) != 0)
                                lintwarn(_("failure status (%d) on pipe close of `%s' (%s)"),
                                         status, rp->value, s);
                        else
                                lintwarn(_("failure status (%d) on file close of `%s' (%s)"),
                                         status, rp->value, s);
                }

                if (! do_traditional) {
                        /* set ERRNO too so that program can get at it */
                        update_ERRNO();
                }
        }

        if (exitwarn) {
                /*
                 * Don't use lintwarn() here.  If lint warnings are fatal,
                 * doing so prevents us from closing other open redirections.
                 *
                 * Using multiple full messages instead of string parameters
                 * for the types makes message translation easier.
                 */
                if ((rp->flag & RED_SOCKET) != 0)
                        warning(_("no explicit close of socket `%s' provided"),
                                rp->value);
                else if ((rp->flag & RED_TWOWAY) != 0)
                        warning(_("no explicit close of co-process `%s' provided"),
                                rp->value);
                else if ((rp->flag & RED_PIPE) != 0)
                        warning(_("no explicit close of pipe `%s' provided"),
                                rp->value);
                else
                        warning(_("no explicit close of file `%s' provided"),
                                rp->value);
        }

        /* remove it from the list if closing both or both ends have been closed */
        if (how == CLOSE_ALL || (rp->iop == NULL && rp->fp == NULL)) {
                if (rp->next != NULL)
                        rp->next->prev = rp->prev;
                if (rp->prev != NULL)
                        rp->prev->next = rp->next;
                else
                        red_head = rp->next;
                free(rp->value);
                free((char *) rp);
        }

        return status;
}

/* flush_io --- flush all open output files */

int
flush_io()
{
        register struct redirect *rp;
        int status = 0;

        errno = 0;
        if (fflush(stdout)) {
                warning(_("error writing standard output (%s)"), strerror(errno));
                status++;
        }
        if (fflush(stderr)) {
                warning(_("error writing standard error (%s)"), strerror(errno));
                status++;
        }
        for (rp = red_head; rp != NULL; rp = rp->next)
                /* flush both files and pipes, what the heck */
                if ((rp->flag & RED_WRITE) && rp->fp != NULL) {
                        if (fflush(rp->fp)) {
                                if (rp->flag  & RED_PIPE)
                                        warning(_("pipe flush of `%s' failed (%s)."),
                                                rp->value, strerror(errno));
                                else if (rp->flag & RED_TWOWAY)
                                        warning(_("co-process flush of pipe to `%s' failed (%s)."),
                                                rp->value, strerror(errno));
                                else
                                        warning(_("file flush of `%s' failed (%s)."),
                                                rp->value, strerror(errno));
                                status++;
                        }
                }
        if (status != 0)
                status = -1;    /* canonicalize it */
        return status;
}

/* close_io --- close all open files, called when exiting */

int
close_io()
{
        register struct redirect *rp;
        register struct