# small 9p implementation in tcl by Axel.Belinfante@cs.utwente.nl
# this is based on the python 9P implementation by Tim Newsham.
# http://lava.net/~newsham/plan9/
package require Tcl 8.5 ;# we need 'chan create'
package require Tcl 8.4 ;# we need 64bit int support
package require vfs 1.0 ;# this is what we build upon
# TODO:
# check we have all handlers (createdirectory, deletefile, ...?)
# do error reporting right
# (we introduced 'filesystem posixerror';
# still, we should be able to give better error messages,
# e.g. when a walk fails we _know_ which is the first non-existent part)
# check wich 9p messages do implicit clunk (only remove??)
# report failure of utime actime setting?
# better packaging?
# ------------------------
set debug 0 ;# set to 1 to enable all debugging/verboseness
proc debug {s} {
if {$::debug} {
puts stderr $s
}
}
set ::vfs::debug $::debug
vfs::filesystem internalerror report
proc report {} {
if {$::debug} {
puts stderr "9pvfs internal error: $::errorInfo"
}
}
# ------------------------
namespace eval 9p {
variable PORT 564
variable VERSION "9P2000"
variable NOTAG 0xffff
variable NOFID 0xffffffff
}
proc 9p::_lfilter {l s} {
set f [lsearch -all $l $s]
while {[llength $f] > 0} {
set i [lindex $f end]
set f [lrange $f 0 end-1]
set l [lreplace $l $i $i]
}
return $l
}
proc 9p::_dump {buf} {
binary scan $buf c* X
set r {}
foreach h $X {
lappend r [format %02x [expr $h & 0xff]]
}
return [join $r " "]
}
proc 9p::verbose {self {val {}}} {
upvar #0 G_[set self](verbose) verbose
set v $verbose
if {$val != {}} {
set verbose $val
}
return $v
}
namespace eval 9p::mode {
variable DMDIR 020000000000
variable QDIR 0x80
variable OREAD 0
variable OWRITE 1
variable ORDWR 2
variable OEXEC 3
variable OTRUNC 0x10
variable ORCLOSE 0x40
}
namespace eval 9p::proto {
variable cmdName
set firstNum 100
set enumCmd [list \
version \
auth \
attach \
error \
flush \
walk \
open \
create \
read \
write \
clunk \
remove \
stat \
wstat \
]
proc enumCmd {num alist} {
variable cmdName
foreach name $alist {
set cmdName($num) T$name
set cmdName([expr $num+1]) R$name
variable T$name
set T$name $num
variable R$name
set R$name [expr $num+1]
incr num 2
}
variable Tmax
set Tmax $num
}
enumCmd $firstNum $enumCmd
}
# Class for marshalling data.
# This class provies helpers for marshalling data. Integers are encoded
# as little endian. All encoders and decoders rely on _encX and _decX.
# These methods append bytes to self.bytes for output and remove bytes
# from the beginning of self.bytes for input. To use another scheme
# only these two methods need be overriden.
namespace eval 9p::marshal {
variable MAXSIZE [expr 1024 * 1024] ;# XXX
set msgFmts {
Tversion "4S"
Rversion "4S"
Tauth "4SS"
Rauth "Q"
Terror ""
Rerror "S"
Tflush "2"
Rflush ""
Tattach "44SS"
Rattach "Q"
Twalk "[Twalk]"
Rwalk "[Rwalk]"
Topen "41"
Ropen "Q4"
Tcreate "4S41"
Rcreate "Q4"
Tread "484"
Rread "D"
Twrite "48D"
Rwrite "4"
Tclunk "4"
Rclunk ""
Tremove "4"
Rremove ""
Tstat "4"
Rstat "[Stat]"
Twstat "4[Stat]"
Rwstat ""
}
proc splitFmt {fmt} {
set idx 0
set r {}
while {$idx < [string length $fmt]} {
if {[string index $fmt $idx] == {[}} {
set fmt [string range $fmt [expr $idx + 1] end]
set idx2 [string first {]} $fmt ]
if {$idx2 < 0} {
error "no close square bracket"
}
set name [string range $fmt 0 [expr $idx2 - 1]]
set idx $idx2
} else {
set name [string range $fmt $idx $idx]
}
incr idx
lappend r $name
}
return $r
}
proc prep {fmttab} {
variable msgEncodes
variable msgDecodes
foreach {k v} $fmttab {
variable ::9p::proto::$k
set kk [set ::9p::proto::$k]
set fmts [splitFmt $v]
set msgEncodes($kk) {}
set msgDecodes($kk) {}
foreach fmt $fmts {
lappend msgEncodes($kk) enc[set fmt]
lappend msgDecodes($kk) dec[set fmt]
}
}
}
variable fmtName
foreach {n v} $msgFmts {
variable ::9p::proto::$n
set fmtName([set ::9p::proto::$n]) $v
}
prep $msgFmts
}
proc 9p::marshal::applyFuncs {self funcs {vals None}} {
set x {}
if {[string compare $vals None] != 0} {
foreach f $funcs v $vals {
lappend x [$f $self $v]
}
} else {
foreach f $funcs {
lappend x [$f $self]
}
}
if {[llength $x] == 1} {
set x [lindex $x 0]
}
return $x
}
proc 9p::marshal::setBuf {self {str ""}} {
upvar #0 C_[set self](buf) buf
set buf $str
}
proc 9p::marshal::getBuf {self} {
upvar #0 C_[set self](buf) buf
return $buf
}
proc 9p::marshal::delBuf {self} {
upvar #0 C_[set self](buf) buf
catch {unset buf}
}
proc 9p::marshal::lenBuf {self} {
upvar #0 C_[set self](buf) buf
return [string length $buf]
}
proc 9p::marshal::appendBuf {self x} {
upvar #0 C_[set self](buf) buf
append buf $x
}
proc 9p::marshal::firstofBuf {self l} {
upvar #0 C_[set self](buf) buf
set ll [string length $buf]
if {$ll < $l} {
error "firstofBuf: short buf (wanted $l, avail $ll)"
}
set x [string range $buf 0 [expr $l - 1]]
set buf [string range $buf $l end]
return $x
}
proc 9p::marshal::rangeBuf {self beg end} {
upvar #0 C_[set self](buf) buf
set x [string range $buf $beg $end]
return $x
}
proc 9p::marshal::replaceBuf {self beg end data} {
upvar #0 C_[set self](buf) buf
set buf [string replace $buf $beg $end $data]
}
proc 9p::marshal::checkSize {v mask} {
if {$v != [expr $v & $mask]} {
error "Invalid value $v"
}
}
proc 9p::marshal::checkLen {x l} {
set ll [string length $x]
if {$ll != $l} {
error "Wrong length $ll, expected $l: $x"
}
}
proc 9p::marshal::encX {self x} {
appendBuf $self $x
}
proc 9p::marshal::decX {self l} {
return [firstofBuf $self $l]
}
proc 9p::marshal::enc1 {self x} {
checkSize $x [expr wide(0xff)]
return [encX $self [binary format c $x]]
}
proc 9p::marshal::dec1 {self} {
binary scan [decX $self 1] c x
return [expr $x & 0xff]
}
proc 9p::marshal::enc2 {self x} {
checkSize $x [expr wide(0xffff)]
return [encX $self [binary format s $x]]
}
proc 9p::marshal::dec2 {self} {
binary scan [decX $self 2] s x
return [expr $x & 0xffff]
}
proc 9p::marshal::enc4 {self x} {
checkSize $x [expr wide(0xffffffff)]
return [encX $self [binary format i $x]]
}
proc 9p::marshal::dec4 {self} {
binary scan [decX $self 4] i x
return [expr $x & 0xffffffff]
}
proc 9p::marshal::enc8 {self x} {
checkSize $x [expr wide(0xffffffffffffffff)]
return [encX $self [binary format w $x]]
}
proc 9p::marshal::dec8 {self} {
binary scan [decX $self 8] w x
return [expr $x & 0xffffffffffffffff]
}
proc 9p::marshal::encS {self x} {
enc2 $self [string length $x]
encX $self $x
}
proc 9p::marshal::decS {self} {
set l [dec2 $self]
return [decX $self $l]
}
proc 9p::marshal::encD {self x} {
enc4 $self [string length $x]
encX $self $x
}
proc 9p::marshal::decD {self} {
set l [dec4 $self]
return [decX $self $l]
}
proc 9p::marshal::encQ {self q} {
set type [lindex $q 0]
set vers [lindex $q 1]
set path [lindex $q 2]
enc1 $self $type
enc4 $self $vers
enc8 $self $path
}
proc 9p::marshal::decQ {self} {
return [list [dec1 $self] [dec4 $self] [dec8 $self]]
}
proc 9p::marshal::encTwalk {self x} {
set fid [lindex $x 0]
set newfid [lindex $x 1]
set names [lindex $x 2]
enc4 $self $fid
enc4 $self $newfid
enc2 $self [llength $names]
foreach n $names {
encS $self $n
}
}
proc 9p::marshal::decTwalk {self} {
set fid [dec4 $self]
set newfid [dec4 $self]
set l [dec2 $self]
set names {}
set i 0
while {$i < $l} {
lappend names [decS $self]
incr i
}
return [list $fid $newfid $names]
}
proc 9p::marshal::encRwalk {self qids} {
enc2 $self [llength $qids]
foreach q $qids {
encQ $self $q
}
}
proc 9p::marshal::decRwalk {self} {
debug "_decRwalk $self"
set l [dec2 $self]
set r {}
set i 0
debug "_decRwalk $self l=$l"
while {$i < $l} {
lappend r [decQ $self]
incr i
}
debug "_decRwalk $self l=$l"
return $r
}
proc 9p::marshal::encDir {self x} {
debug "encDir $self ($x)"
set nself [set self]dir
setBuf $nself ""
enc2 $nself [lindex $x 0] ;# type
enc4 $nself [lindex $x 1] ;# dev
encQ $nself [lindex $x 2] ;# qid
enc4 $nself [lindex $x 3] ;#mode
enc4 $nself [lindex $x 4] ;# atime
enc4 $nself [lindex $x 5] ;# mtime
enc8 $nself [lindex $x 6] ;# ln
encS $nself [lindex $x 7] ;# name
encS $nself [lindex $x 8] ;# uid
encS $nself [lindex $x 9] ;# gid
encS $nself [lindex $x 10] ;# muid
encS $self [getBuf $nself]
delBuf $nself
}
proc 9p::marshal::encStat {self l} {
debug "_encStat $self ($l)"
set nself [set self]stat
setBuf $nself ""
foreach x $l {
encDir $nself $x
}
encS $self [getBuf $nself]
delBuf $nself
}
proc 9p::marshal::decodeDir {self} {
lappend r [dec2 $self] ;# type
lappend r [dec4 $self] ;# dev
lappend r [decQ $self] ;# qid
lappend r [dec4 $self] ;#mode
lappend r [dec4 $self] ;# atime
lappend r [dec4 $self] ;# mtime
lappend r [dec8 $self] ;# ln
lappend r [decS $self] ;# name
lappend r [decS $self] ;# uid
lappend r [decS $self] ;# gid
lappend r [decS $self] ;# muid
return $r
}
proc 9p::marshal::decodeDirs {self s} {
set nself [set self]dirs
setBuf $nself $s
set r {}
while {[lenBuf $nself] > 0} {
set dstr [decS $nself]
set nnself [set nself]dir
setBuf $nnself $dstr
lappend r [decodeDir $nnself]
delBuf $nnself
}
delBuf $nself
return $r
}
proc 9p::marshal::decStat {self} {
set s [decS $self]
set r [decodeDirs $self $s]
return $r
}
proc 9p::marshal::checkType {t} {
variable fmtName
if {![info exists fmtName($t)]} {
error "invalid message type $t"
}
}
proc 9p::marshal::checkResid {self} {
set n [lenBuf $self]
if {$n > 0} {
binary scan [getBuf $self $n] h* X
set Xs [string join $X ""]
error "Extra information in message: $Xs"
}
}
proc 9p::marshal::sread {f l} {
set x [read $f $l]
#puts stderr "9p::marshal::sread read [::9p::_dump $x] of $l"
while {[string length $x] < $l} {
set b [read $f [expr $l - [string length $x]]]
#puts stderr "9p::marshal::sread read [::9p::_dump $b] of $l"
if {[string length $b] == 0} {
error "Client EOF"
}
append x $b
}
# puts stderr "9p::marshal::sread read done"
return $x
}
proc 9p::marshal::swrite {f buf} {
if {[catch {
puts -nonewline $f $buf
flush $f
} msg]} {
error "short write: $msg"
}
}
proc 9p::marshal::send {self type tag arglist} {
variable msgEncodes
upvar #0 G_[set self](verbose) verbose
upvar #0 C_[set self](srvfd) srvfd
setBuf $self ""
checkType $type
enc1 $self $type
enc2 $self $tag
applyFuncs $self $msgEncodes($type) $arglist
set l [lenBuf $self]
set ss [getBuf $self]
setBuf $self ""
enc4 $self [expr $l + 4]
encX $self $ss
if {$verbose} {
puts "send $type $tag $arglist"
}
swrite $srvfd [getBuf $self]
}
proc 9p::marshal::recv {self} {
variable MAXSIZE
upvar #0 G_[set self](verbose) verbose
upvar #0 C_[set self](srvfd) srvfd
variable msgDecodes
setBuf $self [sread $srvfd 4]
set size [dec4 $self]
if {$size > $MAXSIZE || $size < 4} {
error "Bad message size: $size"
}
setBuf $self [sread $srvfd [expr $size - 4]]
set type [dec1 $self]
set tag [dec2 $self]
checkType $type
set rest [applyFuncs $self $msgDecodes($type)]
checkResid $self
if {$verbose} {
puts "recv $type $tag" ;# $rest
}
return [list $type $tag $rest]
}
proc 9p::proto::rpc {self type args} {
variable ::9p::NOTAG
variable cmdName
variable Tversion
variable Rerror
upvar #0 G_[set self](verbose) verbose
set tag 1
if {$type == $Tversion} {
set tag [expr int($NOTAG)]
}
if {$verbose} {
puts "$cmdName($type) $tag $args"
}
::9p::marshal::send $self $type $tag $args
set resp [::9p::marshal::recv $self]
set rtype [lindex $resp 0]
set rtag [lindex $resp 1]
set vals [lindex $resp 2]
if {$verbose} {
puts "$cmdName($rtype) $rtag" ;# $vals
}
if {$rtag != $tag} {
error "invalid tag received"
}
if {$rtype == $Rerror} {
error "RpcError $vals"
}
if {$rtype != [expr $type + 1]} {
error "incorrect reply from server: [list $rtype $rtag $vals]"
}
debug "rpc $self $type $args -> $vals"
return $vals
}
proc 9p::proto::version {self msize version} {
variable Tversion
return [rpc $self $Tversion $msize $version]
}
proc 9p::proto::auth {self fid uname aname} {
variable Tauth
return [rpc $self $Tauth $fid $uname $aname]
}
proc 9p::proto::attach {self fid afid uname aname} {
variable Tattach
return [rpc $self $Tattach $fid $afid $uname $aname]
}
proc 9p::proto::walk {self fid newfid wnames} {
variable Twalk
return [rpc $self $Twalk [list $fid $newfid $wnames]]
}
proc 9p::proto::open {self fid mode} {
variable Topen
return [rpc $self $Topen $fid $mode]
}
proc 9p::proto::create {self fid name perm mode} {
variable Tcreate
return [rpc $self $Tcreate $fid $name $perm $mode]
}
proc 9p::proto::read {self fid off count} {
variable Tread
return [rpc $self $Tread $fid $off $count]
}
proc 9p::proto::write {self fid off data} {
variable Twrite
return [rpc $self $Twrite $fid $off $data]
}
proc 9p::proto::clunk {self fid} {
variable Tclunk
return [rpc $self $Tclunk $fid]
}
proc 9p::proto::remove {self fid} {
variable Tremove
return [rpc $self $Tremove $fid]
}
proc 9p::proto::stat {self fid} {
variable Tstat
return [rpc $self $Tstat $fid]
}
proc 9p::proto::wstat {self fid stats} {
variable Twstat
return [rpc $self $Twstat $fid $stats]
}
proc 9p::chan {handle fid cmd chan args} {
debug "9p::chan $handle $fid $cmd $chan $args"
switch -exact -- $cmd {
initialize {
return [list initialize finalize watch read write seek]
}
finalize {
::9p::clunk $handle $fid
}
watch {
}
read {
set count [lindex $args 0]
return [::9p::read $handle $fid $count]
}
write {
set data [lindex $args 0]
return [::9p::write $handle $fid $data]
}
seek {
set off [lindex $args 0]
set mode [lindex $args 1]
set pos [::9p::seek $handle $fid $off $mode]
}
}
}
namespace eval 9p {
variable selfnr 0
}
proc 9p::mount {fd user {alist {}}} {
variable VERSION
variable NOFID
variable selfnr
set self "v9p[set selfnr]"
incr selfnr
upvar #0 C_[set self](CWD) CWD
upvar #0 C_[set self](ROOT) ROOT
upvar #0 C_[set self](AFID) AFID
upvar #0 C_[set self](recycled) recycled
upvar #0 C_[set self](nextF) nextF
upvar #0 C_[set self](srvfd) srvfd
upvar #0 G_[set self](verbose) verbose
set authsrv [lindex $alist 0]
set passwd [lindex $alist 1]
set AFID 10
set ROOT 11
set nextF 12
set recycled {}
set verbose 0
set srvfd $fd
set maxbuf_vers [proto::version $self [expr 16*1024] $VERSION]
debug "maxbuf_vers $maxbuf_vers"
set maxbuf [lindex $maxbuf_vers 0]
set vers [lindex $maxbuf_vers 1]
if {[string compare $vers $VERSION] != 0} {
error "version mismatch: $vers"
}
set afid $AFID
if {[catch {proto::auth $self $afid $user ""} err]} {
puts stderr "main proto::auth : $err"
set afid $NOFID
} else {
set needauth 1
}
if {$afid != $NOFID} {
if {$passwd == {} && $authsrv == {}} {
error "oops, missing authsrv and password"
} elseif {$passwd == {}} {
error "oops, missing password"
} elseif {$authsrv == {}} {
error "oops, missing authsrv"
} else {
puts "authenticating $user at $authsrv" ;# XXX only if verbose?
}
::p9sk1::clientAuth $self $afid $user [::p9sk1::makeKey $passwd] $authsrv
}
proto::attach $self $ROOT $afid $user ""
if {$afid != $NOFID} {
proto::clunk $self $afid
}
return $self
}
proc 9p::unmount {self} {
upvar #0 C_[set self](srvfd) srvfd
# catch {close $srvfd}
}
proc 9p::qidisdir {qid} {
set type [lindex $qid 0]
set isdir [expr $type & $::9p::mode::QDIR]
return $isdir
}
proc 9p::isdir {self F} {
upvar #0 C_[set self]_[set F](qid) qid
if {![info exists qid]} {
error "no mapping fid->qid"
}
return [9p::qidisdir $qid]
}
proc 9p::newfid {self} {
upvar #0 C_[set self](recycled) recycled
upvar #0 C_[set self](nextF) nextF
if {[llength $recycled] > 0} {
set F [lindex $recycled 0]
set recycled [lrange $recycled 1 end]
} else {
set F $nextF
incr nextF
}
return $F
}
proc 9p::walk {self {pstr {}}} {
upvar #0 C_[set self](ROOT) ROOT
set root $ROOT
set F [newfid $self]
if {$pstr == {}} {
set path {}
} else {
set path [split $pstr /]
if {[string compare [lindex $path 0] ""] == 0} {
set root $ROOT
set path [lrange $path 1 end]
}
set path [_lfilter $path ""]
}
if {[catch {proto::walk $self $root $F $path} w]} {
# puts "error: $w"
return
}
upvar #0 C_[set self]_[set F](qid) qid
set qid [lindex $w end]
if {[llength $w] < [llength $path]} {
# puts "$pstr: not found"
return
}
debug "walk $self ($pstr): $w"
return $F
}
proc 9p::afidopen {self F} {
upvar #0 C_[set self]_[set F](pos) pos
set pos 0
return
}
# Modes taken from ::9p::mode
proc 9p::open {self F mode} {
upvar #0 C_[set self]_[set F](pos) pos
set pos 0
set r [proto::open $self $F $mode]
debug "open $self $F $mode -> $r"
return $r
}
proc 9p::create {self F name perm mode} {
# self dirfid name perm mode
upvar #0 C_[set self]_[set F](pos) pos
set pos 0
if {[catch {proto::create $self $F $name $perm $mode} r]} {
# puts "error: $r"
return
}
debug "create $self $F $name $perm $mode -> $r"
upvar #0 C_[set self]_[set F](qid) qid
set qid [lindex $r 0]
return $r
}
proc 9p::read {self F l} {
upvar #0 C_[set self]_[set F](pos) pos
debug "read $self $l"
set buf [proto::read $self $F $pos $l]
incr pos [string length $buf]
debug "read $self $l -> done"
return $buf
}
proc 9p::write {self F data} {
upvar #0 C_[set self]_[set F](pos) pos
debug "write $self"
set l [proto::write $self $F $pos $data]
incr pos $l
debug "write $self -> done"
return $l
}
proc 9p::stat {self F} {
return [lindex [proto::stat $self $F] 0]
}
proc 9p::wstat {self F stats} {
proto::wstat $self $F [list $stats]
}
proc 9p::clunk {self F} {
upvar #0 C_[set self](recycled) recycled
upvar #0 C_[set self]_[set F](qid) qid
proto::clunk $self $F
lappend recycled $F
unset qid
}
# remove is like clunk with removal of file as side-effect
proc 9p::remove {self F} {
upvar #0 C_[set self](recycled) recycled
upvar #0 C_[set self]_[set F](qid) qid
proto::remove $self $F
lappend recycled $F
unset qid
}
proc 9p::seek {self F n mode} {
upvar #0 C_[set self]_[set F](pos) pos
upvar #0 C_[set self]_[set F](stat) stat
if {[9p::isdir $self $F]} {
error "cannot seek in directory"
}
set npos $pos
switch -- $mode {
start {
set npos $n
}
current {
incr npos $n
}
end {
set stat [lindex [proto::stat $self $F] 0]
set sz [lindex $stat 6]
set npos $sz
incr npos $n
}
default {
error "9p::seek: unknown mode: $mode"
}
}
if {$npos < 0} {
# error "seek pos becomes negative: $npos"
error "invalid argument"
}
set pos $npos
return $pos
}
proc 9p::mode::rwx {mode s} {
set bits [list "---" "--x" "-w-" "-wx" "r--" "r-x" "rw-" "rwx"]
return [lindex $bits [expr ($mode >> $s) & 7]]
}
proc 9p::mode::perm {mode} {
variable DMDIR
set d "-"
if {[expr $mode & $DMDIR]} {
set d "d"
}
return "[set d][rwx $mode 6][rwx $mode 3][rwx $mode 0]"
}
proc 9p::mode::filetype {mode} {
variable DMDIR
if {[expr $mode & $DMDIR]} {
return "directory"
} else {
return "file"
}
}
proc 9p::decodeDirs {self s} {
return [9p::marshal::decodeDirs $self $s]
}
# ------------------------
namespace eval vfs::9p {
variable natmode
variable chanmode
set natmode() $::9p::mode::OREAD
set natmode(r) $::9p::mode::OREAD
set natmode(r+) $::9p::mode::ORDWR
set natmode(w) [expr $::9p::mode::OWRITE | $::9p::mode::OTRUNC]
set natmode(w+) [expr $::9p::mode::ORDWR | $::9p::mode::OTRUNC]
set natmode(a) $::9p::mode::OWRITE
set natmode(a+) $::9p::mode::ORDWR
set chanmode() read
set chanmode(r) read
set chanmode(r+) [list read write]
set chanmode(w) write
set chanmode(w+) [list read write]
set chanmode(a) write
set chanmode(a+) [list read write]
}
proc vfs::9p::Mount {fd user local args} {
vfs::log "vfs::9p::Mount: attempt to mount $fd $user at $local"
set handle [::9p::mount $fd $user $args]
vfs::log "9p $fd $user mounted at $local : $handle"
9p::verbose $handle $::debug
vfs::filesystem mount $local [list vfs::9p::handler $handle]
vfs::RegisterMount $local [list ::vfs::9p::Unmount $handle]
return $handle
}
proc vfs::9p::Unmount {handle local} {
vfs::filesystem unmount $local
::9p::unmount $handle
}
proc vfs::9p::handler {handle cmd root relative actualpath args} {
vfs::log "vfs::9p::handler $handle $cmd $root $relative $actualpath [list $args]"
if {$cmd == "matchindirectory"} {
eval [list vfs::9p::$cmd $handle $relative $actualpath] $args
} else {
eval [list vfs::9p::$cmd $handle $relative] $args
}
}
proc vfs::9p::stat {handle name} {
vfs::log "vfs::9p::stat $handle $name"
set fid [::9p::walk $handle $name]
if {$fid == {}} {
vfs::log "vfs::9p::stat $handle $name : ENOENT"
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
set stat [::9p::stat $handle $fid]
::9p::clunk $handle $fid
set t [lindex $stat 0]
set d [lindex $stat 1]
set q [lindex $stat 2]
set m [lindex $stat 3]
set at [lindex $stat 4]
set mt [lindex $stat 5]
set l [lindex $stat 6]
set name [lindex $stat 7]
set u [lindex $stat 8]
set g [lindex $stat 9]
set mod [lindex $stat 10]
lappend res type [9p::mode::filetype $m]
lappend res ino [lindex $q 2]
lappend res dev -1
lappend res uid -1
lappend res gid -1
lappend res nlink 1
lappend res depth 0
lappend res atime $at
lappend res ctime $mt
lappend res mtime $mt
lappend res mode [expr $m & 0x01ff]
lappend res size [expr $l & 0xffffffff] ;# XXX
vfs::log "vfs::9p::stat $handle $name : ($stat) ($res) "
return $res
}
proc vfs::9p::access {handle name mode} {
vfs::log "vfs::9p::access $handle $name $mode"
if {$name == ""} {
vfs::log "vfs::9p::access $handle $name $mode -> 1"
return 1
}
set fid [::9p::walk $handle $name]
if {$fid == {}} {
vfs::log "vfs::9p::access $handle $name $mode -> ENOENT"
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
::9p::clunk $handle $fid
vfs::log "vfs::9p::access $handle $name $mode -> 1"
return 1
}
proc vfs::9p::createdirectory {handle name} {
vfs::log "vfs::9p::createdirectory $handle $name"
set dname [file dirname $name]
set fname [file tail $name]
set fid [::9p::walk $handle $dname]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
set qid [::9p::create $handle $fid $fname [expr $::9p::mode::DMDIR | 0777] 0]
if {$qid == {}} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
::9p::clunk $handle $fid
}
proc vfs::9p::removedirectory {handle name recursive} {
vfs::log "vfs::9p::removedirectory $handle $name $recursive"
set fid [::9p::walk $handle $name]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
if {[::9p::isdir $handle $fid]} {
9p::open $handle $fid $::9p::mode::OREAD
while {1} {
set buf [::9p::read $handle $fid 4096]
if {[string length $buf] <= 0} {
break
}
foreach stat [::9p::decodeDirs $handle $buf] {
if {! $recursive} {
::vfs::9p::posixerror [::vfs::posixError EEXIST]
}
set sname [lindex $stat 7]
vfs::9p::removedirectory $handle [file join $name $sname] $recursive
}
}
}
::9p::remove $handle $fid
}
proc vfs::9p::deletefile {handle name} {
vfs::log "vfs::9p::deletefile $handle $name"
set fid [::9p::walk $handle $name]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
::9p::remove $handle $fid
}
# XXX usually we will not be allowed to set actime
proc vfs::9p::utime {handle name actime mtime} {
vfs::log "vfs::9p::utime $handle $name $actime $mtime"
set fid [::9p::walk $handle $name]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
set stats {}
# supply 'don't touch' values
# (as discussed in plan 9 stat(5) manual page)
# except for atime and mtime
lappend stats 0xffff ;# type 2
lappend stats 0xffffffff ;# dev 4
lappend stats { 0xff 0xffffffff 0xffffffffffffffff};# qid
lappend stats 0xffffffff ;# mode 4
lappend stats $actime ;# atime 4
lappend stats $mtime ;# mtime 4
lappend stats 0xffffffffffffffff ;# ln 8
lappend stats "" ;# name
lappend stats "" ;# uid
lappend stats "" ;# gid
lappend stats "" ;# muid
9p::wstat $handle $fid $stats
9p::clunk $handle $fid
}
proc vfs::9p::open {handle name mode perm} {
vfs::log "vfs::9p::open $handle $name $mode $perm"
variable natmode
variable chanmode
# puts stderr "vfs::9p::open $handle $name $mode $perm"
# return a list of two elements:
# 1. first element is the Tcl channel name which has been opened
# 2. second element (optional) is a command to evaluate when
# the channel is closed.
set nmode $natmode($mode)
set cmode $chanmode($mode)
switch -exact -- $mode {
"" -
"r" {
set fid [::9p::walk $handle $name]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
if {[catch {::9p::open $handle $fid $nmode} msg]} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
return [chan create $cmode [list ::9p::chan $handle $fid]]
}
"r+" {
set fid [::9p::walk $handle $name]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
if {[::9p::isdir $handle $fid]} {
::vfs::9p::posixerror [::vfs::posixError EISDIR]
}
if {[catch {::9p::open $handle $fid $nmode} msg]} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
return [chan create $cmode [list ::9p::chan $handle $fid]]
}
"a" -
"a+" {
set fid [::9p::walk $handle $name]
if {$fid == {}} {
# suppress walk 'not found' error message?
set dname [file dirname $name]
set fname [file tail $name]
set fid [::9p::walk $handle $dname]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
if {![::9p::isdir $handle $fid]} {
::vfs::9p::posixerror [::vfs::posixError ENOTDIR]
}
set qid [::9p::create $handle $fid $fname $perm $nmode]
if {$qid == {}} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
} else {
if {[::9p::isdir $handle $fid]} {
::vfs::9p::posixerror [::vfs::posixError EISDIR]
}
if {[catch {::9p::open $handle $fid $nmode} msg]} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
}
::9p::seek $handle $fid 0 end
return [chan create $cmode [list ::9p::chan $handle $fid]]
}
"w" -
"w+" {
set fid [::9p::walk $handle $name]
if {$fid == {}} {
# suppress walk 'not found' error message?
set dname [file dirname $name]
set fname [file tail $name]
set fid [::9p::walk $handle $dname]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
if {![::9p::isdir $handle $fid]} {
::vfs::9p::posixerror [::vfs::posixError ENOTDIR]
}
set qid [::9p::create $handle $fid $fname $perm $nmode]
if {$qid == {}} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
} else {
if {[::9p::isdir $handle $fid]} {
::vfs::9p::posixerror [::vfs::posixError EISDIR]
}
if {[catch {::9p::open $handle $fid $nmode} msg]} {
::vfs::9p::posixerror [::vfs::posixError EACCES]
}
}
return [chan create $cmode [list ::9p::chan $handle $fid]]
}
default {
return -code error "illegal access mode \"$mode\""
}
}
}
proc vfs::9p::doesmatch {isdir types perm} {
if {$isdir} {
if {![::vfs::matchDirectories $types]} {
return 0
}
} else {
if {![::vfs::matchFiles $types]} {
return 0
}
}
return 1
}
# it seems that perm is not set by tclvfs package
proc vfs::9p::matchindirectory {handle relative actualpath pattern types {perm {}} {mac {}}} {
vfs::log "vfs::9p::matchindirectory $handle \"$relative\" $actualpath ($pattern) ($types) ($perm) $mac"
set res [list]
set fid [::9p::walk $handle $relative]
if {$fid == {}} {
::vfs::9p::posixerror [::vfs::posixError ENOENT]
}
if {[string length $pattern] > 0} {
if {![::9p::isdir $handle $fid]} {
::vfs::9p::posixerror [::vfs::posixError ENOTDIR]
}
9p::open $handle $fid $::9p::mode::OREAD
while {1} {
set buf [::9p::read $handle $fid 4096]
if {[string length $buf] <= 0} {
break
}
foreach stat [::9p::decodeDirs $handle $buf] {
set name [lindex $stat 7]
set qid [lindex $stat 2]
if {[doesmatch [::9p::qidisdir $qid] $types $perm] &&
[string match $pattern $name]} {
lappend res [file join $actualpath $name]
}
}
}
} else {
# single file
if {[doesmatch [::9p::isdir $handle $fid] $types $perm]} {
lappend res $actualpath
}
}
::9p::clunk $handle $fid
return $res
}
proc vfs::9p::fileattributes {handle path args} {
vfs::log "vfs::9p::fileattributes $handle $path $args"
switch -- [llength $args] {
0 {
# list strings
return [list]
}
1 {
# get value
set index [lindex $args 0]
}
2 {
# set value
set index [lindex $args 0]
set val [lindex $args 1]
error "read-only"
}
}
}
proc vfs::9p::posixerror {code} {
# Seems we need a special case for EEXIST in removedirectory
if {$code == [::vfs::posixError EEXIST]} {
error $code
} else {
vfs::filesystem posixerror $code
}
}
# ------------------------
|
