/usr/share/tcltk/xotcl1.6.7-comm/Ftp.xotcl is in xotcl 1.6.7-2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 | # $Id: Ftp.xotcl,v 1.3 2005/09/09 21:09:01 neumann Exp $
package provide xotcl::comm::ftp 0.9
package require xotcl::comm::httpAccess
package require XOTcl
namespace eval ::xotcl::comm::ftp {
namespace import ::xotcl::*
Class Ftp -superclass NetAccess -parameter {user passwd}
Ftp instproc initialize args {
#my showCall
my instvar port caching user passwd loginMsg resp blocksize
set port 21
set blocksize 1024
set caching 0
set user ftp
set passwd cineast@
set loginMsg {}
set resp(connect) {220 provideUser}
set resp(provideUser) {331 providePasswd}
set resp(providePasswd) {230 loginFinished}
set resp(loginFinished) {227 pasv}
set resp(pasv) {200 type}
set resp(type-list) {150 list}
set resp(type-retr) {150 retr 550 retry-retrieve}
set resp(transfer) {226 transferDone}
next
}
Ftp instproc err {state reply} {
my abort "Error in $state: $reply"
}
Ftp instproc queryServer {query state} {
my instvar S
puts $S $query
flush $S
fileevent $S readable [::list [self] response $state]
}
Ftp instproc response {state} {
#my showCall
my instvar S code msg
set reply [gets $S]
#my showVars reply
if {[regexp {^([0-9]+)[-](.*)$} $reply _ code msg]} {
fileevent $S readable [::list [self] responseMulti $state]
} else {
regexp {^([0-9]+) (.*)$} $reply _ code msg
my responseEnd $state
}
}
Ftp instproc responseMulti {state} {
# multi line response
my instvar S code msg
set m [gets $S]
if {[regexp "^$code " $m]} {
my responseEnd $state
} else {
# try to strip code and dash
regexp "^$code-(.*)\$" $m _ m
append msg \n$m
}
}
Ftp instproc responseEnd {state} {
my instvar S code msg resp
fileevent $S readable {}
#puts stderr "code=$code, msg=<$msg>"
foreach {c newState} $resp($state) {
if {$c == $code} { return [my $newState] }
}
my err $state "expected=$resp($state), got $code $msg"
}
Ftp instproc GET {} {
my instvar S host port url
regexp {^(.*):([0-9]+)$} $host _ host port
my running
# rb running my $url ;# ???
# proxy ?
set S [socket -async $host $port]
fconfigure $S -blocking false -translation {auto crlf}
fileevent $S readable [::list [self] response connect]
}
Ftp instproc provideUser {} {
my instvar user msg loginMsg
set loginMsg $msg
my queryServer "USER $user" provideUser
}
Ftp instproc providePasswd {} {
my instvar passwd
# if {[pwdManager requirePasswd "Ftp $user\@$host" $user password]} {
# my queryServer "PASS $password" providePasswd
# }
my queryServer "PASS $passwd" providePasswd
}
Ftp instproc loginFinished {} {
my instvar msg loginMsg
append loginMsg \n$msg
my queryServer "PASV" loginFinished
}
Ftp instproc pasv {} {
my instvar S D msg
set d {([0-9]+)}
if {[regexp "\[(]$d,$d,$d,$d,$d,$d" $msg _ 1 2 3 4 p1 p2]} {
if {[catch {set D [socket -async $1.$2.$3.$4 [expr {$p1*256 + $p2}]]} err
]} {
return [my err $proc $err]
}
fconfigure $D -blocking no -translation binary
} else {
return [my err $proc $msg]
}
my queryServer "TYPE I" pasv
}
Ftp instproc type {} {
my instvar path
if {$path=={}} {
my queryServer "LIST" type-list
} elseif {[regexp /$ $path]} {
my queryServer "LIST $path" type-list
} else {
my queryServer "RETR $path" type-retr
}
}
Ftp instproc retry-retrieve {} {
my instvar path url
append url /
my queryServer "LIST $path/" type-list
}
Ftp instproc list {} {
my instvar S D contentType
set contentType text/dirlist
my headerDone
fileevent $S readable [::list [self] response transfer]
fileevent $D readable [::list [self] readData]
}
Ftp instproc read {} {
# the method read is called by the more general method readData
my instvar D block blocksize
if {[::eof $D]} {
set block ""
close $D
unset D
} else {
#puts stderr blocksize=$blocksize
set block [::read $D $blocksize]
#puts stderr read:[string length $block]bytes
}
}
Ftp instproc transferDone {} {
my instvar D S
if {[info exists D]} {
fileevent $S readable {}
set block ""
close $D
unset D
}
my finish
}
Ftp instproc retr {} {
my instvar S D msg totalsize contentType path
regexp {[(]([0-9]+)[ ]+[Bb]ytes} $msg _ totalsize
set contentType [Mime guessContentType $path]
my headerDone
if {[info exists S]} {
# file dialog was not canceled
fileevent $S readable [::list [self] response transfer]
fileevent $D readable [::list [self] readData]
fconfigure $D -translation binary
}
}
namespace export Ftp
}
namespace import ::xotcl::comm::ftp::*
|