我有两个 Linux 机器。一个很远。我用 LAMP(Linux Apache Mysql Perl)服务器为我遥远的 Linux 机器提供计算服务。有一天,我认为有一个脚本可以轻松地将文件从那里传输到这里会很好(我远方的员工不懂计算机)。认为通过 CGI 上传文件很容易。鉴于服务器是 https:,我可以免费获得加密。这几天一直在和它打架,没有任何效果。我在网上找到的示例不起作用。所涉及的软件包的文档太模糊了。
服务器端:
#!/usr/bin/perl -wT
use strict;
use CGI;
use CGI::Carp qw ( fatalsToBrowser );
use File::Basename;
use Sys::Syslog;
use Data::Dumper;
$CGI::POST_MAX = 1024 * 5000;
$CGI::DISABLE_UPLOADS = 0;
my $safe_filename_characters = "a-zA-Z0-9_.-";
my $upload_dir = "/var/my_safe_dir_writable_by_user_nobody";
my $query = new CGI;
#my $filename = $query->param( 'upload' );
my $filename = $query->param( 'filename' );
openlog( 'bare_upchuck.cgi','nodelay,pid','local1' );
if ( !$filename )
{
print $query->header ( );
syslog( 'debug', "No filename!" );
exit;
}
# remove any absolute directories
my ( $name, $path, $extension ) = fileparse ( $filename, '..*' );
$filename = $name . $extension;
# remove any spaces.
$filename =~ tr/ /_/;
# remove any unsafe characters
$filename =~ s/[^$safe_filename_characters]//g;
# untaint the filename, taking only safe characters.
if ( $filename =~ /^([$safe_filename_characters]+)$/ )
{
$filename = $1;
}
else
{
die "Filename contains invalid characters";
}
syslog( 'debug', "now filename is $filename" );
syslog( 'debug', CGI::Dump() );
my $upload_filehandle = $query->upload($filename );
if( !defined $upload_filehandle )
{
syslog ( 'debug', "upload_filehandle is undefined!" );
}
else
{
syslog ( 'debug', "upload_filehandle is $upload_filehandle" );
}
open( UPLOADFILE, ">$upload_dir/$filename" ) or die "$!";
binmode UPLOADFILE;
while( <$upload_filehandle> )
{
print UPLOADFILE;
}
close UPLOADFILE;
客户端:
#!/usr/bin/perl -d
use HTTP::Request::Common;
use LWP::UserAgent;
use CGI qw(:standard);
use strict;
use warnings;
my $file;
my $result;
my $message;
my $filePath = '/where_files_to_upload_are';
$file = $filePath . '/' . "stuff.pdf"; #tryit
my $ua = LWP::UserAgent->new;
my $req = $ua->request( POST 'https://www.jm-properties.com/jt5/upchuck/bare_upchuck.cgi',
Content_Type => 'form-data',
Content => [ Content_Type => "application/pdf",
filename => "stuff.pdf",
Upload => ["$file" ]
]
);
print "\nRESPONSE -- \n" . $req->as_string;
print $req->content;
# Check the outcome of the response
if ($req->is_success)
{
print $req->content;
}
else
{
print "\n in else not success\n";
}
...服务器端主要使用 CGI.pm,客户端 - LWP::UserAgent。发生的事情是文件似乎没有传输。服务器端因未定义的 $upload_filehandle 而失败。在客户端上执行 strace 显示文件正在被打开和读取。
服务器可以看到文件名,并且成功地清除了文件名。但是那里似乎没有实际的文件(在服务器中)。也许去过那里并做过那件事的人可以看到明显的东西?几天来我一直在用头撞墙,它开始受伤了:)。
可能的问题可能包括客户端上用于设置上传的 Perl 数据结构。此外 - 将错误的文件名传输到服务器,因此 $query->upload() 调用失败。但我真的不知道。而且我什至不知道如何进行故障排除。由于服务器端脚本是 CGI,我不能真正使用 Perl 调试器。我在客户端尝试了调试器,这似乎在做一些明智的事情。它确实到达了 HTTP::Common::Request::Post,正如我所说,strace 验证文件是否正在被打开和读取。我在网上找到的这个样本已经很老了,而且 API 已经漂移了......
提前致谢,