get_host_property get_timeout
host_involves_pcipassthrough host_get_pcipassthrough_devs
postfork
- poll_loop link_file_contents create_webfile
+ link_file_contents create_webfile
contents_make_cpio file_simple_write_contents
power_state power_cycle power_cycle_time
setup_pxeboot setup_pxeboot_local
await_webspace_fetch_byleaf await_tcp
remote_perl_script_open remote_perl_script_done sshopts
- target_cmd_root target_cmd target_cmd_build
- target_cmd_output_root target_cmd_output
- target_getfile target_getfile_root
- target_putfile target_putfile_root
- target_putfilecontents_stash
- target_putfilecontents_root_stash
- target_editfile_root target_file_exists
- target_install_packages target_install_packages_norec
- target_extract_jobdistpath
host_reboot host_pxedir target_reboot target_reboot_hard
target_choose_vg target_umount_lv target_await_down
target_ping_check_down target_ping_check_up
return $value;
}
-#---------- running commands eg on targets ----------
-
-sub cmd {
- my ($timeout,$stdout,@cmd) = @_;
- my $child= fork; die $! unless defined $child;
- if (!$child) {
- if (defined $stdout) {
- open STDOUT, '>&', $stdout
- or die "STDOUT $stdout $cmd[0] $!";
- }
- exec @cmd;
- die "$cmd[0]: $!";
- }
- my $start= time;
- my $r;
- eval {
- local $SIG{ALRM} = sub { die "alarm\n"; };
- alarm($timeout);
- $r= waitpid $child, 0;
- alarm(0);
- };
- if ($@) {
- die unless $@ eq "alarm\n";
- logm("command timed out [$timeout]: @cmd");
- return '(timed out)';
- } else {
- my $finish= time;
- my $took= $finish-$start;
- my $warn= $took > 0.5*$timeout;
- logm(sprintf "execution took %d seconds%s: %s",
- $took, ($warn ? " [**>$timeout/2**]" : "[<=2x$timeout]"), "@cmd")
- if $warn or $took > 60;
- }
- die "$r $child $!" unless $r == $child;
- logm("command nonzero waitstatus $?: @cmd") if $?;
- return $?;
-}
-
-sub remote_perl_script_open ($$$) {
- my ($userhost, $what, $script) = @_;
- my ($readh,$writeh);
- my ($sshopts) = sshopts();
- my $pid= open2($readh,$writeh, "ssh @$sshopts $userhost perl");
- print $writeh $script."\n__DATA__\n" or die "$what $!";
- my $thing= {
- Read => $readh,
- Write => $writeh,
- Pid => $pid,
- Wait => $what,
- };
- return $thing;
-}
-sub remote_perl_script_done ($) {
- my ($thing) = @_;
- $thing->{Write}->close() or die "$thing->{What} $!";
- $thing->{Read}->close() or die "$thing->{What} $!";
- $!=0; my $got= waitpid $thing->{Pid}, 0;
- $got==$thing->{Pid} or die "$thing->{What} $!";
- !$? or die "$thing->{What} $?";
-}
-
-sub sshuho ($$) { my ($user,$ho)= @_; return "$user\@$ho->{Ip}"; }
-
-sub sshopts () {
- return [ qw(-o StrictHostKeyChecking=no
- -o BatchMode=yes
- -o ConnectTimeout=100
- -o ServerAliveInterval=100
- -o PasswordAuthentication=no
- -o ChallengeResponseAuthentication=no),
- '-o', "UserKnownHostsFile=tmp/t.known_hosts_$flight.$job"
- ];
-}
-
-sub tcmdex {
- my ($timeout,$stdout,$cmd,$optsref,@args) = @_;
- logm("executing $cmd ... @args");
- my $r= cmd($timeout,$stdout, $cmd,@$optsref,@args);
- $r and die "status $r";
-}
-
-sub tgetfileex {
- my ($ruser, $ho,$timeout, $rsrc,$ldst) = @_;
- unlink $ldst or $!==&ENOENT or die "$ldst $!";
- tcmdex($timeout,undef,
- 'scp', sshopts(),
- sshuho($ruser,$ho).":$rsrc", $ldst);
-}
-sub target_getfile ($$$$) {
- my ($ho,$timeout, $rsrc,$ldst) = @_;
- tgetfileex('osstest', @_);
-}
-sub target_getfile_root ($$$$) {
- my ($ho,$timeout, $rsrc,$ldst) = @_;
- tgetfileex('root', @_);
-}
-
-sub tputfileex {
- my ($ruser, $ho,$timeout, $lsrc,$rdst, $rsync) = @_;
- my @args= ($lsrc, sshuho($ruser,$ho).":$rdst");
- if (!defined $rsync) {
- tcmdex($timeout,undef,
- 'scp', sshopts(),
- @args);
- } else {
- unshift @args, $rsync if length $rsync;
- tcmdex($timeout,undef,
- 'rsync', [ '-e', 'ssh '.join(' ',@{ sshopts() }) ],
- @args);
- }
-}
-sub target_putfile ($$$$;$) {
- # $ho,$timeout,$lsrc,$rdst,[$rsync_opt]
- tputfileex('osstest', @_);
-}
-sub target_putfile_root ($$$$;$) {
- tputfileex('root', @_);
-}
-sub target_install_packages {
- my ($ho, @packages) = @_;
- target_cmd_root($ho, "apt-get -y install @packages",
- 300 + 100 * @packages);
-}
-sub target_install_packages_norec {
- my ($ho, @packages) = @_;
- target_cmd_root($ho,
- "apt-get --no-install-recommends -y install @packages",
- 300 + 100 * @packages);
-}
-
-sub target_somefile_getleaf ($$$) {
- my ($lleaf_ref, $rdest, $ho) = @_;
- if (!defined $$lleaf_ref) {
- $$lleaf_ref= $rdest;
- $$lleaf_ref =~ s,.*/,,;
- }
- $$lleaf_ref= "$ho->{Name}--$$lleaf_ref";
-}
-
-sub tpfcs_core {
- my ($tputfilef,$ho,$timeout,$filedata, $rdest,$lleaf) = @_;
- target_somefile_getleaf(\$lleaf,$rdest,$ho);
-
- my $h= new IO::File "$stash/$lleaf", 'w' or die "$lleaf $!";
- print $h $filedata or die $!;
- close $h or die $!;
- $tputfilef->($ho,$timeout, "$stash/$lleaf", $rdest);
-}
-sub target_putfilecontents_stash ($$$$;$) {
- my ($ho,$timeout,$filedata,$rdest, $lleaf) = @_;
- tpfcs_core(\&target_putfile, @_);
-}
-sub target_putfilecontents_root_stash ($$$$;$) {
- my ($ho,$timeout,$filedata,$rdest, $lleaf) = @_;
- tpfcs_core(\&target_putfile_root, @_);
-}
-
-sub target_file_exists ($$) {
- my ($ho,$rfile) = @_;
- my $out= target_cmd_output_root($ho, "if test -e $rfile; then echo y; fi");
- return 1 if $out =~ m/^y$/;
- return 0 if $out !~ m/\S/;
- die "$rfile $out ?";
-}
-
-sub target_editfile_root ($$$;$$) {
- my $code= pop @_;
- my ($ho,$rfile,$lleaf,$rdest) = @_;
-
- if (!defined $rdest) {
- $rdest= $rfile;
- }
- target_somefile_getleaf(\$lleaf,$rdest,$ho);
- my $lfile;
-
- for (;;) {
- $lfile= "$stash/$lleaf";
- if (!lstat $lfile) {
- $! == &ENOENT or die "$lfile $!";
- last;
- }
- $lleaf .= '+';
- }
- if ($rdest eq $rfile) {
- logm("editing $rfile as $lfile".'{,.new}');
- } else {
- logm("editing $rfile to $rdest as $lfile".'{,.new}');
- }
-
- target_getfile($ho, 60, $rfile, $lfile);
- open '::EI', "$lfile" or die "$lfile: $!";
- open '::EO', "> $lfile.new" or die "$lfile.new: $!";
-
- &$code;
-
- '::EI'->error and die $!;
- close '::EI' or die $!;
- close '::EO' or die $!;
- target_putfile_root($ho, 60, "$lfile.new", $rdest);
-}
-
-sub target_cmd_build ($$$$) {
- my ($ho,$timeout,$builddir,$script) = @_;
- target_cmd($ho, <<END.$script, $timeout);
- set -xe
- LC_ALL=C; export LC_ALL
- PATH=/usr/lib/ccache:\$PATH:/usr/lib/git-core
- exec </dev/null
- cd $builddir
-END
-}
-
-sub target_ping_check_core {
- my ($ho, $exp) = @_;
- my $out= `ping -c 5 $ho->{Ip} 2>&1`;
- $out =~ s/\b(?:\d+(?:\.\d+)?\/)*\d+(?:\.\d+)? ?ms\b/XXXms/g;
- report_once($ho, 'ping_check',
- "ping $ho->{Ip} ".(!$? ? 'up' : $?==256 ? 'down' : "$? ?"));
- return undef if $?==$exp;
- $out =~ s/\n/ | /g;
- return "ping gave ($?): $out";
-}
-sub target_ping_check_down ($) { return target_ping_check_core(@_,256); }
-sub target_ping_check_up ($) { return target_ping_check_core(@_,0); }
-
-sub target_await_down ($$) {
- my ($ho,$timeout) = @_;
- poll_loop($timeout,5,'reboot-down', sub {
- return target_ping_check_down($ho);
- });
-}
-
-sub tcmd { # $tcmd will be put between '' but not escaped
- my ($stdout,$user,$ho,$tcmd,$timeout) = @_;
- $timeout=30 if !defined $timeout;
- tcmdex($timeout,$stdout,
- 'ssh', sshopts(),
- sshuho($user,$ho), $tcmd);
-}
-sub target_cmd ($$;$) { tcmd(undef,'osstest',@_); }
-sub target_cmd_root ($$;$) { tcmd(undef,'root',@_); }
-
-sub tcmdout {
- my $stdout= IO::File::new_tmpfile();
- tcmd($stdout,@_);
- $stdout->seek(0,0) or die "$stdout $!";
- my $r;
- { local ($/) = undef;
- $r= <$stdout>; }
- die "$stdout $!" if !defined $r or $stdout->error or !close $stdout;
- chomp($r);
- return $r;
-}
-
-sub target_cmd_output ($$;$) { tcmdout('osstest',@_); }
-sub target_cmd_output_root ($$;$) { tcmdout('root',@_); }
-
-sub poll_loop ($$$&) {
- my ($maxwait, $interval, $what, $code) = @_;
- # $code should return undef when all is well
-
- logm("$what: waiting ${maxwait}s...");
- my $start= time; die $! unless defined $start;
- my $wantwaited= 0;
- my $waited= 0;
- my $bad;
- my $reported= '';
- my $logmtmpfile;
-
- my $org_logm_handle= $logm_handle;
- my $undivertlogm= sub {
- print $org_logm_handle "...\n";
- seek $logmtmpfile,0,0;
- File::Copy::copy($logmtmpfile, $org_logm_handle);
- };
-
- for (;;) {
- $logmtmpfile= IO::File::new_tmpfile or die $!;
-
- if (!eval {
- local ($Osstest::logm_handle) = ($logmtmpfile);
- $bad= $code->();
- 1;
- }) {
- $undivertlogm->();
- die "$@";
- }
-
- my $now= time; die $! unless defined $now;
- $waited= $now - $start;
- last if !defined $bad;
-
- if ($reported ne $bad) {
- logm("$what: $bad (waiting) ...");
- $reported= $bad;
- }
- last unless $waited <= $maxwait;
-
- $wantwaited += $interval;
- my $needwait= $wantwaited - $waited;
- sleep($needwait) if $needwait > 0;
- }
- if (defined $bad) {
- $undivertlogm->();
- fail("$what: wait timed out: $bad.");
- }
- logm("$what: ok. (${waited}s)");
-}
-
#---------- other stuff ----------
sub postfork () {
store_runvar get_runvar get_runvar_maybe get_runvar_default need_runvars
flight_otherjob
+ target_cmd_root target_cmd target_cmd_build
+ target_cmd_output_root target_cmd_output
+ target_getfile target_getfile_root
+ target_putfile target_putfile_root
+ target_putfilecontents_stash
+ target_putfilecontents_root_stash
+ target_editfile_root target_file_exists
+ target_install_packages target_install_packages_norec
+ target_extract_jobdistpath
+poll_loop
);
%EXPORT_TAGS = ( );
return flight_otherjob($flight,$_[0]);
}
+#---------- running commands eg on targets ----------
+
+sub cmd {
+ my ($timeout,$stdout,@cmd) = @_;
+ my $child= fork; die $! unless defined $child;
+ if (!$child) {
+ if (defined $stdout) {
+ open STDOUT, '>&', $stdout
+ or die "STDOUT $stdout $cmd[0] $!";
+ }
+ exec @cmd;
+ die "$cmd[0]: $!";
+ }
+ my $start= time;
+ my $r;
+ eval {
+ local $SIG{ALRM} = sub { die "alarm\n"; };
+ alarm($timeout);
+ $r= waitpid $child, 0;
+ alarm(0);
+ };
+ if ($@) {
+ die unless $@ eq "alarm\n";
+ logm("command timed out [$timeout]: @cmd");
+ return '(timed out)';
+ } else {
+ my $finish= time;
+ my $took= $finish-$start;
+ my $warn= $took > 0.5*$timeout;
+ logm(sprintf "execution took %d seconds%s: %s",
+ $took, ($warn ? " [**>$timeout/2**]" : "[<=2x$timeout]"), "@cmd")
+ if $warn or $took > 60;
+ }
+ die "$r $child $!" unless $r == $child;
+ logm("command nonzero waitstatus $?: @cmd") if $?;
+ return $?;
+}
+
+sub remote_perl_script_open ($$$) {
+ my ($userhost, $what, $script) = @_;
+ my ($readh,$writeh);
+ my ($sshopts) = sshopts();
+ my $pid= open2($readh,$writeh, "ssh @$sshopts $userhost perl");
+ print $writeh $script."\n__DATA__\n" or die "$what $!";
+ my $thing= {
+ Read => $readh,
+ Write => $writeh,
+ Pid => $pid,
+ Wait => $what,
+ };
+ return $thing;
+}
+sub remote_perl_script_done ($) {
+ my ($thing) = @_;
+ $thing->{Write}->close() or die "$thing->{What} $!";
+ $thing->{Read}->close() or die "$thing->{What} $!";
+ $!=0; my $got= waitpid $thing->{Pid}, 0;
+ $got==$thing->{Pid} or die "$thing->{What} $!";
+ !$? or die "$thing->{What} $?";
+}
+
+sub sshuho ($$) { my ($user,$ho)= @_; return "$user\@$ho->{Ip}"; }
+
+sub sshopts () {
+ return [ qw(-o StrictHostKeyChecking=no
+ -o BatchMode=yes
+ -o ConnectTimeout=100
+ -o ServerAliveInterval=100
+ -o PasswordAuthentication=no
+ -o ChallengeResponseAuthentication=no),
+ '-o', "UserKnownHostsFile=tmp/t.known_hosts_$flight.$job"
+ ];
+}
+
+sub tcmdex {
+ my ($timeout,$stdout,$cmd,$optsref,@args) = @_;
+ logm("executing $cmd ... @args");
+ my $r= cmd($timeout,$stdout, $cmd,@$optsref,@args);
+ $r and die "status $r";
+}
+
+sub tgetfileex {
+ my ($ruser, $ho,$timeout, $rsrc,$ldst) = @_;
+ unlink $ldst or $!==&ENOENT or die "$ldst $!";
+ tcmdex($timeout,undef,
+ 'scp', sshopts(),
+ sshuho($ruser,$ho).":$rsrc", $ldst);
+}
+sub target_getfile ($$$$) {
+ my ($ho,$timeout, $rsrc,$ldst) = @_;
+ tgetfileex('osstest', @_);
+}
+sub target_getfile_root ($$$$) {
+ my ($ho,$timeout, $rsrc,$ldst) = @_;
+ tgetfileex('root', @_);
+}
+
+sub tputfileex {
+ my ($ruser, $ho,$timeout, $lsrc,$rdst, $rsync) = @_;
+ my @args= ($lsrc, sshuho($ruser,$ho).":$rdst");
+ if (!defined $rsync) {
+ tcmdex($timeout,undef,
+ 'scp', sshopts(),
+ @args);
+ } else {
+ unshift @args, $rsync if length $rsync;
+ tcmdex($timeout,undef,
+ 'rsync', [ '-e', 'ssh '.join(' ',@{ sshopts() }) ],
+ @args);
+ }
+}
+sub target_putfile ($$$$;$) {
+ # $ho,$timeout,$lsrc,$rdst,[$rsync_opt]
+ tputfileex('osstest', @_);
+}
+sub target_putfile_root ($$$$;$) {
+ tputfileex('root', @_);
+}
+sub target_install_packages {
+ my ($ho, @packages) = @_;
+ target_cmd_root($ho, "apt-get -y install @packages",
+ 300 + 100 * @packages);
+}
+sub target_install_packages_norec {
+ my ($ho, @packages) = @_;
+ target_cmd_root($ho,
+ "apt-get --no-install-recommends -y install @packages",
+ 300 + 100 * @packages);
+}
+
+sub target_somefile_getleaf ($$$) {
+ my ($lleaf_ref, $rdest, $ho) = @_;
+ if (!defined $$lleaf_ref) {
+ $$lleaf_ref= $rdest;
+ $$lleaf_ref =~ s,.*/,,;
+ }
+ $$lleaf_ref= "$ho->{Name}--$$lleaf_ref";
+}
+
+sub tpfcs_core {
+ my ($tputfilef,$ho,$timeout,$filedata, $rdest,$lleaf) = @_;
+ target_somefile_getleaf(\$lleaf,$rdest,$ho);
+
+ my $h= new IO::File "$stash/$lleaf", 'w' or die "$lleaf $!";
+ print $h $filedata or die $!;
+ close $h or die $!;
+ $tputfilef->($ho,$timeout, "$stash/$lleaf", $rdest);
+}
+sub target_putfilecontents_stash ($$$$;$) {
+ my ($ho,$timeout,$filedata,$rdest, $lleaf) = @_;
+ tpfcs_core(\&target_putfile, @_);
+}
+sub target_putfilecontents_root_stash ($$$$;$) {
+ my ($ho,$timeout,$filedata,$rdest, $lleaf) = @_;
+ tpfcs_core(\&target_putfile_root, @_);
+}
+
+sub target_file_exists ($$) {
+ my ($ho,$rfile) = @_;
+ my $out= target_cmd_output_root($ho, "if test -e $rfile; then echo y; fi");
+ return 1 if $out =~ m/^y$/;
+ return 0 if $out !~ m/\S/;
+ die "$rfile $out ?";
+}
+
+sub target_editfile_root ($$$;$$) {
+ my $code= pop @_;
+ my ($ho,$rfile,$lleaf,$rdest) = @_;
+
+ if (!defined $rdest) {
+ $rdest= $rfile;
+ }
+ target_somefile_getleaf(\$lleaf,$rdest,$ho);
+ my $lfile;
+
+ for (;;) {
+ $lfile= "$stash/$lleaf";
+ if (!lstat $lfile) {
+ $! == &ENOENT or die "$lfile $!";
+ last;
+ }
+ $lleaf .= '+';
+ }
+ if ($rdest eq $rfile) {
+ logm("editing $rfile as $lfile".'{,.new}');
+ } else {
+ logm("editing $rfile to $rdest as $lfile".'{,.new}');
+ }
+
+ target_getfile($ho, 60, $rfile, $lfile);
+ open '::EI', "$lfile" or die "$lfile: $!";
+ open '::EO', "> $lfile.new" or die "$lfile.new: $!";
+
+ &$code;
+
+ '::EI'->error and die $!;
+ close '::EI' or die $!;
+ close '::EO' or die $!;
+ target_putfile_root($ho, 60, "$lfile.new", $rdest);
+}
+
+sub target_cmd_build ($$$$) {
+ my ($ho,$timeout,$builddir,$script) = @_;
+ target_cmd($ho, <<END.$script, $timeout);
+ set -xe
+ LC_ALL=C; export LC_ALL
+ PATH=/usr/lib/ccache:\$PATH:/usr/lib/git-core
+ exec </dev/null
+ cd $builddir
+END
+}
+
+sub target_ping_check_core {
+ my ($ho, $exp) = @_;
+ my $out= `ping -c 5 $ho->{Ip} 2>&1`;
+ $out =~ s/\b(?:\d+(?:\.\d+)?\/)*\d+(?:\.\d+)? ?ms\b/XXXms/g;
+ report_once($ho, 'ping_check',
+ "ping $ho->{Ip} ".(!$? ? 'up' : $?==256 ? 'down' : "$? ?"));
+ return undef if $?==$exp;
+ $out =~ s/\n/ | /g;
+ return "ping gave ($?): $out";
+}
+sub target_ping_check_down ($) { return target_ping_check_core(@_,256); }
+sub target_ping_check_up ($) { return target_ping_check_core(@_,0); }
+
+sub target_await_down ($$) {
+ my ($ho,$timeout) = @_;
+ poll_loop($timeout,5,'reboot-down', sub {
+ return target_ping_check_down($ho);
+ });
+}
+
+sub tcmd { # $tcmd will be put between '' but not escaped
+ my ($stdout,$user,$ho,$tcmd,$timeout) = @_;
+ $timeout=30 if !defined $timeout;
+ tcmdex($timeout,$stdout,
+ 'ssh', sshopts(),
+ sshuho($user,$ho), $tcmd);
+}
+sub target_cmd ($$;$) { tcmd(undef,'osstest',@_); }
+sub target_cmd_root ($$;$) { tcmd(undef,'root',@_); }
+
+sub tcmdout {
+ my $stdout= IO::File::new_tmpfile();
+ tcmd($stdout,@_);
+ $stdout->seek(0,0) or die "$stdout $!";
+ my $r;
+ { local ($/) = undef;
+ $r= <$stdout>; }
+ die "$stdout $!" if !defined $r or $stdout->error or !close $stdout;
+ chomp($r);
+ return $r;
+}
+
+sub target_cmd_output ($$;$) { tcmdout('osstest',@_); }
+sub target_cmd_output_root ($$;$) { tcmdout('root',@_); }
+
+sub poll_loop ($$$&) {
+ my ($maxwait, $interval, $what, $code) = @_;
+ # $code should return undef when all is well
+
+ logm("$what: waiting ${maxwait}s...");
+ my $start= time; die $! unless defined $start;
+ my $wantwaited= 0;
+ my $waited= 0;
+ my $bad;
+ my $reported= '';
+ my $logmtmpfile;
+
+ my $org_logm_handle= $logm_handle;
+ my $undivertlogm= sub {
+ print $org_logm_handle "...\n";
+ seek $logmtmpfile,0,0;
+ File::Copy::copy($logmtmpfile, $org_logm_handle);
+ };
+
+ for (;;) {
+ $logmtmpfile= IO::File::new_tmpfile or die $!;
+
+ if (!eval {
+ local ($Osstest::logm_handle) = ($logmtmpfile);
+ $bad= $code->();
+ 1;
+ }) {
+ $undivertlogm->();
+ die "$@";
+ }
+
+ my $now= time; die $! unless defined $now;
+ $waited= $now - $start;
+ last if !defined $bad;
+
+ if ($reported ne $bad) {
+ logm("$what: $bad (waiting) ...");
+ $reported= $bad;
+ }
+ last unless $waited <= $maxwait;
+
+ $wantwaited += $interval;
+ my $needwait= $wantwaited - $waited;
+ sleep($needwait) if $needwait > 0;
+ }
+ if (defined $bad) {
+ $undivertlogm->();
+ fail("$what: wait timed out: $bad.");
+ }
+ logm("$what: ok. (${waited}s)");
+}
+
1;
projects / people / iwj / osstest.git / commitdiff