tree-bisect
standalone.db
logs
+id_rsa_osstest
+id_rsa_osstest.pub
csreadconfig
getmethod
postfork
-
$dbh_tests db_retry db_begin_work
-get_filecontents ensuredir get_filecontents_core_quiet system_checked
+ ensuredir get_filecontents_core_quiet system_checked
nonempty
-
);
%EXPORT_TAGS = ( );
our %c = qw(
- JobDb Standalone
- HostDb Static
+ JobDB Standalone
+ HostDB Static
Stash logs
Images images
Logs logs
Results results
- HostProp_DhcpWatchMethod leases dhcp3 /var/lib/dhcp3/dhcpd.leases
+ TestHostKeypairPath id_rsa_osstest
);
#---------- general setup and config reading ----------
return if $readglobalconfig_done;
$readglobalconfig_done=1;
+ $c{HostProp_DhcpWatchMethod} = 'leases dhcp3 /var/lib/dhcp3/dhcpd.leases';
+ $c{AuthorizedKeysFiles} = '';
+ $c{AuthorizedKeysAppend} = '';
+
+ my $cfgvar_re = '[A-Z][0-9a-zA-Z-_]*';
+
my $cfgfile = $ENV{'OSSTEST_CONFIG'} || "$ENV{'HOME'}/.osstest/config";
if (!open C, '<', "$cfgfile") {
die "$cfgfile $!" unless $!==&ENOENT;
s/\s+$//;
next if m/^\#/;
next unless m/\S/;
- if (m/^([A-Z][0-9a-zA-Z-_]*)\s+(\S.*)$/) {
+ if (m/^($cfgvar_re)\s+(\S.*)$/) {
$c{$1} = $2;
- } elsif (m/^([A-Z][0-9a-zA-Z-_]*)=(.*)$/) {
+ } elsif (m/^($cfgvar_re)=\s*\<\<\'(.*)\'\s*$/) {
+ my ($vn,$delim) = ($1,$2);
+ my $val = '';
+ $!=0; while (<C>) {
+ last if $_ eq "$delim\n";
+ $val .= $_;
+ }
+ die $! unless length $_;
+ $c{$vn} = $val;
+ } elsif (m/^($cfgvar_re)=(.*)$/) {
eval "\$c{$1} = ( $2 ); 1;" or die $@;
} else {
die "bad syntax";
# 2. <~/path> </path> <./path> are replaced with contents of specified file
# 3. <[> and <]> are replaced with < and >
- $mjobdb = getmethod("Osstest::JobDB::$c{JobDb}");
- $mhostdb = getmethod("Osstest::HostDB::$c{HostDb}");
+ $mjobdb = getmethod("Osstest::JobDB::$c{JobDB}");
+ $mhostdb = getmethod("Osstest::HostDB::$c{HostDB}");
$c{TestHostDomain} ||= $c{DnsDomain};
}
return $r;
}
-sub postfork () {
+sub jobdb_postfork () {
$mjobdb->postfork();
}
return $data;
}
-sub get_filecontents ($;$) {
- my ($path, $ifnoent) = @_; # $ifnoent=undef => is error
- my $data= get_filecontents_core_quiet($path);
- if (!defined $data) {
- die "$path does not exist" unless defined $ifnoent;
- logm("read $path absent.");
- return $ifnoent;
- }
- logm("read $path ok.");
- return $data;
-}
-
sub ensuredir ($) {
my ($dir)= @_;
mkdir($dir) or $!==&EEXIST or die "$dir $!";
--- /dev/null
+
+package Osstest::DhcpWatch::leases;
+
+use strict;
+use warnings;
+
+use Osstest;
+use Osstest::TestSupport;
+
+BEGIN {
+ use Exporter ();
+ our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+ $VERSION = 1.00;
+ @ISA = qw(Exporter);
+ @EXPORT = qw();
+ %EXPORT_TAGS = ( );
+
+ @EXPORT_OK = qw();
+}
+
+sub new {
+ my ($class, $ho, $meth, $format, $source) = @_;
+ die "$format (@_) ?" unless $format eq 'dhcp3';
+ return bless {
+ Format => $format,
+ Source => $source,
+ }, $class;
+}
+
+sub check_ip ($$) {
+ my ($mo, $gho) = @_;
+
+ my $leases;
+ my $leasesfn = $mo->{Source};
+
+ if ($leasesfn =~ m,/,) {
+ $leases= new IO::File $leasesfn, 'r';
+ if (!defined $leases) { return "open $leasesfn: $!"; }
+ } else {
+ $leases= new IO::Socket::INET(PeerAddr => $leasesfn);
+ }
+
+ my $lstash= "dhcpleases-$gho->{Guest}";
+ my $inlease;
+ my $props;
+ my $best;
+ my @warns;
+
+ my $copy= new IO::File "$stash/$lstash.new", 'w';
+ $copy or die "$lstash.new $!";
+
+ my $saveas= sub {
+ my ($fn,$keep) = @_;
+
+ while (<$leases>) { print $copy $_ or die $!; }
+ die $! unless $leases->eof;
+
+ my $rename= sub {
+ my ($src,$dst) = @_;
+ rename "$stash/$src", "$stash/$dst"
+ or $!==&ENOENT
+ or die "rename $fn.$keep $!";
+ };
+ while (--$keep>0) {
+ $rename->("$fn.$keep", "$fn.".($keep+1));
+ }
+ if ($keep>=0) {
+ die if $keep;
+ $rename->("$fn", "$fn.$keep");
+ }
+ $copy->close();
+ rename "$stash/$lstash.new", "$stash/$fn" or die "$lstash.new $fn $!";
+ logm("warning: $_") foreach grep { defined } @warns[0..5];
+ logm("$fn: rotated and stashed current leases");
+ };
+
+ my $badleases= sub {
+ my ($m) = @_;
+ $m= "$leasesfn:$.: unknown syntax";
+ $saveas->("$lstash.bad", 7);
+ return $m;
+ };
+
+ while (<$leases>) {
+ print $copy $_ or die $!;
+
+ chomp; s/^\s+//; s/\s+$//;
+ next if m/^\#/; next unless m/\S/;
+ if (m/^lease\s+([0-9.]+)\s+\{$/) {
+ return $badleases->("lease inside lease") if defined $inlease;
+ $inlease= $1;
+ $props= { };
+ next;
+ }
+ if (!m/^\}$/) {
+ s/^( hardware \s+ ethernet |
+ binding \s+ state
+ ) \s+//x
+ or
+ s/^( [-a-z0-9]+
+ ) \s+//x
+ or
+ return $badleases->("unknown syntax");
+ my $prop= $1;
+ s/\s*\;$// or return $badleases->("missing semicolon");
+ $props->{$prop}= $_;
+ next;
+ }
+ return $badleases->("end lease not inside lease")
+ unless defined $inlease;
+
+ $props->{' addr'}= $inlease;
+ undef $inlease;
+
+ # got a lease in $props
+
+ # ignore old leases
+ next if exists $props->{'binding state'} &&
+ lc $props->{'binding state'} ne 'active';
+
+ # ignore leases we don't understand
+ my @missing= grep { !defined $props->{$_} }
+ ('binding state', 'hardware ethernet', 'ends');
+ if (@missing) {
+ push @warns, "$leasesfn:$.: lease without \`$_'"
+ foreach @missing;
+ next;
+ }
+
+ # ignore leases for other hosts
+ next unless lc $props->{'hardware ethernet'} eq lc $gho->{Ether};
+
+ $props->{' ends'}= $props->{'ends'};
+ $props->{' ends'} =~
+ s/^[0-6]\s+(\S+)\s+(\d+)\:(\d+\:\d+)$/
+ sprintf "%s %02d:%s", $1,$2,$3 /e
+ or return $badleases->("unexpected syntax for ends");
+
+ next if $best &&
+ $best->{' ends'} gt $props->{' ends'};
+ $best= $props;
+ }
+
+ if (!$best) {
+ $saveas->("$lstash.nolease", 3);
+ return "no active lease";
+ }
+ $gho->{Ip}= $best->{' addr'};
+
+ report_once($gho, 'guest_check_ip',
+ "guest $gho->{Name}: $gho->{Ether} $gho->{Ip}");
+ return undef;
+}
+
+1;
die if $ho->{SharedOthers} && !$ho->{SharedReady};
}
-sub postfork ($) { #method
+sub jobdb_postfork ($) { #method
my ($jd) = @_;
$dbh_tests->{InactiveDestroy}= 1; undef $dbh_tests;
}
}
augmentconfigdefaults(
- JobDbStandaloneFilename => 'standalone.db',
+ JobDBStandaloneFilename => 'standalone.db',
);
sub new { return bless {}, $_[0]; };
sub dbfl_check { }
sub open ($) {
- my $dbi = "dbi:SQLite:dbname=$c{JobDbStandaloneFilename}";
+ my $dbi = "dbi:SQLite:dbname=$c{JobDBStandaloneFilename}";
my $dbh= DBI->connect($dbi, '','', {
AutoCommit => 1,
my ($jd, $ho) = @_;
}
-sub postfork ($) { }
+sub jobdb_postfork ($) { }
1;
tsreadconfig %r $flight $job $stash
ts_get_host_guest
- fail broken logm $logm_handle
+ fail broken logm $logm_handle get_filecontents
store_runvar get_runvar get_runvar_maybe
get_runvar_default need_runvars flight_otherjob
: "($flight.$job not marked $newst)");
}
+sub get_filecontents ($;$) {
+ my ($path, $ifnoent) = @_; # $ifnoent=undef => is error
+ my $data= get_filecontents_core_quiet($path);
+ if (!defined $data) {
+ die "$path does not exist" unless defined $ifnoent;
+ logm("read $path absent.");
+ return $ifnoent;
+ }
+ logm("read $path ok.");
+ return $data;
+}
+
#---------- runvars ----------
sub store_runvar ($$) {
}
sub guest_check_ip ($) {
- my ($ho) = @_;
+ my ($gho) = @_;
guest_find_ether($gho);
- $ho->{DhcpWatch}->guest_check_ip($ho);
+ $gho->{DhcpWatch}->check_ip($gho);
}
#---------- power cycling ----------
Config settings relevant only to standalone mode
-JobDbStandaloneFilename
+JobDBStandaloneFilename
Database file to use to record the "jobs" and their run variables.
Default: ./standalone.db (sqlite3)
where <format> is dhcp3
<source> is filename (with slash) or <host>:<port>
+AuthorizedKeysFiles
+ :-separated list of files to concatenate into authorized_keys
+AuthorizedKeysAppend
+ literal text to add
+The keys in ~/.ssh/id_{rsa,dsa}.pub and ~/.ssh/authorized_keys
+(if they exist) are copied anyway.
+
+TestHostKeypairPath
+
========================================
General config settings
Other config settings which might be interesting
-JobDb
-HostDb
+JobDB
+HostDB
Class name tails for the job and host databases.
ExecutiveDbnamePat
d-i clock-setup/ntp-server string ntp.uk.xensource.com
END
-$c{TestHostKeypairPath}= '/export/home/osstest/.ssh/id_rsa_osstest';
-
-$c{AuthorizedKeysFiles}= '';
-$c{AuthorizedKeysAppend}= <<'END';
-ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq8eHHFJ+XHYgpHxfSdciq0b3tYPdMhHf9CgtwdKGSqCyDyocbn1jX6P0Z535K/JcVaxvaRQbGDl9FZ25neQw6lysE8pGf+G353mgLAE7Lw6xKqlTXDcR0GpKHiZUyY8Ck5AJlGF2MO0cDEzMBx+xkOahDBvAozikUcDHJsTNP+UUIGoRaPeQK0DfgprPkoaLzXFDiZvEoBtYcUUieuNygJt+QVM+ovyTXC68wg5Xb5Ou2PopmDaVMX6/A1HxziTWc3XdhOF5ocuRF/kfWpZL223Auuu/xvNQDly13DhuVlQiU3gRIP7BSCwCdsQC/K68Q6SgfBklKRiqHquYo/QyNQ== osstest@woking.xci-test.com
-ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAs6FF9nfzWIlLPeYdqNteJBoYJAcgGxQgeNi7FHYDgWNFhoYPlMPXWOuXhgNxA2/vkX9tUMVZaAh+4WTL1iRBW5B/AS/Ek2O7uM2Uq8v68D2aU9/XalLVnIxssr84pewUmKW8hZfjNnRm99RTQ2Knr2BvtwcHqXtdGYdTYCJkel+FPYQ51yXGRU7dS0D59WapkDFU1tH1Y8s+dRZcRZNRJ5f1w/KO1zx1tOrZRkO3fPlEGNZHVUYfpZLPxz0VX8tOeoaOXhKZO8vSp1pD0L/uaD6FOmugMZxbtq9wEjhZciNCq61ynRf2yt2v9DMu4EAzbW/Ws7OBvWtYj/RHcSxKbw== iwj@woking.xci-test.com
-ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEA2m8+FRm8zaCy4+L2ZLsINt3OiRzDu82JE67b4Xyt3O0+IEyflPgw5zgGH69ypOn2GqYTaiBoiYNoAn9bpUksMk71q+co4gsZJ17Acm0256A3NP46ByT6z6/AKTl58vwwNKSCEAzNru53sXTYw2TcCZUN8A4vXY76OeJNJmCmgBDHCNod9fW6+EOn8ZSU1YjFUBV2UmS2ekKmsGNP5ecLAF1bZ8I13KpKUIDIY+UiG0UMwTWDfQY59SNsz6bCxv9NsxSXL29RS2XHFeIQis7t6hJuyZTT4b9YzjEAxvk8kdGzzK6314kwILibm1O1Y8LLyrYsWK1AvnJQFIhcYXF0EQ== iwj@mariner
-ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEApAkFv1FwknjOoataWvq5SRN/eUHjfQ5gfWnGJpIa4qnT+zAqYuC10BAHu3pHPV6NiedMxud0KcYlu/giQBMVMnYBdb7gWKdK4AQTgxHgvMMWHufa8oTLONLRsvyp1wQADJBzjQSjmo6HHF9faUckZHfJTfRxqLuR/3ENIyl+CRV9G6KfN9fbABejBxdfsbuTHc5ew2JsYxhDJsDFHgMjtrUoHI/d6eBTQDx8GRj8uUor8W+riFpW3whTH9dqloOyrqIke2qGVQlMNmzx5Z04vB1+n95nu9c5SGOZTUT4BQ5FybEANWQsNfJ7b3aMcYgVCVkKuRHSbW8Q4Pyn1Nh31w== ian@liberator
-END
-
1;
# -*- bash -*-
-umask 002
+. cri-getconfig
-getconfig () {
- perl -e '
- use Osstest;
- readglobalconfig();
-die "'$1' caps err" if "'$1'" =~ m/A-Z/;
- print $c{"'$1'"} or die $!;
- '
-}
+umask 002
repo_tree_rev_fetch_git () {
local treename=$1
--- /dev/null
+# -*- bash -*-
+
+getconfig () {
+ perl -e '
+ use Osstest;
+ readglobalconfig();
+die "'$1' caps err" if "'$1'" =~ m/A-Z/;
+ print $c{"'$1'"} or die $!;
+ '
+}
source ./tcl/osstestlib.tcl
readconfig
-source-method JobDb
+source-method JobDB
proc run-job {job} {
global jobinfo builds flight ok need_xen_hosts anyfailed
set -e
+. cri-getconfig
+
+#---------- making the database with a flight and some jobs ----------
+
+jobdb=`getconfig JobDB`
+if [ "$jobdb" != Standalone ]; then
+ echo >&2 "jobdb is $jobdb!"; exit 1
+fi
+
branch=xen-unstable
xenbranch=xen-unstable
OSSTEST_FLIGHT=$flight \
./make-flight "$branch" "$xenbranch" play $buildflight >/dev/null
+
+#---------- ensuring we have a suitable rsa key ----------
+
+keypair=`getconfig TestHostKeypairPath`
+if ! test -f "$keypair"; then
+ ssh-keygen -t rsa -b 1024 -N '' -f "$keypair"
+fi
--- /dev/null
+# -*- Tcl -*-
+
+package require Pgtcl 1.5
+
+namespace eval jobdb {
+
+proc logputs {f m} {
+ global argv
+ set time [clock format [clock seconds] -gmt true \
+ -format "%Y-%m-%d %H:%M:%S Z"]
+ puts $f "$time \[$argv] $m"
+}
+
+proc prepare {job} {
+ global jobinfo
+ db-open
+ set found 0
+ pg_execute -array jobinfo dbh "
+ SELECT job, status, recipe FROM jobs
+ WHERE flight = [pg_quote $flight]
+ AND job = [pg_quote $job]
+ " {
+ switch -exact -- $jobinfo(status) {
+ queued - preparing - retriable - play { incr found }
+ default {
+ error "job $flight.$job status $jobinfo(status)"
+ }
+ }
+ }
+ if {!$found} {
+ error "job $flight.$job not found"
+ }
+
+ setstatus preparing
+ db-close
+}
+
+proc job-set-status-unlocked {flight job st} {
+ db-open
+ pg_execute dbh "
+ UPDATE jobs SET status='$st'
+ WHERE flight=$flight AND job='$job'
+ AND status<>'aborted' AND status<>'broken'
+ "
+ db-close
+}
+
+proc job-set-status {flight job st} {
+ transaction flights {
+ job-set-status-unlocked $flight $job $st
+ }
+}
+
+proc set-flight {} {
+ global flight argv env
+
+ if {[string equal [lindex $argv 0] --start-delay]} {
+ after [lindex $argv 1]
+ set argv [lrange $argv 2 end]
+ }
+
+ set flight [lindex $argv 0]
+ set argv [lrange $argv 1 end]
+ set env(OSSTEST_FLIGHT) $flight
+}
+
+
+proc db-open {} {
+ global g
+ variable dbusers 0
+
+ if {$dbusers > 0} { incr dbusers; return }
+
+ # PgDbName_* are odbc-style strings as accepted by Perl's DBD::Pg
+ # but Tcl pg_connect unaccountably uses a different format which
+ # is whitespace-separated.
+ regsub -all {;} $c(ExecutiveDbname_osstestdb) { } conninfo
+ pg_connect -conninfo $conninfo -connhandle dbh
+ incr dbusers
+}
+proc db-close {} {
+ variable dbusers
+ incr dbusers -1
+ if {$dbusers > 0} return
+ if {$dbusers} { error "$dbusers ?!" }
+ pg_disconnect dbh
+}
+
+proc db-update-1 {stmt} {
+ # must be in transaction
+ set nrows [pg_execute dbh $stmt]
+ if {$nrows != 1} { error "$nrows != 1 in < $stmt >" }
+}
+
+proc lock-tables {tables} {
+ # must be inside transaction
+ foreach tab $tables {
+ pg_execute dbh "
+ LOCK TABLE $tab IN ACCESS EXCLUSIVE MODE
+ "
+ }
+}
+
+proc spawn-step-begin {flight job ts stepnovar} {
+ upvar 1 $stepnovar stepno
+
+ db-open
+
+ pg_execute dbh BEGIN
+ pg_execute dbh "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE"
+ if {[catch {
+ lock-tables flights
+ pg_execute -array stepinfo dbh "
+ SELECT max(stepno) AS maxstep FROM steps
+ WHERE flight=[pg_quote $flight] AND job=[pg_quote $job]
+ "
+ set stepno $stepinfo(maxstep)
+ if {[string length $stepno]} {
+ incr stepno
+ } else {
+ set stepno 1
+ }
+ pg_execute dbh "
+ INSERT INTO steps
+ VALUES ([pg_quote $flight], [pg_quote $job], $stepno,
+ [pg_quote $ts], 'running',
+ 'TBD')
+ "
+ pg_execute dbh COMMIT
+ } emsg]} {
+ global errorInfo errorCode
+ set ei $errorInfo
+ set ec $errorCode
+ catch { pg_execute dbh ROLLBACK }
+ db-close
+ error $emsg $ei $ec
+ }
+}
+
+proc spawn-step-commit {flight job stepno testid} {
+ transaction flights {
+ db-update-1 "
+ UPDATE steps
+ SET testid=[pg_quote $testid],
+ started=[clock seconds]
+ WHERE flight=[pg_quote $flight]
+ AND job=[pg_quote $job]
+ AND stepno=$stepno
+ "
+ }
+
+ db-close
+}
+
+proc step-set-status {flight job stepno st} {
+ transaction flights {
+ db-update-1 "
+ UPDATE steps
+ SET status='$st',
+ finished=[clock seconds]
+ WHERE flight=$flight AND job='$job' AND stepno=$stepno
+ "
+ set pause 0
+ pg_execute -array stopinfo dbh "
+ SELECT val FROM runvars
+ WHERE flight=$flight AND job='$job'
+ AND name='pause_on_$st'
+ " {
+ pg_execute -array stepinfo dbh "
+ SELECT * FROM steps
+ WHERE flight=$flight AND job='$job' AND stepno=$stepno
+ " {
+ foreach col {step testid} {
+ if {![info exists stepinfo($col)]} continue
+ foreach pat [split $stopinfo(val) ,] {
+ if {[string match $pat $stepinfo($col)]} {
+ set pause 1
+ }
+ }
+ }
+ }
+ }
+ }
+ if {$pause} {
+ logputs stdout "PAUSING as requested"
+ catch { exec sleep 86400 }
+ }
+}
+
+proc transaction {tables script} {
+ db-open
+ while 1 {
+ set ol {}
+ pg_execute dbh BEGIN
+ pg_execute dbh "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE"
+ lock-tables $tables
+ set rc [catch { uplevel 1 $script } result]
+ if {!$rc} {
+ if {[catch {
+ pg_execute dbh COMMIT
+ } emsg]} {
+ puts "commit failed: $emsg; retrying ..."
+ pg_execute dbh ROLLBACK
+ after 500
+ continue
+ }
+ } else {
+ pg_execute dbh ROLLBACK
+ }
+ db-close
+ return -code $rc $result
+ }
+}
+
+proc become-task {comment} {
+ global env c
+ if {[info exists env(OSSTEST_TASK)]} return
+
+ set ownerqueue [socket $c(ControlDaemonHost) $c(OwnerDaemonPort)]
+ fconfigure $ownerqueue -buffering line -translation lf
+ must-gets $ownerqueue {^OK ms-ownerdaemon\M}
+ puts $ownerqueue create-task
+ must-gets $ownerqueue {^OK created-task (\d+) (\w+ [\[\]:.0-9a-f]+)$} \
+ taskid refinfo
+ fcntl $ownerqueue CLOEXEC 0
+ set env(OSSTEST_TASK) "$taskid $refinfo"
+
+ set hostname [info hostname]
+ regsub {\..*} $hostname {} hostname
+ set username "[id user]@$hostname"
+
+ transaction resources {
+ set nrows [pg_execute dbh "
+ UPDATE tasks
+ SET username = [pg_quote $username],
+ comment = [pg_quote $comment]
+ WHERE taskid = $taskid
+ AND type = [pg_quote [lindex $refinfo 0]]
+ AND refkey = [pg_quote [lindex $refinfo 1]]
+ "]
+ }
+ if {$nrows != 1} {
+ error "$nrows $taskid $refinfo ?"
+ }
+}
+
+}; # namespace eval jobdb
--- /dev/null
+# -*- Tcl -*-
+
+package require sqlite3
+
+namespace eval jobdb {
+
+proc logputs {f m} { logf $f $m }
+
+proc prepare {job} {
+ global flight jobinfo
+ ensure-db-open
+ osstestdb eval {
+ SELECT job, status, recipe FROM jobs
+ WHERE flight = $flight
+ AND job = $job
+ } jobinfo {
+ return
+ }
+ error "job $flight.$job not found"
+}
+
+proc job-set-status {flight job st} {
+ ensure-db-open
+ osstestdb eval {
+ UPDATE jobs
+ SET status = $st
+ WHERE flight = $flight
+ AND job = $job
+ }
+}
+
+proc ensure-db-open {} {
+ global c
+ if {![catch { osstestdb version }]} { return }
+ sqlite3 osstestdb $c(JobDBStandaloneFilename)
+}
+
+proc set-flight {} {
+ global flight env
+ if {![info exists env(OSSTEST_FLIGHT)]} {
+ set env(OSSTEST_FLIGHT) standalone
+ }
+ set flight $env(OSSTEST_FLIGHT)
+}
+
+proc spawn-step-begin {flight job ts stepnovar} {
+ variable stepcounter 0
+ upvar 1 $stepnovar stepno
+ set stepno [incr stepcounter]
+}
+
+proc spawn-step-commit {flight job stepno testid} {
+ logputs stdout "$flight.$job $stepno TESTID $testid..."
+}
+
+proc step-set-status {flight job stepno st} {
+ logputs stdout "$flight.$job $stepno STATUS $st"
+}
+
+proc become-task {argv} { }
+
+}; # namespace eval jobdb
+++ /dev/null
-# -*- Tcl -*-
-
-package require Pgtcl 1.5
-
-namespace eval jobdb {
-
-proc logputs {f m} {
- global argv
- set time [clock format [clock seconds] -gmt true \
- -format "%Y-%m-%d %H:%M:%S Z"]
- puts $f "$time \[$argv] $m"
-}
-
-proc prepare {job} {
- global jobinfo
- db-open
- set found 0
- pg_execute -array jobinfo dbh "
- SELECT job, status, recipe FROM jobs
- WHERE flight = [pg_quote $flight]
- AND job = [pg_quote $job]
- " {
- switch -exact -- $jobinfo(status) {
- queued - preparing - retriable - play { incr found }
- default {
- error "job $flight.$job status $jobinfo(status)"
- }
- }
- }
- if {!$found} {
- error "job $flight.$job not found"
- }
-
- setstatus preparing
- db-close
-}
-
-proc job-set-status-unlocked {flight job st} {
- db-open
- pg_execute dbh "
- UPDATE jobs SET status='$st'
- WHERE flight=$flight AND job='$job'
- AND status<>'aborted' AND status<>'broken'
- "
- db-close
-}
-
-proc job-set-status {flight job st} {
- transaction flights {
- job-set-status-unlocked $flight $job $st
- }
-}
-
-proc set-flight {} {
- global flight argv env
-
- if {[string equal [lindex $argv 0] --start-delay]} {
- after [lindex $argv 1]
- set argv [lrange $argv 2 end]
- }
-
- set flight [lindex $argv 0]
- set argv [lrange $argv 1 end]
- set env(OSSTEST_FLIGHT) $flight
-}
-
-
-proc db-open {} {
- global g
- variable dbusers 0
-
- if {$dbusers > 0} { incr dbusers; return }
-
- # PgDbName_* are odbc-style strings as accepted by Perl's DBD::Pg
- # but Tcl pg_connect unaccountably uses a different format which
- # is whitespace-separated.
- regsub -all {;} $c(ExecutiveDbname_osstestdb) { } conninfo
- pg_connect -conninfo $conninfo -connhandle dbh
- incr dbusers
-}
-proc db-close {} {
- variable dbusers
- incr dbusers -1
- if {$dbusers > 0} return
- if {$dbusers} { error "$dbusers ?!" }
- pg_disconnect dbh
-}
-
-proc db-update-1 {stmt} {
- # must be in transaction
- set nrows [pg_execute dbh $stmt]
- if {$nrows != 1} { error "$nrows != 1 in < $stmt >" }
-}
-
-proc lock-tables {tables} {
- # must be inside transaction
- foreach tab $tables {
- pg_execute dbh "
- LOCK TABLE $tab IN ACCESS EXCLUSIVE MODE
- "
- }
-}
-
-proc spawn-step-begin {flight job ts stepnovar} {
- upvar 1 $stepnovar stepno
-
- db-open
-
- pg_execute dbh BEGIN
- pg_execute dbh "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE"
- if {[catch {
- lock-tables flights
- pg_execute -array stepinfo dbh "
- SELECT max(stepno) AS maxstep FROM steps
- WHERE flight=[pg_quote $flight] AND job=[pg_quote $job]
- "
- set stepno $stepinfo(maxstep)
- if {[string length $stepno]} {
- incr stepno
- } else {
- set stepno 1
- }
- pg_execute dbh "
- INSERT INTO steps
- VALUES ([pg_quote $flight], [pg_quote $job], $stepno,
- [pg_quote $ts], 'running',
- 'TBD')
- "
- pg_execute dbh COMMIT
- } emsg]} {
- global errorInfo errorCode
- set ei $errorInfo
- set ec $errorCode
- catch { pg_execute dbh ROLLBACK }
- db-close
- error $emsg $ei $ec
- }
-}
-
-proc spawn-step-commit {flight job stepno testid} {
- transaction flights {
- db-update-1 "
- UPDATE steps
- SET testid=[pg_quote $testid],
- started=[clock seconds]
- WHERE flight=[pg_quote $flight]
- AND job=[pg_quote $job]
- AND stepno=$stepno
- "
- }
-
- db-close
-}
-
-proc step-set-status {flight job stepno st} {
- transaction flights {
- db-update-1 "
- UPDATE steps
- SET status='$st',
- finished=[clock seconds]
- WHERE flight=$flight AND job='$job' AND stepno=$stepno
- "
- set pause 0
- pg_execute -array stopinfo dbh "
- SELECT val FROM runvars
- WHERE flight=$flight AND job='$job'
- AND name='pause_on_$st'
- " {
- pg_execute -array stepinfo dbh "
- SELECT * FROM steps
- WHERE flight=$flight AND job='$job' AND stepno=$stepno
- " {
- foreach col {step testid} {
- if {![info exists stepinfo($col)]} continue
- foreach pat [split $stopinfo(val) ,] {
- if {[string match $pat $stepinfo($col)]} {
- set pause 1
- }
- }
- }
- }
- }
- }
- if {$pause} {
- logputs stdout "PAUSING as requested"
- catch { exec sleep 86400 }
- }
-}
-
-proc transaction {tables script} {
- db-open
- while 1 {
- set ol {}
- pg_execute dbh BEGIN
- pg_execute dbh "SET TRANSACTION ISOLATION LEVEL SERIALIZABLE"
- lock-tables $tables
- set rc [catch { uplevel 1 $script } result]
- if {!$rc} {
- if {[catch {
- pg_execute dbh COMMIT
- } emsg]} {
- puts "commit failed: $emsg; retrying ..."
- pg_execute dbh ROLLBACK
- after 500
- continue
- }
- } else {
- pg_execute dbh ROLLBACK
- }
- db-close
- return -code $rc $result
- }
-}
-
-proc become-task {comment} {
- global env c
- if {[info exists env(OSSTEST_TASK)]} return
-
- set ownerqueue [socket $c(ControlDaemonHost) $c(OwnerDaemonPort)]
- fconfigure $ownerqueue -buffering line -translation lf
- must-gets $ownerqueue {^OK ms-ownerdaemon\M}
- puts $ownerqueue create-task
- must-gets $ownerqueue {^OK created-task (\d+) (\w+ [\[\]:.0-9a-f]+)$} \
- taskid refinfo
- fcntl $ownerqueue CLOEXEC 0
- set env(OSSTEST_TASK) "$taskid $refinfo"
-
- set hostname [info hostname]
- regsub {\..*} $hostname {} hostname
- set username "[id user]@$hostname"
-
- transaction resources {
- set nrows [pg_execute dbh "
- UPDATE tasks
- SET username = [pg_quote $username],
- comment = [pg_quote $comment]
- WHERE taskid = $taskid
- AND type = [pg_quote [lindex $refinfo 0]]
- AND refkey = [pg_quote [lindex $refinfo 1]]
- "]
- }
- if {$nrows != 1} {
- error "$nrows $taskid $refinfo ?"
- }
-}
-
-}; # namespace eval jobdb
+++ /dev/null
-# -*- Tcl -*-
-
-package require sqlite3
-
-namespace eval jobdb {
-
-proc logputs {f m} { logf $f $m }
-
-proc prepare {job} {
- global flight jobinfo
- ensure-db-open
- osstestdb eval {
- SELECT job, status, recipe FROM jobs
- WHERE flight = $flight
- AND job = $job
- } jobinfo {
- return
- }
- error "job $flight.$job not found"
-}
-
-proc job-set-status {flight job st} {
- ensure-db-open
- osstestdb eval {
- UPDATE jobs
- SET status = $st
- WHERE flight = $flight
- AND job = $job
- }
-}
-
-proc ensure-db-open {} {
- global c
- if {![catch { osstestdb version }]} { return }
- sqlite3 osstestdb $c(JobDbStandaloneFilename)
-}
-
-proc set-flight {} {
- global flight env
- if {![info exists env(OSSTEST_FLIGHT)]} {
- set env(OSSTEST_FLIGHT) standalone
- }
- set flight $env(OSSTEST_FLIGHT)
-}
-
-proc spawn-step-begin {flight job ts stepnovar} {
- variable stepcounter 0
- upvar 1 $stepnovar stepno
- set stepno [incr stepcounter]
-}
-
-proc spawn-step-commit {flight job stepno testid} {
- logputs stdout "$flight.$job $stepno TESTID $testid..."
-}
-
-proc step-set-status {flight job stepno st} {
- logputs stdout "$flight.$job $stepno STATUS $st"
-}
-
-proc become-task {argv} { }
-
-}; # namespace eval jobdb
tsreadconfig();
-my $ts = "./ts-hosts-allocate-$c{JobDb}";
+my $ts = "./ts-hosts-allocate-$c{JobDB}";
exec $ts, @ARGV;
die "$ts $!";
projects / people / iwj / osstest.git / commitdiff