用perl作的ftp
#!/usr/local/bin/perl#################################################################
# I found this script at http://www.terminalp.com
# it was written by a guy named Jeff who sold the domain and
# disappeared. I deleted the original header to save space
# so I am distributing this as is. If Jeff sees this, please
# email me at dreun@eskimo.com!! Thanks, Ron Hagerman
#################################################################
BEGIN {
$SAVE_DIRECTORY = "/your/literal/path/incoming/";
#定义上载的文件的存放位置
$MAXIMUM_UPLOAD = 0;
#最大上载数量
$ALLOW_INDEX = 0;
是否允许上载文件名为index.*的文件
$SUCCESS_LOCATION = "http://www.yourserver.com/~you/page.html";
#定义当上载成功以后，显示该URL指向的内容
}
$| = 1;
#设定$OUTPUT_AUTOFLUSH为1,也就是使STDOUT不对输出进行缓冲，而是直接输出。
chop $SAVE_DIRECTORY if ($SAVE_DIRECTORY =~ //$/);
#若保存目的地址以"/"结尾 则将其删除
use CGI qw(:standard);
#使用CGI模块
$query = new CGI;
#生成一个新的CGI对象
#当指定的保存目的目录名不存在或不可写或不是目录时 输出错误信息
if ( (!(-e $SAVE_DIRECTORY)) ||
(!(-W $SAVE_DIRECTORY)) ||
(!(-d $SAVE_DIRECTORY)) ) {
print header;
#输出http信息头
print <<__END_OF_HTML_CODE__;
#这里的<<__END_OF_HTML_CODE__指示print语句输出文件后面的内容 直到遇到__END_OF_HTML_CODE__ 你可以使用别的符号来替代__END_OF_HTML_CODE__
<HTML>
<HEAD>
<TITLE>Error: Bad Directory</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<H1>Bad Directory</H1>
<P>
The directory you specified:
<BR>
<BLOCKQUOTE>
<TT>$SAVE_DIRECTORY = "<B>$SAVE_DIRECTORY</B>";</TT>
</BLOCKQUOTE>
<BR>
is invalid. This problem is caused by one of the three following reasons:
<OL>
<LI>The directory doesn't exist. Make sure that this directory is a complete path name, not
a URL or something similar. It should look similar to <TT>/home/username/public_html/uploads</TT>
<P>
<LI>The directory isn't writable. Make sure that this directory is writable by all users. At
your UNIX command prompt, type <TT>chmod 777 $SAVE_DIRECTORY</TT>
<P>
<LI>The directory you specified isn't really a directory. Make sure that this is indeed a directory
and not a file.
</OL>
</BODY>
</HTML>
__END_OF_HTML_CODE__
exit;
}
foreach $key (sort {$a <=> $b} $query->param()) {
#对html form中的各个元素的名字进行排序 然后对每个名字进行如下操作
next if ($key =~ /^s*$/);
#若名字为空 则进行下一次循环
next if ($query->param($key) =~ /^s*$/);
#若名字对应的值为空 则进行下一次循环
next if ($key !~ /^file-to-upload-(d+)$/);
#若名字不为file-to-upload-(数字)的形式 则进行下一次循环
$Number = $1;
if ($query->param($key) =~ /([^/\]+)$/) {
#若取到的上载路径中的文件名部分不为空则
$Filename = $1;
$Filename =~ s/^.+//;
#将取到的文件名保存到变量$Filename中，并且去除文件名前的"."符号
$File_Handle = $query->param($key);
#完全路径的文件名保存到$File_Handle;
if (!$ALLOW_INDEX && $Filename =~ /^index/i) {
#若不允许上载文件名为index.*的文件而文件却恰恰为index.*形式则输出错误信息
print header;
print <<__END_OF_HTML_CODE__;
<HTML>
<HEAD>
<TITLE>Error: Filename Problem</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<H1>Filename Problem</H1>
<P>
You attempted to upload a file that isn't properly formatted. The system administrator
has decided that you can't upload files that begin with the word '<B>index</B>'. Please
rename the file on your computer, and try uploading it again.
<P>
</BODY>
</HTML>
__END_OF_HTML_CODE__
exit;
}
#end of decide whether the file can be index.* style
} else {
#当取得的文件名为空 则输出错误信息
$FILENAME_IN_QUESTION = $query->param($key);
#取得该文件路径到变量$FILENAME_IN_QUESTION中 然后输出错误信息
print header;
print <<__END_OF_HTML_CODE__;
<HTML>
<HEAD>
<TITLE>Error: Filename Problem</TITLE>
</HEAD>
<BODY BGCOLOR="#FFFFFF">
<H1>Filename Problem</H1>
<P>
You attempted to upload a file that isn't properly formatted. The file in question
is <TT><B>$FILENAME_IN_QUESTION</B></TT> Please rename the file on your computer, and
attempt to upload it again. Files may not have forward or backward slashes in their
names. Also, they may not be prefixed with one (or more) periods.
<P>
</BODY>
</HTML>
__END_OF_HTML_CODE__
exit;
}
if (!open(OUTFILE, ">$SAVE_DIRECTORY/$Filename")) {
#以写入的方式在上载目录下创建与上载文件同名的文件 若打开错误则输出错误信息
print "Content-type: text/plainnn";
print "-------------------------n";
print "Error:n";
print "-------------------------n";
print "File: $SAVE_DIRECTORY/$Filenamen";
print "-------------------------n";
print "There was an error opening the Output Filen";
print "for Writing.nn";
print "Make sure that the directory:n";
print "$SAVE_DIRECTORYn";
print "has been chmodded with the permissions '777'.nn";
print "Also, make sure that if your attemptingn";
print "to overwrite an existing file, that then";
print "existing file is chmodded '666' or better.nn";
print "The Error message below should help you diagnosen";
print "the problem.nn";
print "Error: $!n";
exit;
}
undef $BytesRead;
undef $Buffer;
while ($Bytes = read($File_Handle,$Buffer,1024)) {
#从要上载源文件读取1K的内容到变量buffer中 循环直到将文件内容全部读完
$BytesRead += $Bytes;
#更新从该文件读取的字节数总数
print OUTFILE $Buffer;
#输出$buffer内容到目的文件中
}
push(@Files_Written, "$SAVE_DIRECTORY/$Filename");
#将上载的带有本机路径文件名加入到数组@Files_Written中
$TOTAL_BYTES += $BytesRead;
#更新上载
