void
DumpString(Tcl_DString *dsPtr)
{
char **largv;
int i, largc;
if (Tcl_SplitList(NULL, dsPtr->string, &largc, (CONST char***)&largv) == TCL_OK) {
for (i = 0; i < largc; ++i) {
printf("\t%s\n", largv[i]);
}
ckfree((char *) largv);
}
Tcl_DStringTrunc(dsPtr, 0);
}
int
NsTclEnvCmd(ClientData dummy, Tcl_Interp *interp, int argc, char **argv)
{
char *name, *value, **envp;
int status, i;
Tcl_DString ds;
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " command ?args ...?\"", NULL);
return TCL_ERROR;
}
status = TCL_OK;
Ns_MutexLock(&lock);
if (STREQ(argv[1], "names")) {
if (argc != 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " names\"", NULL);
status = TCL_ERROR;
} else {
Tcl_DStringInit(&ds);
envp = Ns_GetEnviron();
for (i = 0; envp[i] != NULL; ++i) {
name = envp[i];
value = strchr(name, '=');
Tcl_DStringAppend(&ds, name, value ? value - name : -1);
Tcl_AppendElement(interp, ds.string);
Tcl_DStringTrunc(&ds, 0);
}
Tcl_DStringFree(&ds);
}
} else if (STREQ(argv[1], "exists")) {
if (argc != 3) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " exists name\"", NULL);
status = TCL_ERROR;
} else {
Tcl_SetResult(interp, getenv(argv[2]) ? "1" : "0", TCL_STATIC);
}
} else if (STREQ(argv[1], "get")) {
if ((argc != 3 && argc != 4) ||
(argc == 4 && !STREQ(argv[2], "-nocomplain"))) {
badargs:
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " ", argv[1], " ?-nocomplain? name\"", NULL);
status = TCL_ERROR;
}
name = argv[argc-1];
value = getenv(name);
if (value != NULL) {
Tcl_SetResult(interp, value, TCL_VOLATILE);
} else if (argc == 4) {
Tcl_AppendResult(interp, "no such environment variable: ",
argv[argc-1], NULL);
status = TCL_ERROR;
}
} else if (STREQ(argv[1], "set")) {
if (argc != 4) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
argv[0], " set name value\"", NULL);
status = TCL_ERROR;
} else {
status = PutEnv(interp, argv[2], argv[3]);
}
} else if (STREQ(argv[1], "unset")) {
if ((argc != 3 && argc != 4) ||
(argc == 4 && !STREQ(argv[2], "-nocomplain"))) {
goto badargs;
}
name = argv[argc-1];
if (argc == 3 && getenv(name) == NULL) {
Tcl_AppendResult(interp, "no such environment variable: ", name,
NULL);
status = TCL_ERROR;
} else {
status = PutEnv(interp, name, "");
}
} else {
Tcl_AppendResult(interp, "unknown command \"",
argv[1], "\": should be exists, names, get, set, or unset", NULL);
status = TCL_ERROR;
}
Ns_MutexUnlock(&lock);
return status;
}
int CallModuleProcedure( Tcl_Interp *interp,
Tcl_DString *cmdptr,
char *modulefile,
char *procname,
int suppress_output)
{
char cmdline[ LINELENGTH];
char *cmd;
int result;
int saved_stdout = 0, saved_stderr = 0, devnull;
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_START, LOC, _proc_CallModuleProcedure, NULL);
#endif
/**
** Must send stdout and stderr to /dev/null until the
** ModulesHelp procedure is called.
**/
if( suppress_output) {
if( 0 > (devnull = open( _fil_devnull, O_RDWR))) {
if( OK != ErrorLogger( ERR_OPEN, LOC, _fil_devnull, "changing", NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
/**
** Close STDOUT and reopen it as /dev/null
**/
if( -1 == ( saved_stdout = dup( 1)))
if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == close( 1))
if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == dup( devnull))
if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
/**
** Close STDERR and reopen it as /dev/null
**/
if( -1 == ( saved_stdout = dup( 2)))
if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == close( 2))
if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == dup( devnull))
if( OK != ErrorLogger( ERR_DUP, LOC, _fil_devnull, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
}
/**
** Read the passed module file
**/
Read_Modulefile( interp, modulefile);
/**
** Reinstall stdout and stderr
**/
if( suppress_output) {
/**
** Reinstall STDOUT
**/
if( EOF == fflush( stdout))
if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stdout, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( EOF == fflush( stderr))
if( OK != ErrorLogger( ERR_FLUSH, LOC, _fil_stderr, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == close( 1))
if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stdout, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
/**
** Reinstall STDERR
**/
if( -1 == dup( saved_stdout))
if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stdout, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == close( 2))
if( OK != ErrorLogger( ERR_CLOSE, LOC, _fil_stderr, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
if( -1 == dup( saved_stderr))
if( OK != ErrorLogger( ERR_DUP, LOC, _fil_stderr, NULL))
return( TCL_ERROR); /** ------- EXIT (FAILURE) --------> **/
}
/**
** Now evaluate the Tcl Procedure
**/
/* sprintf( cmdline, "%s\n", procname); */
strcpy( cmdline, procname);
strcat( cmdline, "\n");
cmd = Tcl_DStringAppend( cmdptr, cmdline, (-1));
result = Tcl_Eval( interp, cmd);
Tcl_DStringTrunc( cmdptr, 0);
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_END, LOC, _proc_CallModuleProcedure, NULL);
#endif
return( result);
} /** End of 'CallModuleProcedure' **/
int Execute_TclFile( Tcl_Interp *interp,
char *filename)
{
FILE *infile;
int gotPartial = 0;
int result = 0;
EM_RetVal em_result = EM_OK;
char *cmd;
Tcl_DString cmdbuf;
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_START, LOC, _proc_Execute_TclFile, NULL);
#endif
/**
** If there isn't a line buffer allocated so far, do it now
**/
if( line == NULL) {
if( NULL == (line = (char*) module_malloc(LINELENGTH * sizeof(char)))) {
if( OK != ErrorLogger( ERR_ALLOC, LOC, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
}
/**
** If we're supposed to be interpreting from stdin, set infile
** equal to stdin, otherwise, open the file and interpret
**/
if( !strcmp( filename, _fil_stdin)) {
infile = stdin;
} else {
if( NULL == (infile = fopen( filename, "r"))) {
if( OK != ErrorLogger( ERR_OPEN, LOC, filename, "reading", NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
}
}
/**
** Allow access to which file is being loaded.
**/
linenum = 0;
Tcl_SetVar( interp, "ModulesCurrentModulefile", filename, 0);
Tcl_DStringInit( &cmdbuf);
while( 1) {
linenum++;
if( fgets(line, LINELENGTH, infile) == NULL) {
if( !gotPartial) {
break; /** while **/
}
line[0] = '\0';
}
/**
** Put the whole command on the command buffer
**/
cmd = Tcl_DStringAppend( &cmdbuf, line, (-1));
if( line[0] != 0 && !Tcl_CommandComplete(cmd)) {
gotPartial++;
continue;
}
/**
** Now evaluate the command and react on its result
** Reinitialize the command buffer
**/
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_DEBUG, LOC, " Evaluating '", cmd, "'", NULL);
#endif
result = Tcl_Eval( interp, cmd);
if( EM_ERROR == (em_result = ReturnValue(interp, result))) {
ErrorLogger( ERR_EXEC, LOC, cmd, NULL);
}
Tcl_DStringTrunc( &cmdbuf, 0);
#if WITH_DEBUGGING_UTIL_1
{
char buffer[ 80];
switch( result) {
case TCL_OK: strcpy( buffer, "TCL_OK");
break;
case TCL_ERROR: strcpy( buffer, "TCL_ERROR");
break;
case TCL_LEVEL0_RETURN:
strcpy( buffer, "TCL_LEVEL0_RETURN");
break;
}
ErrorLogger( NO_ERR_DEBUG, LOC, " Result: '", buffer, "'", NULL);
}
#endif
switch( result) {
case TCL_OK: gotPartial = 0;
continue; /** while **/
case TCL_ERROR: interp->errorLine = ((linenum-1)-gotPartial) +
interp->errorLine;
/* FALLTHROUGH */
case TCL_LEVEL0_RETURN:
break; /** switch **/
}
/**
** If the while loop hasn't been continued so far, it is to be broken
** now
**/
break; /** while **/
} /** while **/
/**
** Free up what has been used, close the input file and return the result
** of the last command to the caller
**/
Tcl_DStringFree( &cmdbuf);
if( EOF == fclose( infile))
if( OK != ErrorLogger( ERR_CLOSE, LOC, filename, NULL))
return( TCL_ERROR); /** -------- EXIT (FAILURE) -------> **/
#if WITH_DEBUGGING_UTIL_1
ErrorLogger( NO_ERR_END, LOC, _proc_Execute_TclFile, NULL);
#endif
return( result);
} /** End of 'Execute_TclFile' **/
int
Ns_ConnSend(Ns_Conn *conn, struct iovec *bufs, int nbufs)
{
Conn *connPtr = (Conn *) conn;
int nwrote, towrite, i, n;
struct iovec sbufs[16];
/*
* Send up to 16 buffers, including the queued output
* buffer if necessary.
*/
towrite = 0;
n = 0;
if (connPtr->obuf.length > 0) {
sbufs[n].iov_base = connPtr->obuf.string;
sbufs[n].iov_len = connPtr->obuf.length;
towrite += sbufs[n].iov_len;
++n;
}
for (i = 0; i < nbufs && n < 16; ++i) {
if (bufs[i].iov_len > 0 && bufs[i].iov_base != NULL) {
sbufs[n].iov_base = bufs[i].iov_base;
sbufs[n].iov_len = bufs[i].iov_len;
towrite += bufs[i].iov_len;
++n;
}
}
nbufs = n;
bufs = sbufs;
n = nwrote = 0;
while (towrite > 0) {
n = NsConnSend(conn, bufs, nbufs);
if (n < 0) {
break;
}
towrite -= n;
nwrote += n;
if (towrite > 0) {
for (i = 0; i < nbufs && n > 0; ++i) {
if (n > (int) bufs[i].iov_len) {
n -= bufs[i].iov_len;
bufs[i].iov_base = NULL;
bufs[i].iov_len = 0;
} else {
bufs[i].iov_base = (char *) bufs[i].iov_base + n;
bufs[i].iov_len -= n;
n = 0;
}
}
}
}
if (nwrote > 0) {
connPtr->nContentSent += nwrote;
if (connPtr->obuf.length > 0) {
n = connPtr->obuf.length - nwrote;
if (n <= 0) {
nwrote -= connPtr->obuf.length;
Tcl_DStringTrunc(&connPtr->obuf, 0);
} else {
memmove(connPtr->obuf.string,
connPtr->obuf.string + nwrote, (size_t)n);
Tcl_DStringTrunc(&connPtr->obuf, n);
nwrote = 0;
}
}
} else {
/*
* Return error on first send, if any, from NsSockSend above.
*/
nwrote = n;
}
if (nwrote >= 0
&& NsRunFilters((Ns_Conn *) connPtr, NS_FILTER_WRITE) != NS_OK) {
nwrote = -1;
}
return nwrote;
}
int
NsAdpFlush(NsInterp *itPtr, int stream)
{
Ns_Conn *conn;
Tcl_Interp *interp = itPtr->interp;
int len, wrote, result = TCL_ERROR, flags = itPtr->adp.flags;
char *buf;
/*
* Verify output context.
*/
if (itPtr->adp.conn == NULL && itPtr->adp.chan == NULL) {
Tcl_SetResult(interp, "no adp output context", TCL_STATIC);
return TCL_ERROR;
}
buf = itPtr->adp.output.string;
len = itPtr->adp.output.length;
/*
* If enabled, trim leading whitespace if no content has been sent yet.
*/
if ((flags & ADP_TRIM) && !(flags & ADP_FLUSHED)) {
while (len > 0 && isspace(UCHAR(*buf))) {
++buf;
--len;
}
}
/*
* Leave error messages if output is disabled or failed. Otherwise,
* send data if there's any to send or stream is 0, indicating this
* is the final flush call.
*/
Tcl_ResetResult(interp);
if (itPtr->adp.exception == ADP_ABORT) {
Tcl_SetResult(interp, "adp flush disabled: adp aborted", TCL_STATIC);
} else if (len == 0 && stream) {
result = TCL_OK;
} else {
if (itPtr->adp.chan != NULL) {
while (len > 0) {
wrote = Tcl_Write(itPtr->adp.chan, buf, len);
if (wrote < 0) {
Tcl_AppendResult(interp, "write failed: ",
Tcl_PosixError(interp), NULL);
break;
}
buf += wrote;
len -= wrote;
}
if (len == 0) {
result = TCL_OK;
}
} else if (NsTclGetConn(itPtr, &conn) == TCL_OK) {
if (conn->flags & NS_CONN_CLOSED) {
Tcl_SetResult(interp, "adp flush failed: connection closed",
TCL_STATIC);
} else {
if (flags & ADP_GZIP) {
Ns_ConnSetGzipFlag(conn, 1);
}
if (!(flags & ADP_FLUSHED) && (flags & ADP_EXPIRE)) {
Ns_ConnCondSetHeaders(conn, "Expires", "now");
}
if (Ns_ConnFlush(itPtr->conn, buf, len, stream) == NS_OK) {
result = TCL_OK;
} else {
Tcl_SetResult(interp,
"adp flush failed: connection flush error",
TCL_STATIC);
}
}
}
itPtr->adp.flags |= ADP_FLUSHED;
/*
* Raise an abort exception if autoabort is enabled.
*/
if (result != TCL_OK && (flags & ADP_AUTOABORT)) {
Tcl_AddErrorInfo(interp, "\n abort exception raised");
NsAdpLogError(itPtr);
itPtr->adp.exception = ADP_ABORT;
}
}
Tcl_DStringTrunc(&itPtr->adp.output, 0);
if (!stream) {
NsAdpReset(itPtr);
}
return result;
}
