Index: doc/CrtChannel.3 ================================================================== --- doc/CrtChannel.3 +++ doc/CrtChannel.3 @@ -33,10 +33,15 @@ \fBTcl_GetChannelThread\fR(\fIchannel\fR) .sp int \fBTcl_GetChannelMode\fR(\fIchannel\fR) .sp +.VS 8.7 +int +\fBTcl_RemoveChannelMode\fR(\fIinterp, channel, mode\fR) +.VE 8.7 +.sp int \fBTcl_GetChannelBufferSize\fR(\fIchannel\fR) .sp \fBTcl_SetChannelBufferSize\fR(\fIchannel, size\fR) .sp @@ -240,10 +245,20 @@ events to the correct event queue even for a multi-threaded core. .PP \fBTcl_GetChannelMode\fR returns an OR-ed combination of \fBTCL_READABLE\fR and \fBTCL_WRITABLE\fR, indicating whether the channel is open for input and output. +.PP +.VS 8.7 +.PP +\fBTcl_RemoveChannelMode\fR removes an access privilege from the +channel, either \fBTCL_READABLE\fR or \fBTCL_WRITABLE\fR, and returns +a regular Tcl result code, \fBTCL_OK\fR, or \fBTCL_ERROR\fR. The +function throws an error if either an invalid mode is specified or the +result of the removal would be an inaccessible channel. In that case +an error message is left in the interp argument, if not NULL. +.VE 8.7 .PP \fBTcl_GetChannelBufferSize\fR returns the size, in bytes, of buffers allocated to store input or output in \fIchannel\fR. If the value was not set by a previous call to \fBTcl_SetChannelBufferSize\fR, described below, then the default value of 4096 is returned. Index: generic/tcl.decls ================================================================== --- generic/tcl.decls +++ generic/tcl.decls @@ -2521,10 +2521,15 @@ } declare 679 { int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]) } + +# TIP #220. +declare 680 { + int Tcl_RemoveChannelMode(Tcl_Interp *interp, Tcl_Channel chan, int mode) +} # ----- BASELINE -- FOR -- 8.7.0 ----- # ############################################################################## Index: generic/tclDecls.h ================================================================== --- generic/tclDecls.h +++ generic/tclDecls.h @@ -1994,10 +1994,13 @@ Tcl_CmdDeleteProc *deleteProc); /* 679 */ EXTERN int Tcl_NRCallObjProc2(Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); +/* 680 */ +EXTERN int Tcl_RemoveChannelMode(Tcl_Interp *interp, + Tcl_Channel chan, int mode); typedef struct { const struct TclPlatStubs *tclPlatStubs; const struct TclIntStubs *tclIntStubs; const struct TclIntPlatStubs *tclIntPlatStubs; @@ -2709,10 +2712,11 @@ void (*reserved675)(void); Tcl_Command (*tcl_CreateObjCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 676 */ Tcl_Trace (*tcl_CreateObjTrace2) (Tcl_Interp *interp, int level, int flags, Tcl_CmdObjTraceProc2 *objProc2, void *clientData, Tcl_CmdObjTraceDeleteProc *delProc); /* 677 */ Tcl_Command (*tcl_NRCreateCommand2) (Tcl_Interp *interp, const char *cmdName, Tcl_ObjCmdProc2 *proc, Tcl_ObjCmdProc2 *nreProc2, void *clientData, Tcl_CmdDeleteProc *deleteProc); /* 678 */ int (*tcl_NRCallObjProc2) (Tcl_Interp *interp, Tcl_ObjCmdProc2 *objProc2, void *clientData, size_t objc, Tcl_Obj *const objv[]); /* 679 */ + int (*tcl_RemoveChannelMode) (Tcl_Interp *interp, Tcl_Channel chan, int mode); /* 680 */ } TclStubs; extern const TclStubs *tclStubsPtr; #ifdef __cplusplus @@ -4097,10 +4101,12 @@ (tclStubsPtr->tcl_CreateObjTrace2) /* 677 */ #define Tcl_NRCreateCommand2 \ (tclStubsPtr->tcl_NRCreateCommand2) /* 678 */ #define Tcl_NRCallObjProc2 \ (tclStubsPtr->tcl_NRCallObjProc2) /* 679 */ +#define Tcl_RemoveChannelMode \ + (tclStubsPtr->tcl_RemoveChannelMode) /* 680 */ #endif /* defined(USE_TCL_STUBS) */ /* !END!: Do not edit above this line. */ Index: generic/tclIO.c ================================================================== --- generic/tclIO.c +++ generic/tclIO.c @@ -1679,10 +1679,11 @@ tmp = (char *)ckalloc(7); tmp[0] = '\0'; } statePtr->channelName = tmp; statePtr->flags = mask; + statePtr->maxPerms = mask; /* Save max privileges for close callback */ /* * Set the channel to system default encoding. * * Note the strange bit of protection taking place here. If the system @@ -2164,12 +2165,15 @@ * chanPtr->downChanPtr = NULL; */ /* * Close and free the channel driver state. + * TIP #220: This is done with maximum privileges (as created). */ + statePtr->flags &= ~(TCL_READABLE|TCL_WRITABLE); + statePtr->flags |= statePtr->maxPerms; result = ChanClose(chanPtr, interp); ChannelFree(chanPtr); UpdateInterest(statePtr->topChanPtr); @@ -2443,10 +2447,58 @@ if (handlePtr) { *handlePtr = handle; } return result; } + +/* + *---------------------------------------------------------------------- + * + * Tcl_RemoveChannelMode -- + * + * Remove either read or write privileges from the channel. + * + * Results: + * A standard Tcl result code. + * + * Side effects: + * May change the access mode of the channel. + * May leave an error message in the interp. + * + *---------------------------------------------------------------------- + */ + +int +Tcl_RemoveChannelMode( + Tcl_Interp* interp, /* The interp for an error message. Allowed to be NULL. */ + Tcl_Channel chan, /* The channel which is modified. */ + int mode) /* The access mode to drop from the channel */ +{ + const char* emsg; + ChannelState *statePtr = ((Channel *) chan)->state; + /* State of actual channel. */ + + if ((mode != TCL_READABLE) && (mode != TCL_WRITABLE)) { + emsg = "Illegal mode value."; + goto error; + } + if (0 == (statePtr->flags & (TCL_READABLE | TCL_WRITABLE) & ~mode)) { + emsg = "Bad mode, would make channel inacessible"; + goto error; + } + + statePtr->flags &= ~mode; + return TCL_OK; + + error: + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "Tcl_RemoveChannelMode error: %s. Channel: \"%s\"", + emsg, Tcl_GetChannelName((Tcl_Channel) chan))); + } + return TCL_ERROR; +} /* *--------------------------------------------------------------------------- * * AllocChannelBuffer -- Index: generic/tclIO.h ================================================================== --- generic/tclIO.h +++ generic/tclIO.h @@ -214,10 +214,12 @@ * because it happened in the background. The * value is the chanMg, if any. #219's * companion to 'unreportedError'. */ size_t epoch; /* Used to test validity of stored channelname * lookup results. */ + int maxPerms; /* TIP #220: Max access privileges + * the channel was created with. */ } ChannelState; /* * Values for the flags field in Channel. Any ORed combination of the * following flags can be stored in the field. These flags record various Index: generic/tclStubInit.c ================================================================== --- generic/tclStubInit.c +++ generic/tclStubInit.c @@ -2040,8 +2040,9 @@ 0, /* 675 */ Tcl_CreateObjCommand2, /* 676 */ Tcl_CreateObjTrace2, /* 677 */ Tcl_NRCreateCommand2, /* 678 */ Tcl_NRCallObjProc2, /* 679 */ + Tcl_RemoveChannelMode, /* 680 */ }; /* !END!: Do not edit above this line. */ Index: generic/tclTest.c ================================================================== --- generic/tclTest.c +++ generic/tclTest.c @@ -6038,10 +6038,49 @@ } else { Tcl_AppendElement(interp, ""); } return TCL_OK; } + + if ((cmdName[0] == 'm') && (strncmp(cmdName, "maxmode", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", NULL); + return TCL_ERROR; + } + + if (statePtr->maxPerms & TCL_READABLE) { + Tcl_AppendElement(interp, "read"); + } else { + Tcl_AppendElement(interp, ""); + } + if (statePtr->maxPerms & TCL_WRITABLE) { + Tcl_AppendElement(interp, "write"); + } else { + Tcl_AppendElement(interp, ""); + } + return TCL_OK; + } + + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-rd", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + return Tcl_RemoveChannelMode(interp, chan, TCL_READABLE); + } + + if ((cmdName[0] == 'm') && (strncmp(cmdName, "mremove-wr", len) == 0)) { + if (argc != 3) { + Tcl_AppendResult(interp, "channel name required", + (char *) NULL); + return TCL_ERROR; + } + + return Tcl_RemoveChannelMode(interp, chan, TCL_WRITABLE); + } if ((cmdName[0] == 'm') && (strncmp(cmdName, "mthread", len) == 0)) { if (argc != 3) { Tcl_AppendResult(interp, "channel name required", NULL); return TCL_ERROR; Index: tests/io.test ================================================================== --- tests/io.test +++ tests/io.test @@ -8952,10 +8952,128 @@ removeFile io-74.1 } -returnCodes error -match glob -result {can not find channel named "*"} # ### ### ### ######### ######### ######### + + +test io-75.0 {channel modes} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r] +} -constraints testchannel -body { + testchannel mode $f +} -cleanup { + close $f + removeFile dummy +} -result {read {}} + +test io-75.1 {channel modes} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile w] +} -constraints testchannel -body { + testchannel mode $f +} -cleanup { + close $f + removeFile dummy +} -result {{} write} + +test io-75.2 {channel modes} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mode $f +} -cleanup { + close $f + removeFile dummy +} -result {read write} + +test io-75.3 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r] +} -constraints testchannel -body { + testchannel mremove-wr $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{read {}} {read {}}} + +test io-75.4 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r] +} -constraints testchannel -body { + testchannel mremove-rd $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + +test io-75.5 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile w] +} -constraints testchannel -body { + testchannel mremove-rd $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{{} write} {{} write}} + +test io-75.6 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile w] +} -constraints testchannel -body { + testchannel mremove-wr $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + +test io-75.7 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-rd $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{{} write} {read write}} + +test io-75.8 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-wr $f + list [testchannel mode $f] [testchannel maxmode $f] +} -cleanup { + close $f + removeFile dummy +} -result {{read {}} {read write}} + +test io-75.9 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-wr $f + testchannel mremove-rd $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + +test io-75.10 {channel mode dropping} -setup { + set datafile [makeFile {some characters} dummy] + set f [open $datafile r+] +} -constraints testchannel -body { + testchannel mremove-rd $f + testchannel mremove-wr $f +} -returnCodes error -cleanup { + close $f + removeFile dummy +} -match glob -result {Tcl_RemoveChannelMode error: Bad mode, would make channel inacessible. Channel: "*"} + # cleanup foreach file [list fooBar longfile script script2 output test1 pipe my_script \ test2 test3 cat stdout kyrillic.txt utf8-fcopy.txt utf8-rp.txt] { removeFile $file }