416 lines
10 KiB
Perl
Executable File
416 lines
10 KiB
Perl
Executable File
#!/usr/bin/perl -w
|
|
#/**************************************************************************/
|
|
#/* */
|
|
#/* Copyright (c) 2015-2016 Qindel Group (http://www.qindel.com) */
|
|
#/* */
|
|
#/* NXSCRIPTS, NX protocol compression and NX extensions to this software */
|
|
#/* are copyright of the aforementioned persons and companies. */
|
|
#/* */
|
|
#/* Redistribution and use of the present software is allowed according */
|
|
#/* to terms specified in the file LICENSE.nxcomp which comes in the */
|
|
#/* source distribution. */
|
|
#/* */
|
|
#/* All rights reserved. */
|
|
#/* */
|
|
#/* NOTE: This software has received contributions from various other */
|
|
#/* contributors, only the core maintainers and supporters are listed as */
|
|
#/* copyright holders. Please contact us, if you feel you should be listed */
|
|
#/* as copyright holder, as well. */
|
|
#/* */
|
|
#/**************************************************************************/
|
|
|
|
use strict;
|
|
use Getopt::Long;
|
|
use IO::Socket;
|
|
use Time::HiRes qw(gettimeofday tv_interval sleep );
|
|
use IO::Socket::INET;
|
|
|
|
my ($opt_batch, $opt_count, $opt_host, $opt_port, $opt_debug, $opt_blocksize, $opt_dump, $opt_delay);
|
|
my ($cmd_echo, $cmd_pingbench, $cmd_rand_read_bench, $cmd_fast_read_bench, $cmd_fast_write_bench);
|
|
my ($cmd_rand_write_bench, $cmd_fast_echo_bench, $cmd_rand_echo_bench, $cmd_all_bench);
|
|
my ($cmd_char_write_bench, $cmd_char_read_bench);
|
|
my ($cmd_help);
|
|
|
|
|
|
$opt_host = "127.0.0.1";
|
|
$opt_count = 10000;
|
|
$opt_blocksize = 1024;
|
|
$opt_delay = 0;
|
|
|
|
Getopt::Long::Configure ("bundling");
|
|
|
|
GetOptions(
|
|
"d|dump" => \$opt_dump,
|
|
"c|count=i" => \$opt_count,
|
|
"H|host=s" => \$opt_host,
|
|
"P|port=i" => \$opt_port,
|
|
"D|debug" => \$opt_debug,
|
|
"e|delay=f" => \$opt_delay,
|
|
"b|blocksize=i" => \$opt_blocksize,
|
|
"E|echo=s" => \$cmd_echo,
|
|
"pingbench" => \$cmd_pingbench,
|
|
"randreadbench" => \$cmd_rand_read_bench,
|
|
"fastreadbench" => \$cmd_fast_read_bench,
|
|
"fastwritebench" => \$cmd_fast_write_bench,
|
|
"randwritebench" => \$cmd_rand_write_bench,
|
|
"fastechobench" => \$cmd_fast_echo_bench,
|
|
"randechobench" => \$cmd_rand_echo_bench,
|
|
"charwritebench" => \$cmd_char_write_bench,
|
|
"charreadbench" => \$cmd_char_read_bench,
|
|
"a|allbench" => \$cmd_all_bench,
|
|
"h|help" => \$cmd_help,
|
|
) or die "Getopt failed";
|
|
|
|
|
|
if ($cmd_help) {
|
|
print <<HELP;
|
|
Usage: $0 --port <port> [options] <command>
|
|
NX Slave Channel demo, benchmark and tester.
|
|
|
|
Options:
|
|
-b, --blocksize=INT Block size for testing. 1024 bytes by default.
|
|
-c, --count=NUM Number of blocks or pings to issue.
|
|
-D, --debug Output protocol data for debugging
|
|
-d, --dump Dump benchmark data in tab separated format, for
|
|
graphing.
|
|
-e, --delay=FLOAT Delay between blocks or pings. None by default.
|
|
-H, --host=HOST Host to connect to. 'localhost' by default.
|
|
-P, --port=PORT Port to connect to. Mandatory.
|
|
|
|
Benchmarks:
|
|
-a, --allbench Run all the benchmarks
|
|
--fastechobench Benchmark sending a single repeated character,
|
|
and receiving it back.
|
|
--fastreadbench Benchmark reading a single repeated character.
|
|
--fastwritebench Benchmark writing a single repeated character.
|
|
--pingbench Benchmark ping time.
|
|
--randechobench Benchmark sending random data, and receiving it
|
|
back
|
|
--randreadbench Benchmark reading random, incompressible data.
|
|
--randwritebench Benchmark writing random, incompressible data.
|
|
|
|
Other commands:
|
|
-E, --echo=STR Send STR to the slave channel handler, and print
|
|
the response.
|
|
-h, --help Show this text
|
|
|
|
Example:
|
|
Test basic connectivity:
|
|
$0 --port 42000 --echo "hi"
|
|
|
|
Connect to port 42000 and run all the benchmarks:
|
|
$0 --port 42000 -a
|
|
|
|
HELP
|
|
exit(0);
|
|
}
|
|
|
|
if (!$opt_port) {
|
|
print STDERR "Syntax: $0 --port <port> <command> [arguments]\nUse $0 --help for more information.\n\n";
|
|
exit(1);
|
|
}
|
|
|
|
|
|
my $socket = IO::Socket::INET->new(PeerAddr => $opt_host, PeerPort => $opt_port, Proto => 'tcp');
|
|
if (!$socket) {
|
|
die "Can't connect to $opt_host:$opt_port: $!";
|
|
}
|
|
|
|
my @greeting = read_until_prompt();
|
|
my $sl = StatusLine->new();
|
|
my $random_fh;
|
|
|
|
if ( $cmd_all_bench ) {
|
|
$cmd_pingbench = 1;
|
|
$cmd_rand_read_bench = 1;
|
|
$cmd_fast_read_bench = 1;
|
|
$cmd_fast_write_bench = 1;
|
|
$cmd_rand_write_bench = 1;
|
|
$cmd_fast_echo_bench = 1;
|
|
$cmd_rand_echo_bench = 1;
|
|
$cmd_all_bench = 1;
|
|
|
|
}
|
|
|
|
if ( $cmd_echo ) {
|
|
send_cmd("echo $cmd_echo");
|
|
print read_until_prompt() . "\n";
|
|
}
|
|
|
|
if ( $cmd_pingbench ) {
|
|
my $t0 = [gettimeofday()];
|
|
for(my $i=0;$i<$opt_count;$i++) {
|
|
send_cmd("echo $i");
|
|
read_until_prompt();
|
|
|
|
my $elapsed = tv_interval($t0, [gettimeofday()]);
|
|
if ( $opt_dump ) {
|
|
print "$elapsed\t$i\n";
|
|
} else {
|
|
$sl->set("Pinged " . ($i+1) . " times, ${elapsed}s elapsed, " . $opt_count / $elapsed . "/s");
|
|
}
|
|
|
|
sleep($opt_delay) if ($opt_delay>0);
|
|
}
|
|
|
|
$sl->show_last();
|
|
print STDERR "\n\n";
|
|
}
|
|
|
|
if ( $cmd_rand_read_bench ) {
|
|
read_bench("Random read", "randgen");
|
|
}
|
|
|
|
if ( $cmd_fast_read_bench ) {
|
|
read_bench("Fast read", "fastgen");
|
|
}
|
|
|
|
if ( $cmd_fast_write_bench ) {
|
|
write_bench("Fast write", "discard", sub { "x" x $opt_blocksize }, 0);
|
|
}
|
|
|
|
if ( $cmd_rand_write_bench ) {
|
|
write_bench("Random write", "discard", \&get_random_bytes, 0);
|
|
}
|
|
|
|
if ( $cmd_fast_echo_bench ) {
|
|
write_bench("Fast echo", "blkecho $opt_blocksize", sub { "x" x $opt_blocksize }, 1);
|
|
}
|
|
|
|
|
|
if ( $cmd_rand_echo_bench ) {
|
|
write_bench("Random echo", "blkecho $opt_blocksize", \&get_random_bytes, 1);
|
|
}
|
|
|
|
if ( $cmd_char_write_bench ) {
|
|
for(my $i=0;$i<=255;$i++) {
|
|
write_bench("Fast write $i", "discard", sub { chr($i) x $opt_blocksize }, 0);
|
|
}
|
|
}
|
|
|
|
if ( $cmd_char_read_bench ) {
|
|
for(my $i=0;$i<=255;$i++) {
|
|
read_bench("Fast read $i", "fastgen $i");
|
|
}
|
|
}
|
|
|
|
sub get_random_bytes {
|
|
if (!$random_fh) {
|
|
open($random_fh, '<', "/dev/urandom") or die "Can't open /dev/urandom: $!";
|
|
}
|
|
|
|
my $buf="";
|
|
while(length($buf) < $opt_blocksize) {
|
|
my $tmp;
|
|
sysread($random_fh, $tmp, $opt_blocksize - length($buf));
|
|
$buf .= $tmp;
|
|
}
|
|
|
|
return $buf;
|
|
}
|
|
|
|
sub read_bench {
|
|
my ($desc, $command) = @_;
|
|
init();
|
|
send_cmd($command);
|
|
|
|
my $t0 = [gettimeofday()];
|
|
my $bytes = 0;
|
|
|
|
while($bytes < $opt_count * $opt_blocksize) {
|
|
my $junk = "";
|
|
while(length($junk) < $opt_blocksize) {
|
|
$junk .= read_sock($opt_blocksize - length($junk));
|
|
}
|
|
|
|
$bytes += length($junk);
|
|
|
|
my $elapsed = tv_interval($t0, [gettimeofday()]);
|
|
if ( $opt_dump ) {
|
|
print "$elapsed\t$bytes\n";
|
|
} else {
|
|
$sl->set("$desc $bytes bytes, ${elapsed}s elapsed, " . sprintf("%0.3f", ($bytes / $elapsed) / (1024*1024)) . " MB/s");
|
|
}
|
|
|
|
sleep($opt_delay) if ($opt_delay>0);
|
|
|
|
}
|
|
|
|
$sl->show_last();
|
|
print STDERR "\n\n";
|
|
|
|
}
|
|
|
|
sub write_bench {
|
|
my ($desc, $command, $generator, $do_read) = @_;
|
|
init();
|
|
send_cmd($command);
|
|
|
|
my $t0 = [gettimeofday()];
|
|
my $bytes = 0;
|
|
|
|
while($bytes < $opt_count * $opt_blocksize) {
|
|
|
|
my $junk = $generator->();
|
|
$bytes += length($junk);
|
|
|
|
write_sock($junk);
|
|
|
|
if ( $do_read ) {
|
|
my $readbuf = "";
|
|
while(length($readbuf) < $opt_blocksize) {
|
|
$readbuf .= read_sock($opt_blocksize-length($readbuf));
|
|
}
|
|
|
|
if ( $junk ne $readbuf ) {
|
|
die "Agent returned different data! Sent:\n$junk\nReceived:\n$readbuf\n";
|
|
}
|
|
}
|
|
|
|
my $elapsed = tv_interval($t0, [gettimeofday()]);
|
|
if ( $opt_dump ) {
|
|
print "$elapsed\t$bytes\n";
|
|
} else {
|
|
$sl->set("$desc $bytes bytes, ${elapsed}s elapsed, " . sprintf("%0.3f", ($bytes / $elapsed) / (1024*1024)) . " MB/s");
|
|
}
|
|
|
|
sleep($opt_delay) if ($opt_delay>0);
|
|
}
|
|
|
|
$sl->show_last();
|
|
print STDERR "\n\n";
|
|
|
|
}
|
|
|
|
|
|
|
|
sub read_until_prompt {
|
|
my $buf;
|
|
my $tmp;
|
|
my @lines;
|
|
my $ret = "";
|
|
|
|
while(1) {
|
|
$buf .= read_sock(1024);
|
|
|
|
while ( $buf =~ /^(.*?)\n/m ) {
|
|
dbg("LINE: '$1'\n");
|
|
push @lines, $1;
|
|
$ret .= "$1\n";
|
|
$buf =~ s/^(.*?)\n//m;
|
|
}
|
|
|
|
dbg("BUF: '$buf'\n");
|
|
if ( $buf =~ /^(Agent|Proxy|\?)> / ) {
|
|
dbg("PROMPT: '$buf'\n");
|
|
return wantarray ? @lines : $ret;
|
|
}
|
|
}
|
|
}
|
|
|
|
sub init {
|
|
if ( $socket ) {
|
|
close $socket;
|
|
}
|
|
|
|
$socket = IO::Socket::INET->new(PeerAddr => $opt_host, PeerPort => $opt_port, Proto => 'tcp');
|
|
|
|
if (!$socket) {
|
|
die "Can't connect to $opt_host:$opt_port: $!";
|
|
}
|
|
|
|
my @greeting = read_until_prompt();
|
|
}
|
|
|
|
sub read_sock {
|
|
my ($len) = @_;
|
|
my $buf;
|
|
my $ret = sysread($socket, $buf, $len);
|
|
if (!defined $ret) {
|
|
die "Error reading $len bytes from socket: $!";
|
|
}
|
|
|
|
if ( $ret == 0 ) {
|
|
die "Socket unexpectedly closed when trying to read $len bytes";
|
|
}
|
|
|
|
dbg("READ: '$buf', length $ret\n");
|
|
return $buf;
|
|
}
|
|
|
|
sub write_sock {
|
|
my ($data) = @_;
|
|
dbg("SEND: '$data'\n");
|
|
|
|
my $written = 0;
|
|
my $total = length($data);
|
|
|
|
while($written < $total) {
|
|
my $ret = syswrite($socket, $data, $total, $written);
|
|
|
|
if (!$ret) {
|
|
die "Error writing '$data' to socket: $!";
|
|
}
|
|
if ( $ret == 0 ) {
|
|
die "Socket closed when writing '$data' to socket";
|
|
}
|
|
|
|
$written += $ret;
|
|
}
|
|
|
|
}
|
|
|
|
|
|
sub send_cmd {
|
|
my ($cmd) = @_;
|
|
write_sock("$cmd\n");
|
|
}
|
|
|
|
sub dbg {
|
|
my ($str) = @_;
|
|
if ( $opt_debug ) {
|
|
$str =~ s/[^[:print:]\r\n\t]/./g;
|
|
print STDERR $str;
|
|
}
|
|
}
|
|
|
|
|
|
package StatusLine;
|
|
use Time::HiRes qw(gettimeofday tv_interval );
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
|
|
my $self = {
|
|
prev_len => 0
|
|
};
|
|
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
sub set {
|
|
my ($self, $str) = @_;
|
|
|
|
my $now = [gettimeofday()];
|
|
$self->{last_str} = $str;
|
|
|
|
if ( !defined $self->{prev_time} || tv_interval($self->{prev_time}, $now) >= 0.1 ) {
|
|
print STDERR "\r" . (" " x $self->{prev_len}) . "\r$str";
|
|
$self->{prev_len} = length($str);
|
|
$self->{prev_time} = $now;
|
|
}
|
|
}
|
|
|
|
sub clear {
|
|
my ($self) = @_;
|
|
undef $self->{prev_time};
|
|
$self->set("");
|
|
}
|
|
|
|
sub show_last {
|
|
my ($self) = @_;
|
|
undef $self->{prev_time};
|
|
$self->set( $self->{last_str} ) if ( $self->{last_str} );
|
|
}
|