1#! /bin/sh 2# -*- tcl -*- \ 3exec tclsh "$0" ${1+"$@"} 4 5# FTP daemon 6 7# This ftpd runs on port 7777, uses /tmp as root dir and does not do 8# any authentication at all. IOW, do not run this server for longer 9# periods of time or you create a security hole on your machine. This 10# server is strictly for short testing the implementation of the ftp 11# module over short periods of time. 12 13package require Tcl 8.3 14package require ftpd 15package require log 16 17proc bgerror {args} { 18 global errorInfo 19 puts stderr "bgerror: [join $args]" 20 puts stderr $errorInfo 21} 22 23proc ftplog {level text} { 24 if {[string equal $level note]} {set level notice} 25 log::log $level $text 26} 27 28proc noauth {args} { 29 return 1 30} 31 32proc fakefs {cmd path args} { 33 # Use the standard unix fs, i.e. "::ftpd::fsFile::fs", but rewrite the incoming path 34 # to stay in the /tmp directory. 35 36 set path [file join / tmp [file tail $path]] 37 eval [linsert $args 0 ::ftpd::fsFile::fs $cmd $path] 38} 39 40::ftpd::config -logCmd ftplog -authUsrCmd noauth -authFileCmd noauth -fsCmd fakefs 41set ::ftpd::port 7777 ; # Listen on user port 42 43::ftpd::server 44vwait forever 45