int tclcommand_replacestdchannel(ClientData clientData, Tcl_Interp *interp, int argc, char **argv)
{
Tcl_Channel channel=NULL;
if (argc != 3){
Tcl_AppendResult(interp,"Wrong # of args! Usage: ",argv[0]," [stdout|stderr|stdin] <pipename>",(char *)NULL);
return TCL_ERROR;
}
if(access(argv[2],F_OK)<0){
Tcl_AppendResult(interp,"File ",argv[2]," does not exist!",(char *) NULL);
return TCL_ERROR;
}
if(strcmp(argv[1],"stdout")==0){
if(access(argv[2],W_OK)<0){
Tcl_AppendResult(interp,"You do not have permission to access ",argv[2],(char *) NULL);
return TCL_ERROR;
}
Tcl_UnregisterChannel(interp,Tcl_GetStdChannel(TCL_STDOUT));
channel = Tcl_OpenFileChannel(interp, argv[2], "WRONLY",0666);
Tcl_RegisterChannel(interp,channel);
Tcl_SetStdChannel(channel,TCL_STDOUT);
}
else if(strcmp(argv[1],"stderr")==0){
if(access(argv[2],W_OK)<0){
Tcl_AppendResult(interp,"You do not have permission to access ",argv[2],(char *) NULL);
return TCL_ERROR;
}
Tcl_UnregisterChannel(interp,Tcl_GetStdChannel(TCL_STDERR));
channel = Tcl_OpenFileChannel(interp, argv[2], "WRONLY",0666);
Tcl_RegisterChannel(interp,channel);
Tcl_SetStdChannel(channel,TCL_STDERR);
}
else if(strcmp(argv[1],"stdin")==0){
if(access(argv[2],R_OK)<0){
Tcl_AppendResult(interp,"You do not have permission to access ",argv[2],(char *) NULL);
return TCL_ERROR;
}
Tcl_UnregisterChannel(interp,Tcl_GetStdChannel(TCL_STDIN));
channel = Tcl_OpenFileChannel(interp, argv[2], "RDONLY",0666);
Tcl_RegisterChannel(interp,channel);
Tcl_SetStdChannel(channel,TCL_STDIN);
}
else{
Tcl_AppendResult(interp,"invalid first argument (got: ",argv[1]," )",(char *) NULL);
return TCL_ERROR;
}
if(channel == NULL)
return TCL_ERROR;
return TCL_OK;
}
int
Pg_disconnect(ClientData cData, Tcl_Interp *interp, int argc, CONST84 char *argv[])
{
PGconn *conn;
Tcl_Channel conn_chan;
if (argc != 2)
{
Tcl_AppendResult(interp, "Wrong # of arguments\n", "pg_disconnect connection", 0);
return TCL_ERROR;
}
conn_chan = Tcl_GetChannel(interp, argv[1], 0);
if (conn_chan == NULL)
{
Tcl_ResetResult(interp);
Tcl_AppendResult(interp, argv[1], " is not a valid connection", 0);
return TCL_ERROR;
}
/* Check that it is a PG connection and not something else */
conn = PgGetConnectionId(interp, argv[1], (Pg_ConnectionId **) NULL);
if (conn == (PGconn *) NULL)
return TCL_ERROR;
return Tcl_UnregisterChannel(interp, conn_chan);
}
bool ecAdminDialog::EvalTclFile(int nargc, const wxString& Argv, const wxString& msg)
{
wxProgressDialog dlgWait(msg, _("Please wait..."), 100, this);
dlgWait.Update(50);
//TRACE (_T("Evaluating ecosadmin.tcl %s\n"), pszArgv);
// set up the data structure which is passed to the Tcl thread
wxString strArgc;
strArgc.Printf (wxT("%d"), nargc);
std::string argv0 = ecUtils::UnicodeToStdStr (m_strRepository) + "/ecosadmin.tcl";
std::string argv = ecUtils::UnicodeToStdStr (Argv);
std::string argc = ecUtils::UnicodeToStdStr (strArgc);
Tcl_Interp * interp = Tcl_CreateInterp ();
#ifdef __WXMSW__
Tcl_Channel outchan = Tcl_OpenFileChannel (interp, "nul", "a+", 777);
Tcl_SetStdChannel (outchan, TCL_STDOUT); // direct standard output to NUL:
#endif
const char * pszStatus = Tcl_SetVar (interp, "argv0", (char*) argv0.c_str(), 0);
pszStatus = Tcl_SetVar (interp, "argv", (char*) argv.c_str(), 0);
pszStatus = Tcl_SetVar (interp, "argc", (char*) argc.c_str(), 0);
pszStatus = Tcl_SetVar (interp, "gui_mode", "1", 0); // return errors in result string
int nStatus = Tcl_EvalFile (interp, (char*) argv0.c_str());
const char* result = Tcl_GetStringResult (interp);
#ifdef __WXMSW__
Tcl_SetStdChannel (NULL, TCL_STDOUT);
Tcl_UnregisterChannel (interp, outchan);
#endif
Tcl_DeleteInterp (interp);
wxString strErrorMessage (result);
// report any error
if (! strErrorMessage.IsEmpty ())
{
wxString msg (_("Command execution error:\n\n") + strErrorMessage);
wxMessageBox(msg, wxGetApp().GetSettings().GetAppName(), wxICON_EXCLAMATION|wxOK);
return FALSE;
}
else if (TCL_OK != nStatus)
{
wxString msg (_("Command execution error"));
wxMessageBox(msg, wxGetApp().GetSettings().GetAppName(), wxICON_EXCLAMATION|wxOK);
return FALSE;
}
return TRUE;
}
/* ARGSUSED */
int
Tcl_CloseObjCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
Tcl_Channel chan; /* The channel to close. */
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "channelId");
return TCL_ERROR;
}
if (TclGetChannelFromObj(interp, objv[1], &chan, NULL, 0) != TCL_OK) {
return TCL_ERROR;
}
if (Tcl_UnregisterChannel(interp, chan) != TCL_OK) {
/*
* If there is an error message and it ends with a newline, remove the
* newline. This is done for command pipeline channels where the error
* output from the subprocesses is stored in interp's result.
*
* NOTE: This is likely to not have any effect on regular error
* messages produced by drivers during the closing of a channel,
* because the Tcl convention is that such error messages do not have
* a terminating newline.
*/
Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
char *string;
int len;
if (Tcl_IsShared(resultPtr)) {
resultPtr = Tcl_DuplicateObj(resultPtr);
Tcl_SetObjResult(interp, resultPtr);
}
string = TclGetStringFromObj(resultPtr, &len);
if ((len > 0) && (string[len - 1] == '\n')) {
Tcl_SetObjLength(resultPtr, len - 1);
}
return TCL_ERROR;
}
return TCL_OK;
}
/*-----------------------------------------------------------------------------
* CloseForError --
*
* Close a file on error. If the file is associated with a channel, close
* it too. The error number will be saved and not lost.
*
* Parameters:
* o interp (I) - Current interpreter.
* o channel (I) - Channel to close if not NULL.
* o fileNum (I) - File number to close if >= 0.
*-----------------------------------------------------------------------------
*/
static void
CloseForError (Tcl_Interp *interp,
Tcl_Channel channel,
int fileNum)
{
int saveErrNo = Tcl_GetErrno ();
/*
* Always close fileNum, even if channel close is done, as it doesn't
* close stdin, stdout or stderr numbers.
*/
if (channel != NULL)
Tcl_UnregisterChannel (interp, channel);
if (fileNum >= 0)
close (fileNum);
Tcl_SetErrno (saveErrNo);
}
void
TnmDeleteSocketHandler(int sock)
{
SocketHandler **shPtrPtr;
for (shPtrPtr = &socketHandlerList; *shPtrPtr; ) {
if ((*shPtrPtr)->sd == sock) {
Tcl_DeleteChannelHandler((*shPtrPtr)->channel,
(*shPtrPtr)->proc,
(*shPtrPtr)->clientData);
Tcl_UnregisterChannel((Tcl_Interp *) NULL, (*shPtrPtr)->channel);
*shPtrPtr = (*shPtrPtr)->nextPtr;
} else {
shPtrPtr = &(*shPtrPtr)->nextPtr;
}
}
}
static void
AcceptCallbackProc(
ClientData callbackData, /* The data stored when the callback was
* created in the call to
* Tcl_OpenTcpServer. */
Tcl_Channel chan, /* Channel for the newly accepted
* connection. */
char *address, /* Address of client that was accepted. */
int port) /* Port of client that was accepted. */
{
AcceptCallback *acceptCallbackPtr = (AcceptCallback *) callbackData;
/*
* Check if the callback is still valid; the interpreter may have gone
* away, this is signalled by setting the interp field of the callback
* data to NULL.
*/
if (acceptCallbackPtr->interp != NULL) {
char portBuf[TCL_INTEGER_SPACE];
char *script = acceptCallbackPtr->script;
Tcl_Interp *interp = acceptCallbackPtr->interp;
int result;
Tcl_Preserve(script);
Tcl_Preserve(interp);
TclFormatInt(portBuf, port);
Tcl_RegisterChannel(interp, chan);
/*
* Artificially bump the refcount to protect the channel from being
* deleted while the script is being evaluated.
*/
Tcl_RegisterChannel(NULL, chan);
result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan),
" ", address, " ", portBuf, NULL);
if (result != TCL_OK) {
TclBackgroundException(interp, result);
Tcl_UnregisterChannel(interp, chan);
}
/*
* Decrement the artificially bumped refcount. After this it is not
* safe anymore to use "chan", because it may now be deleted.
*/
Tcl_UnregisterChannel(NULL, chan);
Tcl_Release(interp);
Tcl_Release(script);
} else {
/*
* The interpreter has been deleted, so there is no useful way to
* utilize the client socket - just close it.
*/
Tcl_Close(NULL, chan);
}
}
int
TclFileTemporaryCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
* file in. */
Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
* file, or NULL if there's an error. */
Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
/* Pieces of template. Each piece is NULL if
* it is omitted. The platform temporary file
* engine might ignore some pieces. */
if (objc < 1 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
return TCL_ERROR;
}
if (objc > 1) {
nameVarObj = objv[1];
TclNewObj(nameObj);
}
if (objc > 2) {
int length;
Tcl_Obj *templateObj = objv[2];
const char *string = TclGetStringFromObj(templateObj, &length);
/*
* Treat an empty string as if it wasn't there.
*/
if (length == 0) {
goto makeTemporary;
}
/*
* The template only gives a directory if there is a directory
* separator in it.
*/
if (strchr(string, '/') != NULL
|| (tclPlatform == TCL_PLATFORM_WINDOWS
&& strchr(string, '\\') != NULL)) {
tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
/*
* Only allow creation of temporary files in the native filesystem
* since they are frequently used for integration with external
* tools or system libraries. [Bug 2388866]
*/
if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
!= &tclNativeFilesystem) {
TclDecrRefCount(tempDirObj);
tempDirObj = NULL;
}
}
/*
* The template only gives the filename if the last character isn't a
* directory separator.
*/
if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
|| string[length-1] != '\\')) {
Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
TCL_PATH_TAIL);
if (tailObj != NULL) {
tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
TclDecrRefCount(tailObj);
}
}
}
/*
* Convert empty parts of the template into unspecified parts.
*/
if (tempDirObj && !TclGetString(tempDirObj)[0]) {
TclDecrRefCount(tempDirObj);
tempDirObj = NULL;
}
if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
TclDecrRefCount(tempBaseObj);
tempBaseObj = NULL;
}
if (tempExtObj && !TclGetString(tempExtObj)[0]) {
TclDecrRefCount(tempExtObj);
tempExtObj = NULL;
}
/*
* Create and open the temporary file.
*/
makeTemporary:
chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
/*
* If we created pieces of template, get rid of them now.
*/
if (tempDirObj) {
TclDecrRefCount(tempDirObj);
}
if (tempBaseObj) {
TclDecrRefCount(tempBaseObj);
}
if (tempExtObj) {
TclDecrRefCount(tempExtObj);
}
/*
* Deal with results.
*/
if (chan == NULL) {
if (nameVarObj) {
TclDecrRefCount(nameObj);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create temporary file: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
if (nameVarObj != NULL) {
if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_UnregisterChannel(interp, chan);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
/*
* Remove a connection Id from the hash table and
* close all portals the user forgot.
*/
int
PgDelConnectionId(DRIVER_DEL_PROTO)
{
Tcl_HashEntry *entry;
Tcl_HashSearch hsearch;
Pg_ConnectionId *connid;
Pg_TclNotifies *notifies;
int i;
connid = (Pg_ConnectionId *) cData;
for (i = 0; i < connid->res_max; i++)
{
if (connid->results[i])
PQclear(connid->results[i]);
}
ckfree((void *) connid->results);
/* Release associated notify info */
while ((notifies = connid->notify_list) != NULL)
{
connid->notify_list = notifies->next;
for (entry = Tcl_FirstHashEntry(¬ifies->notify_hash, &hsearch);
entry != NULL;
entry = Tcl_NextHashEntry(&hsearch))
ckfree((char *) Tcl_GetHashValue(entry));
Tcl_DeleteHashTable(¬ifies->notify_hash);
if (notifies->conn_loss_cmd)
ckfree((void *) notifies->conn_loss_cmd);
if (notifies->interp)
Tcl_DontCallWhenDeleted(notifies->interp, PgNotifyInterpDelete,
(ClientData) notifies);
ckfree((void *) notifies);
}
/*
* Turn off the Tcl event source for this connection, and delete any
* pending notify and connection-loss events.
*/
PgStopNotifyEventSource(connid, true);
/* Close the libpq connection too */
PQfinish(connid->conn);
connid->conn = NULL;
/*
* Kill the notifier channel, too. We must not do this until after
* we've closed the libpq connection, because Tcl will try to close
* the socket itself!
*
* XXX Unfortunately, while this works fine if we are closing due to
* explicit pg_disconnect, all Tcl versions through 8.4.1 dump core if
* we try to do it during interpreter shutdown. Not clear why. For
* now, we kill the channel during pg_disconnect, but during interp
* shutdown we just accept leakage of the (fairly small) amount of
* memory taken for the channel state representation. (Note we are not
* leaking a socket, since libpq closed that already.) We tell the
* difference between pg_disconnect and interpreter shutdown by
* testing for interp != NULL, which is an undocumented but apparently
* safe way to tell.
*/
#if TCL_MAJOR_VERSION >= 8
if (connid->notifier_channel != NULL && interp != NULL)
Tcl_UnregisterChannel(NULL, connid->notifier_channel);
#endif
/*
* We must use Tcl_EventuallyFree because we don't want the connid
* struct to vanish instantly if Pg_Notify_EventProc is active for it.
* (Otherwise, closing the connection from inside a pg_listen callback
* could lead to coredump.) Pg_Notify_EventProc can detect that the
* connection has been deleted from under it by checking connid->conn.
*/
Tcl_EventuallyFree((ClientData) connid, TCL_DYNAMIC);
return 0;
}
