use strict; use warnings; #use Smart::Comments::JSON '##'; use IPC::Run3 qw(run3); #use List::MoreUtils qw( all ); delete $ENV{SSH_BATCH_SSH_CMD}; delete $ENV{SSH_BATCH_LINE_MODE}; my $should_skip; BEGIN { $should_skip = ! $ENV{SSH_BATCH_TEST_AGENTZH}; }; use Test::More $should_skip ? (skip_all => "Should only be enabled by developers.") : ('no_plan'); sub sh ($) { my $cmd = shift; if (system($cmd) != 0) { die "Failed to execute $cmd. Abort.\n"; } } sub fornodes (@) { my ($out, $err); run3 [$^X, 'bin/fornodes', @_], \undef, \$out, \$err; if ($? != 0) { warn "fornodes returns non-zero status: ", $? >> 8, "\n"; } if ($err) { warn $err; } chomp $out; my @hosts = split / /ms, $out; return \@hosts; } sub tonodes (@) { my ($out, $err); run3 [$^X, 'bin/tonodes', @_], \undef, \$out, \$out; if ($? != 0) { warn "tonodes returns non-zero status: ", $? >> 8, "\n"; } if ($err) { warn $err; } my @outs = split /^====+ [^=]+ ===+$/ms, $out; shift @outs; return \@outs; } sub tonodes2 (@) { my ($out, $err); run3 [$^X, 'bin/tonodes', @_], \undef, \$out, \$out; if ($? != 0) { warn "tonodes returns non-zero status: ", $? >> 8, "\n"; } if ($err) { warn $err; } return $out; } sub atnodes (@) { my ($out, $err); run3 [$^X, 'bin/atnodes', @_], \undef, \$out, \$out; if ($? != 0) { warn "atnodes returns non-zero status: ", $? >> 8, "\n"; } if ($err) { warn $err; } my @outs = split /^====+ [^=]+ ===+$/ms, $out; shift @outs; return \@outs; } sub atnodes2 (@) { my ($out, $err); run3 [$^X, 'bin/atnodes', @_], \undef, \$out, \$out; if ($? != 0) { warn "atnodes returns non-zero status: ", $? >> 8, "\n"; } if ($err) { warn $err; } return $out; } sub gen_local_tree () { if (-d 't/tmp') { sh 'rm -rf t/tmp'; } sh 'mkdir -p t/tmp'; sh 'touch t/tmp/a.txt'; sh 'touch t/tmp/b.txt'; sh 'touch t/tmp/README'; sh 'mkdir -p t/tmp/foo/bar'; sh 'touch t/tmp/foo/INSTALL'; } sub cleanup_remote_tree ($) { my $count = shift; my $outs = atnodes('rm -rf /tmp/tmp', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; for my $out (@$outs) { like $out, qr/^\s*$/, 'rm successfuly'; } $outs = atnodes('ls /tmp/tmp', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; ## outs: @$outs for my $out (@$outs) { is $out, "\nRemote command returns status code 1.\nls: /tmp/tmp: No such file or directory\n\n", 'directory already removed'; } } my $hosts = fornodes('{tq}'); my $count = @$hosts; ok $count > 3, "more than 3 hosts in {tq} (found $count)"; # atnodes: exit 1 { my $out = atnodes2('exit 1', '{tq}', '-L'); my @lines = split /\n/, $out; my $i = 0; for my $host (@$hosts) { like $lines[$i++], qr/^\Q$host\E: Remote command returns status code 1\.$/, 'line mode works'; } } # atnodes: multi-line output { my $out = atnodes2('echo hello, world; echo hey', '{tq}', '-L'); my @lines = split /\n/, $out; my $i = 0; for my $host (@$hosts) { like $lines[$i++], qr/^\Q$host\E: hello, world$/, 'line mode works'; like $lines[$i++], qr/^\Q$host\E: hey$/, 'line mode works'; } } # atnodes: single-line { my $out = atnodes2('echo', '{tq}', '-L'); my @lines = split /\n/, $out; my $i = 0; for my $host (@$hosts) { like $lines[$i++], qr/^\Q$host\E: $/, 'line mode works'; } } # atnodes: no output { my $out = atnodes2('echo -n', '{tq}', '-L'); is $out, '', 'no output, no hostname'; } # atnodes: buggy with invalid hosts { my $out = atnodes2('hostname', '{buggy}', '-L'); open my $in, '<', \$out; my $i = 0; my $fail_count = 0; while (<$in>) { chomp; next if /^ssh:.*?: Name or service not known\r?$/s; if (/^\S+: ERROR: /) { $fail_count++; next; } my $host = $hosts->[$i++]; my $hostname; if ($host =~ /^\w+/) { $hostname = $&; } like $_, qr/^\Q$host\E: $hostname$/, 'hostname works'; } close $in; cmp_ok $fail_count, '>', 1, 'fail count okay'; ## out: $out } # atnodes: buggy with timeout hosts { my $out = atnodes2('hostname', '-t', 2, '{timeout}', '-L'); open my $in, '<', \$out; my $i = 0; my $fail_count = 0; while (<$in>) { chomp; next if /^ssh:.*?: Name or service not known\r?$/s; if (/^\S+: ERROR: .*?timed out/) { $fail_count++; next; } my $host = $hosts->[$i++]; my $hostname; if ($host =~ /^\w+/) { $hostname = $&; } like $_, qr/^\Q$host\E: $hostname$/, 'hostname works'; } close $in; cmp_ok $fail_count, '>=', 1, 'fail count okay'; ## out: $out } # tonodes: buggy with invalid hosts { my $out = tonodes2('t/agentzh.t', '{buggy}:/tmp/', '-L'); open my $in, '<', \$out; my $i = 0; my $fail_count = 0; while (<$in>) { chomp; next if /^ssh:.*?: Name or service not known\r?$/s; if (/^\S+: ERROR: /) { $fail_count++; next; } } close $in; cmp_ok $fail_count, '>', 1, 'fail count okay'; ## out: $out } # tonodes: buggy with timeout hosts { my $out = tonodes2('t/agentzh.t', '-t', 2, '{timeout}:/tmp/', '-L'); open my $in, '<', \$out; my $i = 0; my $fail_count = 0; while (<$in>) { chomp; if (/^\S+: ERROR: .*?timed out/) { $fail_count++; } } close $in; cmp_ok $fail_count, '>=', 1, 'fail count okay'; ## out: $out } #exit; cleanup_remote_tree($count); my $outs = tonodes('-r', '-rsync', 't/tmp', '--', '{tq}', ':/tmp/'); for my $out (@$outs) { is $out, "\n\n", 'transfer successfuly'; } $outs = atnodes('ls /tmp/tmp|sort', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; ## outs: @$outs for my $out (@$outs) { is $out, "\nREADME\na.txt\nb.txt\nfoo\n\n", 'only specified files uploaded'; } cleanup_remote_tree($count); gen_local_tree(); $outs = tonodes('-r', 't/tmp', '{tq}:/tmp/'); is scalar(@$outs), $count, 'all hosts generate outputs'; $outs = atnodes('ls /tmp/tmp|sort', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; for my $out (@$outs) { is $out, "\nREADME\na.txt\nb.txt\nfoo\n\n", 'level 1 files expected'; } $outs = atnodes('ls /tmp/tmp/foo|sort', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; ## outs: @$outs for my $out (@$outs) { is $out, "\nINSTALL\nbar\n\n", 'level 1 files expected'; } cleanup_remote_tree($count); $outs = tonodes('t/tmp', '{tq}:/tmp/', '-v'); for my $out (@$outs) { is $out, "\n", 'transfer successfuly'; } $outs = atnodes('ls /tmp/tmp', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; ## outs: @$outs for my $out (@$outs) { is $out, "\nRemote command returns status code 1.\nls: /tmp/tmp: No such file or directory\n\n", 'no -r no cp'; } cleanup_remote_tree($count); $outs = atnodes('mkdir /tmp/tmp', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; $outs = tonodes('t/tmp/a.txt', 't/tmp/b.txt', '--', '{tq}', ':/tmp/tmp/'); for my $out (@$outs) { is $out, "\n\n", 'transfer successfuly'; } $outs = atnodes('ls /tmp/tmp|sort', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; ## outs: @$outs for my $out (@$outs) { is $out, "\na.txt\nb.txt\n\n", 'only specified files uploaded'; } cleanup_remote_tree($count); $outs = atnodes('mkdir /tmp/tmp', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; $outs = tonodes('t/tmp/*', '--', '{tq}', ':/tmp/tmp/'); ## outs: @$outs for my $out (@$outs) { is $out, "\n\n", 'transfer successfuly'; } $outs = atnodes('ls /tmp/tmp|sort', '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; for my $out (@$outs) { is $out, "\n\n", 'no glob no files'; } $outs = tonodes('-g', 't/tmp/*', '--', '{tq}', ':/tmp/tmp/', '-c', 2, '-v'); for my $out (@$outs) { like $out, qr/^\s*$/s, 'transfer successfuly'; } $outs = atnodes('ls /tmp/tmp|sort', '-c', 2, '{tq}'); is scalar(@$outs), $count, 'all hosts generate outputs'; ## outs: @$outs for my $out (@$outs) { is $out, "\nREADME\na.txt\nb.txt\n\n", 'only specified files uploaded'; } warn "DONE.\n";