SEH 2011-11-29: The chief frustration for me in writing A template virtual filesystem was discovering that the tclvfs extension implements the close command using a callback executed in the background (which means that errors in the custom close procedure code are simply invisible to the user, potentially leading to total data loss), and not being able to come up with a satisfying workaround. When I tried to communicate to the Tclvfs maintainers how important I thought this issue was, I was told it was no big deal, and anyway there was no other way to do it given Tcl's internal architecture. I thought that the issue kept Tcl virtual filesystems from being really ready for prime time.
Then in Portland I saw AK presenting his work on the new reflected channel feature. Turns out he ran into a similar issue when dealing with scripted channels. His solution was to do what I couldn't, rewrite Tcl's internals so background errors on close get bubbled up to the foreground and cause the execution stack to stop and unwind.
When I heard that, I instantly knew that scriptable channels were the solution I'd been lacking when trying to implement robust virtual filesystems.
My first step in incorporating a scripted channel solution into my template vfs was to write a simple template channel handler, that does nothing but pass data and commands to/from an underlying channel. Despite its simplicity, its value is that it attempts to utilize all channel handler subcommands and throw required errors as documented, and thus may be useful as a starting point for new scripted channel designs. Similar example channel handlers exist on the wiki, but as far as I can see they only implement portions of the documented API.
It of course also has value in that it can be stacked onto another channel which when closed via a background callback, gets its errors forced into the foreground.
The code below is minimally tested, but it seems to function as desired in a reworked template filesystem (forthcoming).
if 0 {
########################
stackchan.tcl --
Written by Stephen Huntley ([email protected])
License: Tcl license
Version 0.1
An attempt to create a simple reflected channel which meaningfully uses every
option in the API. Does nothing but pass data and commands to/from specified
underlying channel. Tries to throw the right errors as specified in the API.
Reports configuration options to user by querying underlying channel and passing
responses up. Also tries to set configuration options on underlying channel as
appropriate.
Usage: stackchan <existing channel> <mode> ?<close command>?
<mode> is a list whose values are "read", "write" or both.
<close command> is a list comprising a command and its arguments, which will be
used to create an interpreter alias.
########################
}
package require Tcl 8.5
namespace eval ::stackchan {}
# Channel instantiation command. Handles creation and configuration of new
# channel. Calls [chan create].
proc ::stackchan::stackchan {underchan mode {close_cmd {}}} {
if {$close_cmd ne {}} {
interp alias {} ::stackchan::close_$underchan {} {*}$close_cmd
}
set chan [chan create $mode \
[list [namespace origin _stackchan_handler] $underchan $mode]]
array set chanconfig [fconfigure $chan]
array set underchanconfig [fconfigure $underchan]
foreach conf [array names underchanconfig] {
if [info exists chanconfig($conf)] {
fconfigure $chan $conf $underchanconfig($conf)
}
}
return $chan
}
# Handler used internally by Tcl chan command. Should never be accessed
# directly by script.
proc ::stackchan::_stackchan_handler {underchan mode cmd chan args} {
switch -exact -- $cmd {
initialize {
return [concat initialize finalize watch $args seek cget cgetall configure blocking]
}
finalize {
if {[info commands ::stackchan::close_$underchan] eq {}} {
close $underchan
} else {
set close_ [interp alias {} ::stackchan::close_$underchan]
interp alias {} ::stackchan::close_$underchan {}
eval $close_ $underchan
}
return
}
seek {
chan seek $underchan {*}$args
return [chan tell $underchan]
}
read {
set enc [fconfigure $underchan -encoding]
fconfigure $underchan -encoding binary
set fail [catch {set bytes [read $underchan $args]} err]
fconfigure $underchan -encoding $enc
if $fail {
error $err
}
if {![eof $underchan] && ([string length $bytes] == 0)} {
error EAGAIN
}
return $bytes
}
write {
set data [lindex $args 0]
set dLength [string length $data]
set enc [fconfigure $underchan -encoding]
fconfigure $underchan -encoding binary
set fail [catch {puts -nonewline $underchan $data} err]
fconfigure $underchan -encoding $enc
if $fail {
error $err
}
return $dLength
}
cget {
return [chan configure $underchan $args]
}
cgetall {
array set underchanconfig [chan configure $underchan]
foreach conf {-blocking -buffering -buffersize -encoding -eofchar -translation} {
array unset underchanconfig $conf
}
return [array get underchanconfig]
}
configure {
return [chan configure $underchan {*}$args]
}
watch {
after 10 timer $underchan $mode
}
blocking {
fconfigure $underchan -blocking $args
}
}
}
proc ::stackchan::timer {chan mode} {
foreach event $mode {
chan postevent $chan $event
}
after 10 [namespace code [info level 0]]
}
package provide stackchan 0.1