blob: e599e54d3d82afef072fb22a118be5ba6c8ce52d (
plain)
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
|
#!/usr/bin/env tclsh
## -*- tcl -*-
# FTP daemon
# This ftpd runs on port 7777, uses /tmp as root dir and does not do
# any authentication at all. IOW, do not run this server for longer
# periods of time or you create a security hole on your machine. This
# server is strictly for short testing the implementation of the ftp
# module over short periods of time.
package require Tcl 8.3
package require ftpd
package require log
proc bgerror {args} {
global errorInfo
puts stderr "bgerror: [join $args]"
puts stderr $errorInfo
}
proc ftplog {level text} {
if {[string equal $level note]} {set level notice}
log::log $level $text
}
proc noauth {args} {
return 1
}
proc fakefs {cmd path args} {
# Use the standard unix fs, i.e. "::ftpd::fsFile::fs", but rewrite the incoming path
# to stay in the /tmp directory.
set path [file join / tmp [file tail $path]]
eval [linsert $args 0 ::ftpd::fsFile::fs $cmd $path]
}
::ftpd::config -logCmd ftplog -authUsrCmd noauth -authFileCmd noauth -fsCmd fakefs
set ::ftpd::port 7777 ; # Listen on user port
::ftpd::server
vwait forever
|
