Repository List / perl / trunk / ftp-bwtest.pl @ HEAD

#!/usr/bin/perl -w

# FTP badwidth tester
#
# 2006-09-02 Dobrica Pavlinusic <dpavlin@rot13.org>
#
# This scripts expect input from STDIN (so you can pipe configuration to it)
# in following format:
#
# descriptive name [tab] ftp://username:password@host/path/ [tab] file_to_transfer
#
# it will try to upload and download file_to_transfer from current directory

use Net::FTP;
use Time::HiRes qw/time/;
use POSIX qw/strftime/;

my $debug = 0;

sub dump_stat($$$)  {
	my ($what, $size, $dur) = @_;

	printf("%s %d bytes in %.2f s (%.2f K/s)\n",
		$what, $size, $dur,
		($size / 1024) / $dur
	);
}

while(<>) {
	chomp;

	my ($name, $uri, $file) = split(/\t+/,$_,3);

	print STDERR "name: $name uri: $uri file: $file\n" if ($debug);

	unless ($uri =~ m!^ftp://(?:(?:([^:]*):?)?([^@]*)@)?([^/]+)/?(.*)$!i) {
		print STDERR "SKIPPED: $_\n";
		next;
	}

	my ($user, $passwd, $host, $path) = ($1,$2,$3,$4);

	print STDERR "user: $user passwd: $passwd host: $host path: $path\n" if ($debug);

	my $ftp = Net::FTP->new($host, Debug => 0) or die "Cannot connect to $host: $@";

	$ftp->login($user, $passwd) or die "Cannot login ", $ftp->message;

	$ftp->cwd($path) or die "Cannot change working directory ", $ftp->message;

	die "File $file doesn't exist" unless (-e $file);

	my $size = (stat($file))[7];

	print STDERR "file: $file [$size bytes]\n" if ($debug);

	print strftime('%Y-%m-%d %H:%M:%S', localtime()), "\t$name\n";

	my $t = time();

	$ftp->put($file) or die "put failed ", $ftp->message;

	my $dur = time() - $t;

	dump_stat('PUT', $size, $dur);

	my $tmp = '.' . $file . '.tmp';

	$t = time();
	
	$ftp->get($file, $tmp) or die "get failed ", $ftp->message;

	$dur = time() - $t;

	dump_stat('GET', $size, $dur);

	unlink $tmp or die "can't erase $tmp: $!";

	$ftp->quit;
}