1#! /usr/bin/env tclsh 2 3if 0 { 4######################## 5 6fishvfs.tcl -- 7 8 A "FIles transferred over SHell" virtual filesystem 9 This is not an official "FISH" protocol client as described at: 10 http://mini.net/tcl/12792 11 but it utilizes the same concept of turning any computer that offers 12 access via ssh, rsh or similar shell into a file server. 13 14 Written by Stephen Huntley (stephen.huntley@alum.mit.edu) 15 License: Tcl license 16 Version 1.5.2 17 18 Usage: mount ?-volume? \ 19 ?-cache <number>? \ # cache retention seconds 20 ?-exec? \ # location of executable 21 ?-transport <protocol>? \ # can be ssh, rsh or plink 22 ?-user <username>? \ # remote computer login name 23 ?-password <password>? \ # remote computer login password 24 ?-host <remote hostname>? \ # remote computer domain name 25 ?-port <port number>? \ # override default port 26 ?<option> <value>? 27 <remote directory> \ # an existing directory on the remote filesystem 28 <virtual mount directory or URL> 29 30Options: 31 32-cache 33Sets number of seconds file information will dwell in cache after being retrieved. 34Default is 2. This value is viewable and editable after mount by calling 35"file attributes <virtual directory> -cache ?value?" 36 37-volume 38Volume specified in virtual directory pathname will be mounted as a virtual volume. 39 40-exec 41Full pathname of ssh or equivalent program. Default is name of the -transport option, 42which is assumed to be the name of the executable program findable in the PATH. 43 44-transport 45Protocol used to transport commands to remote computer. Built-in allowable values are 46ssh, rsh or plink. Extensible to new protocols with addition of a single command line 47formatting proc. 48 49The ssh option assumes rsa login protocol is set up so no interactive password entry 50is necessary. 51 52-user 53Login name at remote computer if necessary. 54 55-password 56Password for remote login name if necessary. 57 58-host 59Hostname of remote computer. Only necessary if not specified in virtual mount URL. 60 61-port 62Override default port if necessary. 63 64Arbitrary option/value pairs can be included in the command line; they may be useful if 65a custom new transport protocol handler is added which requires info not included in the 66provided set. 67 68The vfs can be mounted as a local directory, or as a URL in conjunction with 69the "-volume" option. 70 71The URL can be of the form: 72 73transport://[user[:password]@]host[:port][/filename] 74 75Option switches can be used in conjunction with a URL to specify connection 76information; the option switch values will override the URL values. 77 78 79Examples: 80 81 mount -transport ssh -user root -host tcl.tk / /mnt/vfs/tcl 82 83 mount -volume /home/foo rsh://foo@localcomp 84 85 mount -volume -password foopass /home/foo plink://foo@bar.org:2323/remotemount 86 87 mount -cache 60 -transport plink -user foo -password foopass -host bar.org /home/foo C:/Tcl/mount/foo 88 89 90Client configuration: 91 92 If the -exec option is not used, the shell client must be in the PATH; it must be 93 configured for non-interactive (no password prompt) use. 94 95 The value of the -transport option is used to load an appropriate handler 96 procedure which is called to handle the specifics of the particular client. 97 Handlers for the supported transports (ssh, rsh, plink) already exist. 98 New clients can be added simply by providing a suitable handler procedure. 99 100 server configuration: 101 102 The remote computer is assumed to be running an SSH server, have a sh-type shell and 103 the standard GNU fileutils, but otherwise no configuration is needed. 104 105######################## 106} 107 108package require vfs::template 1.5 109package provide vfs::template::fish 1.5.2 110 111namespace eval ::vfs::template::fish { 112 113# read template procedures into current namespace. Do not edit: 114foreach templateProc [namespace eval ::vfs::template {info procs}] { 115 set infoArgs [info args ::vfs::template::$templateProc] 116 set infoBody [info body ::vfs::template::$templateProc] 117 proc $templateProc $infoArgs $infoBody 118} 119 120proc close_ {channelID} { 121 upvar root root path path relative relative 122 set fileName [file join $path $relative] 123 124 fconfigure $channelID -translation binary 125 seek $channelID 0 end 126 set channelSize [tell $channelID] 127 128# use cat to pump channel contents to target file: 129 set command "cat>'$fileName'\;cat>/dev/null" 130 Transport $root $command stdin $channelID 131 132# check file size to ensure proper transmission: 133 set command "ls -l '$fileName' | ( read a b c d x e\; echo \$x )" 134 set fileSize [Transport $root $command] 135 if {$channelSize != $fileSize} {error "couldn't save \"$fileName\": Input/output error" "Input/output error" {POSIX EIO {Input/output error}}} 136 return 137} 138 139proc file_atime {file time} { 140 upvar root root 141 set atime [clock format $time -format %Y%m%d%H%M.%S -gmt 1] 142 set command "TZ=UTC\; export TZ\; touch -a -c -t $atime '$file'" 143 Transport $root $command 144 return $time 145} 146 147proc file_mtime {file time} { 148 upvar root root 149 set mtime [clock format $time -format %Y%m%d%H%M.%S -gmt 1] 150 set command "TZ=UTC\; export TZ\; touch -c -m -t $mtime '$file'" 151 Transport $root $command 152 return $time 153} 154 155proc file_attributes {file {attribute {}} args} { 156 upvar root root 157 set tail [file tail $file] 158 set value $args 159 160# retrive info option: 161 if {([string equal $attribute {}]) || ([string equal $value {}])} { 162 set command "find '$file' -maxdepth 1 -name '$tail' -printf '%u %g %m\\n'" 163 164# set info option: 165 } elseif ![string first $attribute "-group"] { 166 set command "chgrp $value '$file'" 167 } elseif ![string first $attribute "-owner"] { 168 set command "chown $value '$file'" 169 } elseif ![string first $attribute "-permissions"] { 170 set command "chmod $value '$file'" 171 } 172 173 set returnValue [Transport $root $command] 174 175# format retrieved info: 176 if [string equal $attribute {}] { 177 return "-group [lindex $returnValue 1] -owner [lindex $returnValue 0] -permissions [lindex $returnValue 2]" 178 } 179 if [string equal $value {}] { 180 if ![string first $attribute "-group"] { 181 return [lindex $returnValue 1] 182 } elseif ![string first $attribute "-owner"] { 183 return [lindex $returnValue 0] 184 } elseif ![string first $attribute "-permissions"] { 185 return [lindex $returnValue 2] 186 } 187 } 188 return 189} 190 191proc file_delete {file} { 192 upvar root root 193 set command "rm -rf '$file'" 194 Transport $root $command 195} 196proc file_executable {file} { 197 file_access $file executable 198} 199proc file_exists {file} { 200 file_access $file exists 201} 202proc file_mkdir {file} { 203 upvar root root 204 set command "mkdir -p '$file'" 205 Transport $root $command 206} 207proc file_readable {file} { 208 file_access $file readable 209} 210 211if 0 { 212### 213In the interest of efficiency, the stat call grabs a lot of info. 214Since many operations require a stat call and then an access call, this proc 215grabs the file's access info as well as the stat info and caches it. Stat info 216for every file in the target directory is grabbed in one call and cached for 217possible future use. 218### 219} 220proc file_stat {file arrayName} { 221 upvar $arrayName array 222 upvar path path root root relative relative 223 set secs [clock seconds] 224 set cache $::vfs::template::fish::cache($root) 225 226# combined command retrieves access and stat info: 227 set command "if \[ -r '$file' \]\; then echo 1\; else echo 0\; fi \; if \[ -w '$file' \]\; then echo 1\; else echo 0\; fi \; if \[ -x '$file' \]\; then echo 1\; else echo 0\; fi \; if \[ -e '$file' \]\; then echo 1\; else echo 0\; fi \; find '[::file dirname $file]' -maxdepth 1 -xtype d -printf '%A@ %C@ %G %i %m %T@ %n %s %U \{%f\}\\n' \; echo / \; find '[::file dirname $file]' -maxdepth 1 -xtype f -printf '%A@ %C@ %G %i %m %T@ %n %s %U \{%f\}\\n'" 228 229# see if info is in cache: 230 set returnValue [CacheGet ::vfs::template::fish::stat [::file join $root $relative] $cache $secs] 231 232#if not, retrieve it: 233 if [string equal $returnValue {}] { 234 set returnValue [Transport $root $command] 235 236 set dir 1 237 set returnValue [split $returnValue \n] 238 239# split off access info and cache it: 240 set access [lrange $returnValue 0 3] 241 set returnValue [lrange $returnValue 4 end] 242 CacheSet ::vfs::template::fish::readable [file join $root $relative] [lindex $access 0] $secs 243 CacheSet ::vfs::template::fish::writable [file join $root $relative] [lindex $access 1] $secs 244 CacheSet ::vfs::template::fish::executable [file join $root $relative] [lindex $access 2] $secs 245 CacheSet ::vfs::template::fish::exists [file join $root $relative] [lindex $access 3] $secs 246 247# current dir info is first entry, discard it if file is not root: 248 if ![string equal $file "/"] {set returnValue [lrange $returnValue 1 end]} 249 250# format and cache info for each file in dir containing target file: 251 set pathLength [llength [file split $path]] 252 foreach rV $returnValue { 253 if [string equal $rV "/"] {set dir 0 ; continue} 254 set fileTail [lindex $rV end] 255 set fN [::file join $root [join [lrange [file split [file join [file dirname $file] $fileTail]] $pathLength end] /]] 256 257 set value "mtime [lindex $rV 5] gid [lindex $rV 2] nlink [lindex $rV 6] atime [lindex $rV 0] mode [lindex $rV 4] type [if $dir {set type directory} else {set type file}] ctime [lindex $rV 1] uid [lindex $rV 8] ino [lindex $rV 3] size [lindex $rV 7] dev -1" 258 CacheSet ::vfs::template::fish::stat $fN $value $secs 259 260 } 261# grab info for target file from cache: 262 set returnValue $::vfs::template::fish::stat([file join $root $relative],value) 263 } 264# feed info into upvar'd array: 265 array set array $returnValue 266 return 267} 268 269proc file_writable {file} { 270 file_access $file writable 271} 272 273if 0 { 274### 275glob call aims to increase efficiency by grabbing stat info of listed files, under 276assumption that a file listing is likely to be followed by an operation on one 277of the listed files: 278### 279} 280proc glob_ {d directory nocomplain tails types typeString dashes pattern} { 281 282 upvar 1 path path root root relative relative 283 284# list files along with their stat info: 285 set command "find '$directory' -maxdepth 1 -mindepth 1 -xtype d -printf '%A@ %C@ %G %i %m %T@ %n %s %U \{%f\}\\n' \; echo / \; find '$directory' -maxdepth 1 -mindepth 1 -xtype f -printf '%A@ %C@ %G %i %m %T@ %n %s %U \{%f\}\\n'" 286 287 set returnValue [Transport $root $command] 288 set secs [clock seconds] 289 set virtualName [file join $root $relative] 290 291 set dirs {} 292 set files {} 293 set dir 1 294 295# loop through file list and cache stat info: 296 foreach rV [split $returnValue \n] { 297 if [string equal $rV "/"] {set dir 0 ; continue} 298 299 set fileTail [lindex $rV end] 300 set fN [file join $virtualName $fileTail] 301 302 set value "mtime [lindex $rV 5] gid [lindex $rV 2] nlink [lindex $rV 6] atime [lindex $rV 0] mode [lindex $rV 4] type [if $dir {set type directory} else {set type file}] ctime [lindex $rV 1] uid [lindex $rV 8] ino [lindex $rV 3] size [lindex $rV 7] dev -1" 303 CacheSet ::vfs::template::fish::stat $fN $value $secs 304 305 if $dir {lappend dirs $fileTail} else {lappend files $fileTail} 306 } 307 308# decide to return dirs, files or both: 309 set dir [lsearch $typeString "d"] 310 set file [lsearch $typeString "f"] 311 incr dir ; incr file 312 313 if $dir {set values $dirs} 314 if $file {set values $files} 315 if {$dir && $file} {set values [concat $dirs $files]} 316 317# give filenames virtual paths: 318 set fileNames {} 319 foreach fileName $values { 320 if [string equal $fileName "."] {continue} 321 if [string equal $fileName ".."] {continue} 322 if ![string match $pattern $fileName] {continue} 323 lappend fileNames $fileName 324 } 325 return $fileNames 326} 327 328proc open_ {file mode} { 329 upvar root root 330 331# check existence and file size before retrieval: 332 set command "ls -l '$file' | ( read a b c d x e\; echo \$x )" 333 if {([catch {set fileSize [Transport $root $command]}]) && ($mode == "r")} {error "couldn't open \"$file\": no such file or directory" "no such file or directory" {POSIX ENOENT {no such file or directory}}} 334 335 set channelID [memchan] 336 337# file must exist after open procedure, ensure it: 338 set command "touch -a '$file'" 339 Transport $root $command 340 341# if write mode, don't need to retrieve contents: 342 if [string match w* $mode] {return $channelID} 343 344# cat file contents to stdout and transfer to channelID: 345 fconfigure $channelID -translation binary 346 set command "cat '$file'" 347 Transport $root $command stdout $channelID 348 349# check if entire file contents transported: 350 seek $channelID 0 end 351 set channelSize [tell $channelID] 352 if {[info exists fileSize] && ($channelSize != $fileSize)} {error "Input/output error" "Input/output error" {POSIX EIO {Input/output error}}} 353 return $channelID 354} 355 356# all file access procs are redirected here for ease of programming: 357proc file_access {file type} { 358 upvar 2 root root relative relative 359 360 set command "if \[ -r '$file' \]\; then echo 1\; else echo 0\; fi \; if \[ -w '$file' \]\; then echo 1\; else echo 0\; fi \; if \[ -x '$file' \]\; then echo 1\; else echo 0\; fi \; if \[ -e '$file' \]\; then echo 1\; else echo 0\; fi" 361 set returnValue [Transport $root $command] 362 set access [split $returnValue \n] 363 set secs [clock seconds] 364 365 CacheSet ::vfs::template::fish::readable [file join $root $relative] [lindex $access 0] $secs 366 CacheSet ::vfs::template::fish::writable [file join $root $relative] [lindex $access 1] $secs 367 CacheSet ::vfs::template::fish::executable [file join $root $relative] [lindex $access 2] $secs 368 CacheSet ::vfs::template::fish::exists [file join $root $relative] [lindex $access 3] $secs 369 370 eval return \$::vfs::template::fish::${type}(\[file join \$root \$relative\],value) 371} 372 373proc MountProcedure {args} { 374 upvar volume volume 375 376 set to [lindex $args end] 377 set path [lindex $args end-1] 378 if [string equal $volume {}] {set to [file normalize $to]} 379 380# if virtual mount contains mount info, retrieve it: 381 array set params [FileTransport $to] 382 383# retrieve all option/value pairs from args list: 384 if {[llength $args] > 2} { 385 set args [lrange $args 0 end-2] 386 set argsIndex [llength $args] 387 for {set i 0} {$i < $argsIndex} {incr i} { 388 set arg [lindex $args $i] 389 if {[string index $arg 0] == "-"} { 390 set arg [string range $arg 1 end] 391 set params($arg) [lindex $args [incr i]] 392 } 393 } 394 } 395 396# local option if no other transport given, useful for testing: 397 if [string equal $params(transport) {}] {set params(transport) local} 398 399# default executable name is transport name: 400 if ![info exists params(exec)] {set params(exec) $params(transport)} 401 402# store parameters: 403 set ::vfs::template::fish::params($to) [array get params] 404 set ::vfs::template::fish::transport($to) $params(transport) 405 406# rewrite template vfshandler so appropriate transport proc is imported with each file operation: 407 set body "set trans \$::vfs::template::fish::transport(\$root) \; namespace import -force ::vfs::template::fish::\$\{trans\}::Transport \n" 408 append body [info body handler] 409 proc handler [info args handler] $body 410 411 lappend pathto $path 412 lappend pathto $to 413 return $pathto 414} 415 416proc UnmountProcedure {path to} { 417 unset ::vfs::template::fish::params($to) 418 unset ::vfs::template::fish::transport($to) 419 return 420} 421 422# execute commands, handle stdin/stdout if necessary: 423proc ExecCommand {root command args} { 424 array set params [lindex $args 0] 425 if [info exists params(stdin)] { 426 set execID [eval ::open \"|$command\" w] 427 fconfigure $execID -translation binary 428 seek $params(stdin) 0 429 puts -nonewline $execID [read $params(stdin)] 430 ::close $execID 431 return 432 } 433 434 if [info exists params(stdout)] { 435 set execID [eval ::open \"|$command\" r] 436 fconfigure $execID -translation binary 437 seek $params(stdout) 0 438 puts -nonewline $params(stdout) [read $execID] 439 ::close $execID 440 return 441 } 442 eval exec $command 443} 444# analyze virtual URL for mount information: 445proc FileTransport {filename} { 446 if {[string first : $filename] < 0} {return [list transport {} user {} password {} host {} port {} filename [file normalize $filename]]} 447 if {[string first [string range $filename 0 [string first : $filename]] [file volume]] > -1} {return [list transport {} user {} password {} host {} port {} filename [file normalize $filename]]} 448 449 set filename $filename/f 450 set transport {} ; set user {} ; set password {} ; set host {} ; set port {} 451 452 regexp {(^[^:]+)://} $filename trash transport 453 regsub {(^[^:]+://)} $filename "" userpasshost 454 set userpass [lindex [split $userpasshost @] 0] 455 set user $userpass 456 regexp {(^[^:]+):(.+)$} $userpass trash user password 457 458 if {[string first @ $userpasshost] == -1} {set user {} ; set password {}} 459 460 regsub {([^/]+)(:[^/]+)(@[^/]+)} $filename \\1\\3 filename 461 462 if [regexp {(^[^:]+)://([^/:]+)(:[^/:]*)*(.+$)} $filename trash transport host port filename] { 463 regexp {([0-9]+)} $port trash port 464 if {[string first [lindex [file split $filename] 1] [file volume]] > -1} {set filename [string range $filename 1 end]} 465 } else { 466 set host [lindex [split $filename /] 0] 467 set filename [string range $filename [string length $host] end] 468 set port [lindex [split $host :] 1] 469 set host [lindex [split $host :] 0] 470 } 471 regexp {^.+@(.+)} $host trash host 472 set filename [string range $filename 0 end-2] 473 return [list transport $transport user $user password $password host $host port $port filename $filename ] 474} 475 476 477} 478# end namespace ::vfs::template::fish 479 480 481# Each transport procedure has its own namespace and Transport proc. 482# Copy and customize for new transport methods: 483 484namespace eval ::vfs::template::fish::local { 485 proc Transport {root command {std none} {chan none}} { 486 array set params "$std $chan" 487 return [::vfs::template::fish::ExecCommand $root $command [array get params]] 488 } 489 namespace export * 490} 491 492namespace eval ::vfs::template::fish::plink { 493 proc Transport {root command {std none} {chan none}} { 494 array set params $::vfs::template::fish::params($root) 495 array set params "$std $chan" 496 497 set port {} 498 if ![string equal $params(port) {}] {set port "-P $params(port)"} 499 set commandLine "[list $params(exec)] -ssh $port -l $params(user) -batch -pw $params(password) $params(host) [list $command]" 500 501 return [::vfs::template::fish::ExecCommand $root $commandLine [array get params]] 502 } 503 namespace export * 504} 505 506namespace eval ::vfs::template::fish::rsh { 507 proc Transport {root command {std none} {chan none}} { 508 509 array set params $::vfs::template::fish::params($root) 510 array set params "$std $chan" 511 512 set user {} 513 if ![string equal $params(user) {}] {set user "-l $params(user)"} 514 set commandLine "[list $params(exec)] $user $params(host) [list ${command}]" 515 return [::vfs::template::fish::ExecCommand $root $commandLine [array get params]] 516 } 517 namespace export * 518} 519 520namespace eval ::vfs::template::fish::ssh { 521 proc Transport {root command {std none} {chan none}} { 522 523 array set params $::vfs::template::fish::params($root) 524 array set params "$std $chan" 525 526 set port {} 527 if ![string equal $params(port) {}] {set port "-D $params(port)"} 528 set user {} 529 if ![string equal $params(user) {}] {set user "-l $params(user)"} 530 set commandLine "[list $params(exec)] $port $user $params(host) [list ${command}]" 531 return [::vfs::template::fish::ExecCommand $root $commandLine [array get params]] 532 } 533 namespace export * 534} 535 536