/usr/share/doc/libnet-ssh2-perl/examples/benchmark.pl is in libnet-ssh2-perl 0.63-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 | #!/usr/bin/perl
use strict;
use warnings;
use feature 'say';
use Sort::Key::Top qw(ntop);
my $host = shift @ARGV // die "host missing";
my $local_iface = 'lxcbr0';
my $remote_iface = 'eth0';
my $rate_unit = 'Mbit';
my $size = 16 * 1024 * 1024;
my $dd_bs = 16 * 1024;
my $dd_count = int($size / $dd_bs);
my $cmd = "dd bs=$dd_bs count=$dd_count if=/dev/zero 2>/dev/null";
my $read_size = 4 * 64 * 1024;
my $n = 8;
my $delay_min = 10;
my $delay_max = 100;
my $delay_steps = 5;
my $delay_f = ($delay_max / $delay_min) ** (1 / ($delay_steps - 1));
my @delays = (0, map int(0.5 + $delay_min * $delay_f ** $_), 0 .. $delay_steps - 1);
my @rates = (10, 20, 100, 200, 1000);
use Time::HiRes qw(time);
use Net::SSH2;
use Net::OpenSSH;
my $ssh2 = Net::SSH2->new(compress => 0);
#$ssh2->trace(-1);
$ssh2->connect($host)
or $ssh2->die_with_error;
my $key_path = scalar(<~/.ssh/id_rsa>);
$ssh2->auth(username => undef,
publickey => "$key_path.pub", privatekey => $key_path)
or $ssh2->die_with_error;
$ssh2->auth_ok or die "auth failed";
my $openssh = Net::OpenSSH->new($host, key_path => $key_path);
$openssh->die_on_error;
my %save;
$| = 1;
sub mean1 {
my $n = int (0.5 + 0.66 * @_);
my @n = ntop -$n, @_;
my $acu = 0;
$acu += $_ for @n;
return $acu / @n;
}
sub test {
my ($ssh, $rate, $delay, $ix) = @_;
my ($name, $sub) = ($ssh->isa('Net::SSH2')
? (libssh2 => \&test_net_ssh2)
: (openssh => \&test_net_openssh));
my ($dt, $total) = $sub->($ssh);
my $speed = $total / $dt / 1024 / 1024; # MB/s
printf("%s => ix: %s, delay: %dms, rate: %d%s time: %.2fs, speed: %.2fMB/s\n",
$name, $ix, $delay, $rate, $rate_unit, $dt, $speed);
push @{$save{$rate}{$name}{$delay} //= []}, $speed;
}
sub test_net_ssh2 {
my $ssh2 = shift;
my $c = $ssh2->channel
or $ssh2->die_with_error;
$c->ext_data('ignore');
my $time0 = time;
$c->exec($cmd)
or $ssh2->die_with_error;
$c->send_eof;
my $total = 0;
my $buf;
while (my $bytes = $c->read($buf, $read_size)) {
$total += $bytes;
}
$c->wait_closed
or $ssh2->die_with_error;
return (time - $time0, $total);
}
sub test_net_openssh {
my $ssh = shift;
my $time0 = time;
my $fh = $ssh->pipe_out($cmd) or $ssh->die_on_error;
my $total = 0;
my $buf;
while (my $bytes = sysread($fh, $buf, $read_size)) {
$total += $bytes;
}
close $fh or die "close failed";
return (time - $time0, $total);
}
sub rsys {
my ($ssh2, $cmd) = @_;
my $c = $ssh2->channel or $ssh2->die_with_error;
$c->exec($cmd);
$c->send_eof();
while (my @o = $c->read2) {
print for @o;
}
close $c or warn "rsys >>$cmd<< failed $?";
}
sleep 1;
for my $ssh ($openssh, $ssh2) {
for my $rate (@rates) {
for my $delay (@delays) {
system "tc qdisc del dev $local_iface root netem 2>/dev/null; true";
rsys($ssh2, "tc qdisc del dev $remote_iface root netem 2>/dev/null; true");
rsys($ssh2, "tc qdisc add dev $remote_iface root netem delay ${delay}ms rate $rate$rate_unit");
system "tc qdisc add dev $local_iface root netem delay ${delay}ms rate $rate$rate_unit";
test($ssh, $rate, $delay, $_) for 1..$n;
system "tc qdisc del dev $local_iface root netem 2>/dev/null";
rsys($ssh2, "tc qdisc del dev $remote_iface root netem 2>/dev/null; true");
say "";
}
}
}
sub csv { say join ', ', @_ }
END {
csv Delays => @delays;
if (%save) {
for my $rate (sort { $a <=> $b } keys %save) {
csv Rate => "$rate$rate_unit";
my $h1 = $save{$rate};
for my $name (sort keys %$h1) {
my $h2 = $h1->{$name};
my @means = map mean1( @{$h2->{$_}} ), @delays;
csv "$name $rate$rate_unit" => @means;
}
say "";
}
}
}
|