aolserver/nsd/tclfile.c

/*
 * The contents of this file are subject to the AOLserver Public License
 * Version 1.1 (the "License"); you may not use this file except in
 * compliance with the License. You may obtain a copy of the License at
 * http://aolserver.com/.
 *
 * Software distributed under the License is distributed on an "AS IS"
 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 * the License for the specific language governing rights and limitations
 * under the License.
 *
 * The Original Code is AOLserver Code and related documentation
 * distributed by AOL.
 * 
 * The Initial Developer of the Original Code is America Online,
 * Inc. Portions created by AOL are Copyright (C) 1999 America Online,
 * Inc. All Rights Reserved.
 *
 * Alternatively, the contents of this file may be used under the terms
 * of the GNU General Public License (the "GPL"), in which case the
 * provisions of GPL are applicable instead of those above.  If you wish
 * to allow use of your version of this file only under the terms of the
 * GPL and not to allow others to use your version of this file under the
 * License, indicate your decision by deleting the provisions above and
 * replace them with the notice and other provisions required by the GPL.
 * If you do not delete the provisions above, a recipient may use your
 * version of this file under either the License or the GPL.
 */


/*
 * tclfile.c --
 *
 *      Tcl commands that do stuff to the filesystem. 
 */

static const char *RCSID = "@(#) $Header: /cvsroot-fuse/aolserver/aolserver/nsd/tclfile.c,v 1.27 2008/05/06 07:43:08 gneumann Exp $, compiled: " __DATE__ " " __TIME__;

#include "nsd.h"
#ifdef _WIN32
#include <sys/utime.h>
#else
#include <utime.h>
#endif

/*
 * Structure handling one registered channel for the [ns_chan] command
 */

typedef struct _NsRegChan {
    char *name;
    Tcl_Channel chan;
} NsRegChan;

static void <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_SpliceChannel">SpliceChannel</a>(Tcl_Interp *interp, Tcl_Channel chan);
static void <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_UnspliceChannel">UnspliceChannel</a>(Tcl_Interp *interp, Tcl_Channel chan);


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenChannel">Ns_TclGetOpenChannel</a> --
 *
 *      Return an open channel with an interface similar to the
 *      pre-Tcl7.5 Tcl_GetOpenFile, used throughout AOLserver.
 *
 * Results:
 *      TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *      The value at chanPtr is updated with a valid open Tcl_Channel.
 *
 *----------------------------------------------------------------------
 */

static int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_GetOpenChannel">GetOpenChannel</a>(Tcl_Interp *interp, Tcl_Obj *obj, int write,
        int check, Tcl_Channel *chanPtr)
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenChannel">Ns_TclGetOpenChannel</a>(interp, Tcl_GetString(obj), write, check, chanPtr);
}

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenChannel">Ns_TclGetOpenChannel</a>(Tcl_Interp *interp, char *chanId, int write,
        int check, Tcl_Channel *chanPtr)
{
    int mode;

    *chanPtr = Tcl_GetChannel(interp, chanId, &mode);
    if (*chanPtr == NULL) {
        return TCL_ERROR;
    }
    if (check &&
        ((write && !(mode & TCL_WRITABLE)) ||
         (!write && !(mode & TCL_READABLE)))) {
        Tcl_AppendResult(interp, "channel \"", chanId, "\" not open for ",
            write ? "write" : "read", NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a> --
 *
 *      Return an open Unix file descriptor for the given channel.
 *      This routine is used by the AOLserver * routines
 *      to provide access to the underlying socket.
 *
 * Results:
 *      TCL_OK or TCL_ERROR.
 *
 * Side effects:
 *      The value at fdPtr is updated with a valid Unix file descriptor.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(Tcl_Interp *interp, char *chanId, int write, int *fdPtr)
{
    Tcl_Channel chan;
    ClientData data;

    if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenChannel">Ns_TclGetOpenChannel</a>(interp, chanId, write, 1, &chan) != TCL_OK) {
        return TCL_ERROR;
    }
    if (Tcl_GetChannelHandle(chan, write ? TCL_WRITABLE : TCL_READABLE,
                             (ClientData*) &data) != TCL_OK) {
        Tcl_AppendResult(interp, "could not get handle for channel: ",
                         chanId, NULL);
        return TCL_ERROR;
    }
    *fdPtr = (int) data;
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclCpFpObjCmd">NsTclCpFpObjCmd</a> --
 *
 *      Implements ns_cpfp as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclCpFpObjCmd">NsTclCpFpObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    Tcl_Channel  in, out;
    char         buf[2048];
    char        *p;
    int          tocopy, nread, nwrote, toread, ntotal;

    if (objc != 3 && objc != 4) {
        Tcl_WrongNumArgs(interp, 1, objv, "inChan outChan ?ncopy?");
        return TCL_ERROR;
    }
    if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_GetOpenChannel">GetOpenChannel</a>(interp, objv[1], 0, 1, &in) != TCL_OK ||
        <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_GetOpenChannel">GetOpenChannel</a>(interp, objv[2], 1, 1, &out) != TCL_OK) {
        return TCL_ERROR;
    }
    if (objc == 3) {
        tocopy = -1;
    } else {
        if (Tcl_GetInt(interp, Tcl_GetString(objv[3]), &tocopy) != TCL_OK) {
            return TCL_ERROR;
        }
        if (tocopy < 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "invalid length \"", 
                Tcl_GetString(objv[3]),
                        "\": must be >= 0", NULL);
            return TCL_ERROR;
        }
    }
    
    ntotal = 0;
    while (tocopy != 0) {
        toread = sizeof(buf);
        if (tocopy > 0 && toread > tocopy) {
            toread = tocopy;
        }
        nread = Tcl_Read(in, buf, toread);
        if (nread == 0) {
            break;
        } else if (nread < 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "read failed: ",
                             Tcl_PosixError(interp), NULL);
            return TCL_ERROR;
        }
        if (tocopy > 0) {
            tocopy -= nread;
        }
        p = buf;
        while (nread > 0) {
            nwrote = Tcl_Write(out, p, nread);
            if (nwrote < 0) {
                Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "write failed: ",
                                 Tcl_PosixError(interp), NULL);
                return TCL_ERROR;
            }
            nread -= nwrote;
            ntotal += nwrote;
            p += nwrote;
        }
    }
    Tcl_SetObjResult(interp, Tcl_NewIntObj(ntotal));
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclCpObjCmd">NsTclCpObjCmd</a> --
 *
 *      Implements ns_cp as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclCpObjCmd">NsTclCpObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int             nread, towrite, nwrote;
    char            buf[4096], *src, *dst, *p, *emsg, *efile;
    int             preserve, result, rfd, wfd;
    struct stat     st;
    struct utimbuf  ut;
    
    if (objc != 3 && objc != 4) {
badargs:
        Tcl_WrongNumArgs(interp, 1, objv, "?-preserve? srcfile dstfile");
        return TCL_ERROR;
    }

    emsg  = "<unknown>";
    efile = "";

    wfd = rfd = -1;
    result = TCL_ERROR;

    if (objc == 3) {
        preserve = 0;
        src = Tcl_GetString(objv[1]);
        dst = Tcl_GetString(objv[2]);
    } else {
        if (!STREQ(Tcl_GetString(objv[1]), "-preserve")) {
            goto badargs;
        }
        preserve = 1;
        src = Tcl_GetString(objv[2]);
        dst = Tcl_GetString(objv[3]);
        if (stat(src, &st) != 0) {
            emsg = "stat";
            efile = src;
            goto done;
        }
    }

    emsg = "open";
    rfd = open(src, O_RDONLY|O_BINARY);
    if (rfd < 0) {
        efile = src;
        goto done;
    }
    wfd = open(dst, O_WRONLY|O_CREAT|O_TRUNC|O_BINARY, 0644);
    if (wfd < 0) {
        efile = dst;
        goto done;
    }

    while ((nread = read(rfd, buf, sizeof(buf))) > 0) {
        p = buf;
        towrite = nread;
        while (towrite > 0) {
            nwrote = write(wfd, p, (size_t)towrite);
            if (nwrote <= 0) {
                emsg = "write";
                efile = dst;
                goto done;
            }
            towrite -= nwrote;
            p += nwrote;
        }
    }
    if (nread < 0) {
        emsg = "read";
        efile = src;
        goto done;
    }

    if (!preserve) {
        result = TCL_OK;
    } else {
        efile = dst;
        if (chmod(dst, st.st_mode) != 0) {
            emsg = "chmod";
            goto done;
        }
        ut.actime  = st.st_atime;
        ut.modtime = st.st_mtime;
        if (utime(dst, &ut) != 0) {
            emsg = "utime";
            goto done;
        }
        result = TCL_OK;
    }

done:
    if (result != TCL_OK) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not ", emsg, " \"",
                efile, "\": ", Tcl_PosixError(interp), NULL);
    }
    if (rfd >= 0) {
        close(rfd);
    }
    if (wfd >= 0) {
        close(wfd);
    }
    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclMkdirObjCmd">NsTclMkdirObjCmd</a> --
 *
 *      Implements ns_mkdir as obj command.
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclMkdirObjCmd">NsTclMkdirObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "dir");
        return TCL_ERROR;
    }
    if (mkdir(Tcl_GetString(objv[1]), 0777) != 0) {
       Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "mkdir (\"", 
                Tcl_GetString(objv[1]),
                "\") failed:  ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclRmdirObjCmd">NsTclRmdirObjCmd</a> --
 *
 *      Implements ns_rmdir 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclRmdirObjCmd">NsTclRmdirObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "dir");
        return TCL_ERROR;
    }
    if (rmdir(Tcl_GetString(objv[1])) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "rmdir (\"", 
                Tcl_GetString(objv[1]),
                "\") failed:  ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclRollFileObjCmd">NsTclRollFileObjCmd</a> --
 *
 *      Implements ns_rollfile obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

static int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_FileObjCmd">FileObjCmd</a>(Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[], char *cmd)
{
    int max, status;

    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "file backupMax");
        return TCL_ERROR;
    }
    if (Tcl_GetIntFromObj(interp, objv[2], &max) != TCL_OK) {
        return TCL_ERROR;
    }
    if (max <= 0 || max > 1000) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "invalid max \"", 
                Tcl_GetString(objv[2]),
                "\": should be > 0 and <= 1000.", NULL);
        return TCL_ERROR;
    }
    if (*cmd == 'p') {
        status = <a href="/cvs/aolserver/aolserver/nsd/rollfile.c#A_Ns_PurgeFiles">Ns_PurgeFiles</a>(Tcl_GetString(objv[1]), max);
    } else {
        status = <a href="/cvs/aolserver/aolserver/nsd/rollfile.c#A_Ns_RollFile">Ns_RollFile</a>(Tcl_GetString(objv[1]), max);
    }
    if (status != NS_OK) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "could not ", cmd, " \"", 
                Tcl_GetString(objv[1]),
                "\": ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclRollFileObjCmd">NsTclRollFileObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_FileObjCmd">FileObjCmd</a>(interp, objc, objv, "roll");
}

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclPurgeFilesObjCmd">NsTclPurgeFilesObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    return <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_FileObjCmd">FileObjCmd</a>(interp, objc, objv, "purge");
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclUnlinkObjCmd">NsTclUnlinkObjCmd</a> --
 *
 *      Implement ns_unlink as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclUnlinkObjCmd">NsTclUnlinkObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int fComplain = NS_TRUE;

    if ((objc != 2) && (objc != 3)) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? filename");
        return TCL_ERROR;
    }

    if (objc == 3) {
        if (!STREQ(Tcl_GetString(objv[1]), "-nocomplain")) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unknown flag \"",
                    Tcl_GetString(objv[1]), "\": should be -nocomplain", 
                    NULL);
            return TCL_ERROR;
        } else {
            fComplain = NS_FALSE;
        }
    }

    if (unlink(Tcl_GetString(objv[objc-1])) != 0) {
        if (fComplain || errno != ENOENT) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "unlink (\"", 
                    Tcl_GetString(objv[objc-1]),
                    "\") failed:  ", Tcl_PosixError(interp), NULL);
            return TCL_ERROR;
        }
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclMkTempCmd">NsTclMkTempCmd</a> --
 *
 *      Implements ns_mktemp. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      Allocates memory for the filename as a TCL_VOLATILE object.
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclMkTempCmd">NsTclMkTempCmd</a>(ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
{
    char *buffer;

    if (argc != 2) {
        Tcl_AppendResult(interp, "wrong # of args: should be \"",
                         argv[0], " template\"", NULL);
        return TCL_ERROR;
    }

    buffer = ns_strdup(argv[1]);
    Tcl_SetResult(interp, mktemp(buffer), (Tcl_FreeProc *)ns_free);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclTmpNamObjCmd">NsTclTmpNamObjCmd</a> --
 *
 *      Implements ns_tmpnam as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclTmpNamObjCmd">NsTclTmpNamObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
#ifdef WIN32
    /*
      The WIN32 implmentation of tmpnam() ignores the environment
      variable TMP and generates filenames for the root
      directory. Unfortunately, new WIN versions (Vista) don't allow
      this. The suggested replacement is _tempnam().

      The first argument of _tempnam() is the default directory, in case
      the environment variable TMP is not set or points to a directory
      that does not exist.
    */
    int i;
    char *buf = _tempnam("/tmp", NULL);

    if (buf == NULL) {
        Tcl_SetResult(interp, "could not generate temporary filename.", TCL_STATIC);
        return TCL_ERROR;
    }
    /*
      Change back-slash characters into slash characters, as all other
      paths are slash separated. Even some programs under Windows
      do not allow back-slahed paths (e.g. Oracle's SqlLdr).
    */
    for (i = 0; i < strlen(buf); i++) {
        if (buf[i] == '\\') buf[i] = '/';
    }
    /* 
       The documentation says that _tempnam() allocates memory via
       malloc(); to be sure, that the "right" free() is used, we do
       not use TCL_DYNAMIC but the TCL_VOLATILE followed by the manual
       free().
    */
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
    free(buf);
#else
    char buf[L_tmpnam];

    if (tmpnam(buf) == NULL) {
        Tcl_SetResult(interp, "could not generate temporary filename.", TCL_STATIC);
        return TCL_ERROR;
    }
    Tcl_SetResult(interp, buf, TCL_VOLATILE);
#endif
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclNormalizePathObjCmd">NsTclNormalizePathObjCmd</a> --
 *
 *      Implements ns_normalizepath as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclNormalizePathObjCmd">NsTclNormalizePathObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    Ns_DString ds;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "path");
        return TCL_ERROR;
    }
    <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringInit">Ns_DStringInit</a>(&ds);
    <a href="/cvs/aolserver/aolserver/nsd/pathname.c#A_Ns_NormalizePath">Ns_NormalizePath</a>(&ds, Tcl_GetString(objv[1]));
    Tcl_SetResult(interp, ds.string, TCL_VOLATILE);
    <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringFree">Ns_DStringFree</a>(&ds);
    
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclUrl2FileObjCmd">NsTclUrl2FileObjCmd</a> --
 *
 *      Implements ns_url2file as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclUrl2FileObjCmd">NsTclUrl2FileObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    NsInterp *itPtr = arg;
    Ns_DString ds;

    if (objc != 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "url");
        return TCL_ERROR;
    }
    <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringInit">Ns_DStringInit</a>(&ds);
    <a href="/cvs/aolserver/aolserver/nsd/fastpath.c#A_NsUrlToFile">NsUrlToFile</a>(&ds, itPtr->servPtr, Tcl_GetString(objv[1]));
    Tcl_SetResult(interp, ds.string, TCL_VOLATILE);
    <a href="/cvs/aolserver/aolserver/nsd/dstring.c#A_Ns_DStringFree">Ns_DStringFree</a>(&ds);
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclKillObjCmd">NsTclKillObjCmd</a> --
 *
 *      Implements ns_kill as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclKillObjCmd">NsTclKillObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int pid, signal;

    if ((objc != 3) && (objc != 4)) {
      badargs:
        Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? pid signal");
        return TCL_ERROR;
    }
    if (objc == 3) {
        if (Tcl_GetIntFromObj(interp, objv[1], &pid) != TCL_OK) {
            return TCL_ERROR;
        }
        if (Tcl_GetIntFromObj(interp, objv[2], &signal) != TCL_OK) {
            return TCL_ERROR;
        }
        if (<a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_kill">kill</a>(pid, signal) != 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "<a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_kill">kill</a> (\"", 
                Tcl_GetString(objv[1]), ",", 
                Tcl_GetString(objv[2]),
                            "\") failed:  ", Tcl_PosixError(interp), NULL);
            return TCL_ERROR;
        }
    } else {
        if (strcmp(Tcl_GetString(objv[1]), "-nocomplain") != 0) {
            goto badargs;
        }
        if (Tcl_GetIntFromObj(interp, objv[2], &pid) != TCL_OK) {
            return TCL_ERROR;
        }
        if (Tcl_GetIntFromObj(interp, objv[3], &signal) != TCL_OK) {
            return TCL_ERROR;
        }
        <a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_kill">kill</a>(pid, signal);
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclLinkObjCmd">NsTclLinkObjCmd</a> --
 *
 *      Implements ns_link as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclLinkObjCmd">NsTclLinkObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    if ((objc != 3) && (objc != 4)) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? filename1 filename2");
        return TCL_ERROR;
    }
    if (objc == 3) {
        if (link(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])) != 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), 
                    "link (\"", Tcl_GetString(objv[1]), "\", \"", 
                    Tcl_GetString(objv[2]),
                    "\") failed:  ", Tcl_PosixError(interp), NULL);
            return TCL_ERROR;
        }
    } else {
        if (strcmp(Tcl_GetString(objv[1]), "-nocomplain") != 0) {
        Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? filename1 filename2");
            return TCL_ERROR;
        }
        link(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclSymlinkObjCmd">NsTclSymlinkObjCmd</a> --
 *
 *      Implements ns_symlink as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclSymlinkObjCmd">NsTclSymlinkObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    if ((objc != 3) && (objc != 4)) {
      badargs:
        Tcl_WrongNumArgs(interp, 1, objv, "?-nocomplain? filename1 filename2");
        return TCL_ERROR;
    }

    if (objc == 3) {
        if (<a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_symlink">symlink</a>(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])) != 0) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "<a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_symlink">symlink</a> (\"", 
                    Tcl_GetString(objv[1]), "\", \"", 
                    Tcl_GetString(objv[2]),
                    "\") failed:  ", Tcl_PosixError(interp), NULL);
            return TCL_ERROR;
        }
    } else {
        if (strcmp(Tcl_GetString(objv[1]), "-nocomplain") != 0) {
            goto badargs;
        }
        <a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_symlink">symlink</a>(Tcl_GetString(objv[2]), Tcl_GetString(objv[3]));
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclRenameObjCmd">NsTclRenameObjCmd</a> --
 *
 *      Implements ns_rename as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclRenameObjCmd">NsTclRenameObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "filename1 filename2");
        return TCL_ERROR;
    }
    if (rename(Tcl_GetString(objv[1]), Tcl_GetString(objv[2])) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "rename (\"", 
                Tcl_GetString(objv[1]), "\", \"", 
                Tcl_GetString(objv[2]),
                "\") failed:  ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclWriteFpObjCmd">NsTclWriteFpObjCmd</a> --
 *
 *      Implements ns_writefp as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclWriteFpObjCmd">NsTclWriteFpObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    NsInterp   *itPtr = arg;
    Tcl_Channel chan;
    int         nbytes = INT_MAX;
    int         result;

    if (objc != 2 && objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "fileid ?nbytes?");
            return TCL_ERROR;
    }
    if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_GetOpenChannel">GetOpenChannel</a>(interp, objv[1], 0, 1, &chan) != TCL_OK) {
            return TCL_ERROR;
    }
    if (objc == 3 && Tcl_GetIntFromObj(interp, objv[2], &nbytes) != TCL_OK) {
            return TCL_ERROR;
    }
    if (itPtr->conn == NULL) {
            Tcl_SetResult(interp, "no connection", TCL_STATIC);
            return TCL_ERROR;
    }
    result = <a href="/cvs/aolserver/aolserver/nsd/connio.c#A_Ns_ConnSendChannel">Ns_ConnSendChannel</a>(itPtr->conn, chan, nbytes);
    if (result != NS_OK) {
        Tcl_SetResult(interp, "i/o failed", TCL_STATIC);
            return TCL_ERROR;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclTruncateObjCmd">NsTclTruncateObjCmd</a> --
 *
 *      Implements ns_truncate as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclTruncateObjCmd">NsTclTruncateObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int length;
    
    if (objc != 2 && objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "file ?length?");
        return TCL_ERROR;
    }

    if (objc == 2) {
        length = 0;
    } else if (Tcl_GetIntFromObj(interp, objv[2], &length) != TCL_OK) {
        return TCL_ERROR;
    }

    if (<a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_truncate">truncate</a>(Tcl_GetString(objv[1]), length) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "<a href="/cvs/aolserver/aolserver/nsd/nswin32.c#A_truncate">truncate</a> (\"", 
                Tcl_GetString(objv[1]), "\", ",
                Tcl_GetString(objv[2]) ? Tcl_GetString(objv[2]) : "0",
                ") failed:  ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclFTruncateObjCmd">NsTclFTruncateObjCmd</a> --
 *
 *      Implements ns_ftruncate as obj command. 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclFTruncateObjCmd">NsTclFTruncateObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int length, fd;
    
    if (objc != 2 && objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "fileId ?length?");
        return TCL_ERROR;
    }
    if (<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_Ns_TclGetOpenFd">Ns_TclGetOpenFd</a>(interp, Tcl_GetString(objv[1]), 1, &fd) != TCL_OK) {
        return TCL_ERROR;
    }
    if (objc == 2) {
        length = 0;
    } else if (Tcl_GetInt(interp, Tcl_GetString(objv[2]), &length) != TCL_OK) {
        return TCL_ERROR;
    }
    if (ftruncate(fd, length) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "ftruncate (\"", 
            Tcl_GetString(objv[1]), "\", ",
            Tcl_GetString(objv[2]) ? Tcl_GetString(objv[2]) : "0",
            ") failed:  ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclChmodObjCmd">NsTclChmodObjCmd</a> --
 *
 *      NsTclChmodCmd 
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclChmodObjCmd">NsTclChmodObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    int mode;
    
    if (objc != 3) {
        Tcl_WrongNumArgs(interp, 1, objv, "filename mode");
        return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[2], &mode) != TCL_OK) {
        return TCL_ERROR;
    }

    if (chmod(Tcl_GetString(objv[1]), (mode_t)mode) != 0) {
        Tcl_AppendStringsToObj(Tcl_GetObjResult(interp), "chmod (\"", 
                Tcl_GetString(objv[1]), "\", ", 
                Tcl_GetString(objv[2]),
                ") failed:  ", Tcl_PosixError(interp), NULL);
        return TCL_ERROR;
    }

    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclChanObjCmd">NsTclChanObjCmd</a> --
 *
 *      Implement the ns_chan command.
 *
 * Results:
 *      Tcl result. 
 *
 * Side effects:
 *      See docs. 
 *
 *----------------------------------------------------------------------
 */

int
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_NsTclChanObjCmd">NsTclChanObjCmd</a>(ClientData arg, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
    NsInterp *itPtr = arg;
    NsServer *servPtr = itPtr->servPtr;
    Tcl_Channel chan = NULL;
    char *name, *chanName;
    NsRegChan *regChan = NULL;
    int new, shared;
    Tcl_HashTable *tabPtr;
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch search;
    static CONST char *opts[] = {
        "cleanup", "list", "create", "put", "get", NULL
    };
    enum {
        CCleanupIdx, CListIdx, CCreateIdx, CPutIdx, CGetIdx
    } _nsmayalias opt;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "command ?args?");
        return TCL_ERROR;
    }
    if (Tcl_GetIndexFromObj(interp, objv[1], opts, "option", 0,
                (int *) &opt) != TCL_OK) {
        return TCL_ERROR;
    }

    switch (opt) {
    case CCreateIdx:
        if (objc != 4) {
            Tcl_WrongNumArgs(interp, 1, objv, "create channel name");
            return TCL_ERROR;
        }
        chanName = Tcl_GetString(objv[2]);
        chan = Tcl_GetChannel(interp, chanName, NULL);
        if (chan == (Tcl_Channel)NULL) {
            return TCL_ERROR;
        }
        if (Tcl_IsChannelShared(chan)) {
            Tcl_SetResult(interp, "channel is shared", TCL_STATIC);
            return TCL_ERROR;
        }
        name = Tcl_GetString(objv[3]);
        Ns_MutexLock(&servPtr->chans.lock);
        hPtr = Tcl_CreateHashEntry(&servPtr->chans.table, name, &new);
        if (new) {
            regChan = ns_malloc(sizeof(NsRegChan));
            regChan->name = ns_malloc(strlen(chanName)+1);
            regChan->chan = chan;
            strcpy(regChan->name, chanName);
            Tcl_SetHashValue(hPtr, regChan);
        }
        Ns_MutexUnlock(&servPtr->chans.lock);
        if (!new) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "channel with name \"", Tcl_GetString(objv[3]),
                    "\" already exists", NULL);
            return TCL_ERROR;
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_UnspliceChannel">UnspliceChannel</a>(interp, chan);
        break;

    case CGetIdx:
        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 1, objv, "get name");
            return TCL_ERROR;
        }
        name = Tcl_GetString(objv[2]);
        Ns_MutexLock(&servPtr->chans.lock);
        hPtr = Tcl_FindHashEntry(&servPtr->chans.table, name);
        if (hPtr != NULL) {
            regChan = (NsRegChan*)Tcl_GetHashValue(hPtr);
            Tcl_DeleteHashEntry(hPtr);
        }
        Ns_MutexUnlock(&servPtr->chans.lock);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                    "no such shared channel: ", name, NULL);
            return TCL_ERROR;
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_SpliceChannel">SpliceChannel</a>(interp, regChan->chan);
        Tcl_SetResult(interp, regChan->name, TCL_VOLATILE);
        hPtr = Tcl_CreateHashEntry(&itPtr->chans, name, &new);
        Tcl_SetHashValue(hPtr, regChan);
        break;

    case CPutIdx:
        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 1, objv, "put name");
            return TCL_ERROR;
        }
        name = Tcl_GetString(objv[2]);
        hPtr = Tcl_FindHashEntry(&itPtr->chans, name);
        if (hPtr == NULL) {
            Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
                   "no such shared channel: ", name, NULL);
            return TCL_ERROR;
        }
        regChan = (NsRegChan*)Tcl_GetHashValue(hPtr);
    chan = Tcl_GetChannel(interp, regChan->name, NULL);
        if (chan == (Tcl_Channel)NULL || chan != regChan->chan) {
            Tcl_DeleteHashEntry(hPtr);
        if (chan != regChan->chan) {
            Tcl_SetResult(interp, "channel mismatch", TCL_STATIC);
        }
            return TCL_ERROR;
        }
        <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_UnspliceChannel">UnspliceChannel</a>(interp, regChan->chan);
        Tcl_DeleteHashEntry(hPtr);
        Ns_MutexLock(&servPtr->chans.lock);
        hPtr = Tcl_CreateHashEntry(&servPtr->chans.table, name, &new);
        Tcl_SetHashValue(hPtr, regChan);
        Ns_MutexUnlock(&servPtr->chans.lock);
        break;

    case CListIdx:
        if (objc != 2 && objc != 3) {
            Tcl_WrongNumArgs(interp, 1, objv, "list ?-shared?");
            return TCL_ERROR;
        }
        shared = (objc == 3);
        if (shared) {
            Ns_MutexLock(&servPtr->chans.lock);
            tabPtr = &servPtr->chans.table; 
        } else {
            tabPtr = &itPtr->chans;
        }
        hPtr = Tcl_FirstHashEntry(tabPtr, &search);
        while (hPtr != NULL) {
            Tcl_AppendElement(interp, Tcl_GetHashKey(tabPtr, hPtr));
            hPtr = Tcl_NextHashEntry(&search);
        }
        if (shared) {
            Ns_MutexUnlock(&servPtr->chans.lock);
        }
        break;

    case CCleanupIdx:
        if (objc != 2 && objc != 3) {
            Tcl_WrongNumArgs(interp, 1, objv, "cleanup ?-shared?");
            return TCL_ERROR;
        }
        shared = (objc == 3);
        if (shared) {
            Ns_MutexLock(&servPtr->chans.lock);
            tabPtr = &servPtr->chans.table;
        } else {
            tabPtr = &itPtr->chans;
        }
        hPtr = Tcl_FirstHashEntry(tabPtr, &search);
        while (hPtr != NULL) {
            regChan = (NsRegChan*)Tcl_GetHashValue(hPtr);
            if (shared) {
                Tcl_SpliceChannel(regChan->chan);
                Tcl_UnregisterChannel((Tcl_Interp*)NULL, regChan->chan);
            } else {
                Tcl_UnregisterChannel(interp, regChan->chan);
            }
            ns_free(regChan->name);
            ns_free(regChan);
            Tcl_DeleteHashEntry(hPtr);
            hPtr = Tcl_NextHashEntry(&search);
        }
        if (shared) {
            Ns_MutexUnlock(&servPtr->chans.lock);
        }
        break;
    }
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_SpliceChannel">SpliceChannel</a> 
 *
 *      Adds the shared channel in the interp/thread. 
 *
 * Results:
 *      None.   
 *
 * Side effects:
 *      New channel appears in the interp. 
 *
 *----------------------------------------------------------------------
 */

static void 
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_SpliceChannel">SpliceChannel</a>(Tcl_Interp *interp, Tcl_Channel chan)
{
    Tcl_SpliceChannel(chan);
    Tcl_RegisterChannel(interp, chan);
    Tcl_UnregisterChannel((Tcl_Interp*)NULL, chan); /* Prevent closing */
}


/*
 *----------------------------------------------------------------------
 *
 * <a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_UnspliceChannel">UnspliceChannel</a> 
 *
 *      Divorces the channel from its owning interp/thread.     
 *
 * Results:
 *      None.   
 *
 * Side effects:
 *      Channel is not accesible by Tcl scripts any more.       
 *
 *----------------------------------------------------------------------
 */

static void 
<a href="/cvs/aolserver/aolserver/nsd/tclfile.c#A_UnspliceChannel">UnspliceChannel</a>(Tcl_Interp *interp, Tcl_Channel chan)
{
    Tcl_ClearChannelHandlers(chan);
    Tcl_RegisterChannel((Tcl_Interp*)NULL, chan); /* Prevent closing */
    Tcl_UnregisterChannel(interp, chan);
    Tcl_CutChannel(chan);
}
