bprun

   1 #!/usr/bin/perl
   2 # Batch EXecutor 2.0 -- Parallel Execution Using Screen
   3 # (c) 2011 Martin Mares <mj@ucw.cz>
   4
   5 use strict;
   6 use warnings;
   7 use feature 'switch';
   8
   9 use Getopt::Long;
  10 use POSIX;
  11
  12 use lib 'lib';
  13 use BEX;
  14
  15 my $queue_name;
  16 my $screen_session = 'BEX';
  17 my $text_mode;
  18
  19 GetOptions(
  20         "q|queue=s" => \$queue_name,
  21         "session=s" => \$screen_session,
  22         "text!" => \$text_mode,
  23 ) or die <<AMEN ;
  24 Usage: bprun [<options>] [[!]<machine-or-class> ...]
  25
  26 Options:
  27 -q, --queue=<name>      Run jobs in the given queue
  28     --session=<name>    Job windows should be opened within the given screen
  29                         session (default: BEX)
  30     --text              Use textual user interface instead of curses
  31 AMEN
  32
  33 system 'screen', '-S', $screen_session, '-X', 'select', '.';
  34 !$? or die "Screen session $screen_session not found\n";
  35
  36 my $queue = BEX::Queue->new($queue_name);
  37 my $fifo_name = $queue->{'Name'} . '/status-fifo';
  38 unlink $fifo_name;
  39 mkfifo $fifo_name, 0700 or die "Cannot create $fifo_name: $!";
  40 open FIFO, '+<', $fifo_name or die "Cannot open $fifo_name: $!";
  41
  42 my $ui = ($text_mode ? BEX::bprun::text->new : BEX::bprun::curses->new);
  43
  44 my @machines = ();
  45 for my $mach (BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*')) {
  46         my @jobs = $queue->scan($mach);
  47         @jobs or next;
  48         push @machines, $mach;
  49         for (@jobs) { $ui->update($mach, $_, 'READY'); }
  50 }
  51
  52 my %running = ();
  53 my $max = $BEX::Config::max_parallel_jobs;
  54
  55 while (keys %running || @machines) {
  56         if (@machines && keys %running < $max) {
  57                 my $mach = shift @machines;
  58                 $ui->update($mach, undef, 'START');
  59                 my @scr = ('screen', '-t', $mach);
  60                 push @scr, '-S', $screen_session if defined $screen_session;
  61                 push @scr, '-X', 'screen', './brun', "--status-fifo=$fifo_name", $mach;
  62                 system @scr;
  63                 !$? or $ui->update($mach, undef, 'INTERR');
  64                 $running{$mach} = 'START';
  65                 next;
  66         }
  67         $_ = <FIFO>;
  68         chomp;
  69         my ($mach, $jid, $stat) = /^! (\S+) (\S+) (\S+)$/;
  70         if (!defined $stat) {
  71                 $ui->err("Received invalid status message <$_>");
  72                 next;
  73         }
  74         if (!defined $running{$mach}) {
  75                 $ui->err("Received status message <$_> for a machine which does not run");
  76                 next;
  77         }
  78         $running{$mach} = $stat;
  79         $ui->update($mach, ($jid eq '-' ? undef : $jid), $stat);
  80         if ($stat eq 'DONE') {
  81                 delete $running{$mach};
  82         }
  83 }
  84
  85 close FIFO;
  86 unlink $fifo_name;
  87 $ui->done;
  88
  89 package BEX::bprun::text;
  90
  91 sub new($) {
  92         return bless {};
  93 }
  94
  95 sub done($) {
  96 }
  97
  98 sub update($$$$) {
  99         my ($ui, $mach, $jid, $stat) = @_;
 100         print +($mach // '-'), (defined($jid) ? ":$jid" : ""), " $stat\n";
 101 }
 102
 103 sub err($$) {
 104         my ($ui, $msg) = @_;
 105         print STDERR "ERROR: $msg\n";
 106 }
 107
 108 package BEX::bprun::curses;
 109
 110 use Curses;
 111
 112 my $C;
 113
 114 my $nrows;
 115 my @by_row = ();
 116 my %by_host = ();
 117
 118 my %host_state;
 119 my %host_cnt;
 120
 121 my %job_state;
 122 my %job_cnt;
 123
 124 my %host_last_fail_job;
 125 my %host_last_fail_stat;
 126
 127 sub new($) {
 128         $C = new Curses;
 129         start_color;
 130         has_colors && COLORS >= 8 && COLOR_PAIRS >= 8 or die "Your terminal is too dumb for me\n";
 131         cbreak; noecho;
 132         $C->intrflush(0);
 133         $C->keypad(1);
 134         $C->meta(1);
 135         $C->clear;
 136         init_pair(1, COLOR_YELLOW, COLOR_BLUE);
 137         init_pair(2, COLOR_YELLOW, COLOR_RED);
 138         init_pair(3, COLOR_YELLOW, COLOR_BLACK);
 139         init_pair(4, COLOR_RED, COLOR_BLACK);
 140
 141         $nrows = $C->getmaxy - 2;
 142         if ($BEX::Config::max_parallel_jobs > $nrows) {
 143                 $BEX::Config::max_parallel_jobs = $nrows;
 144         }
 145
 146         %host_state = %host_cnt = ();
 147         %job_state = %job_cnt = ();
 148         for my $s ('unknown', 'ready', 'running', 'done', 'failed') {
 149                 $host_cnt{$s} = 0;
 150                 $job_cnt{'*'}{$s} = 0;
 151         }
 152
 153         my $ui = bless {};
 154         $ui->refresh_status;
 155         return $ui;
 156 }
 157
 158 sub done($)
 159 {
 160         $C->bkgdset(COLOR_PAIR(1) | A_BOLD);
 161         $C->addstr($C->getmaxy-1, 0, "Press any key to quit...");
 162         $C->clrtoeol;
 163         $C->getch;
 164         endwin;
 165 }
 166
 167 sub err($$) {
 168         my ($ui, $msg) = @_;
 169         $C->bkgdset(COLOR_PAIR(2) | A_BOLD);
 170         $C->addnstr($C->getmaxy-1, 0, "ERROR: $msg", $C->getmaxx);
 171         $C->clrtoeol;
 172         $C->refresh;
 173 }
 174
 175 sub set_host_status($$$) {
 176         my ($ui, $mach, $stat) = @_;
 177         my $prev_stat = $host_state{$mach};
 178         if (defined $prev_stat) {
 179                 $host_cnt{$prev_stat}--;
 180         } else {
 181                 for my $s ('unknown', 'ready', 'running', 'done', 'failed') { $job_cnt{$mach}{$s} = 0; }
 182         }
 183         $host_state{$mach} = $stat;
 184         $host_cnt{$stat}++;
 185 }
 186
 187 sub set_job_status($$$$) {
 188         my ($ui, $mach, $jid, $stat) = @_;
 189         my $prev_stat = $job_state{$mach}{$jid} // 'unknown';
 190         $job_cnt{$mach}{$prev_stat}--;
 191         $job_cnt{'*'}{$prev_stat}--;
 192         $job_state{$mach}{$jid} = $stat;
 193         $job_cnt{$mach}{$stat}++;
 194         $job_cnt{'*'}{$stat}++;
 195 }
 196
 197 sub refresh_status($) {
 198         $C->bkgdset(COLOR_PAIR(1) | A_BOLD);
 199         $C->addnstr(0, 0,
 200                 sprintf("BEX  Hosts: %dR %dD %dE %dW  Jobs: %dR %dD %dE %dW",
 201                         $host_cnt{'running'},
 202                         $host_cnt{'done'},
 203                         $host_cnt{'failed'},
 204                         $host_cnt{'ready'},
 205                         $job_cnt{'*'}{'running'},
 206                         $job_cnt{'*'}{'done'},
 207                         $job_cnt{'*'}{'failed'},
 208                         $job_cnt{'*'}{'ready'},
 209                 ), $C->getmaxx);
 210         $C->clrtoeol;
 211         $C->refresh;
 212 }
 213
 214 sub get_slot($) {
 215         my ($mach) = @_;
 216         my $s;
 217         if (defined ($s = $by_host{$mach})) {
 218                 delete $s->{'Gone'};
 219         } else {
 220                 my ($best, $besti);
 221                 for my $i (0..$nrows-1) {
 222                         my $r = $by_row[$i];
 223                         if (!defined $r) {
 224                                 $besti = $i;
 225                                 $best = undef;
 226                                 last;
 227                         } elsif ($r->{'Gone'} && (!$best || $best->{'Gone'} > $r->{'Gone'})) {
 228                                 $besti = $i;
 229                                 $best = $r;
 230                         }
 231                 }
 232                 if ($best) {
 233                         delete $by_host{$best->{'Host'}};
 234                 }
 235                 $s->{'Host'} = $mach;
 236                 $s->{'Row'} = $besti;
 237                 $by_host{$mach} = $s;
 238                 $by_row[$besti] = $s;
 239         }
 240         return $s;
 241 }
 242
 243 my $gone_counter = 1;
 244 sub delete_slot($) {
 245         my ($s) = @_;
 246         $s->{'Gone'} = $gone_counter++;
 247 }
 248
 249 sub redraw_slot($) {
 250         my ($s) = @_;
 251         my $mach = $s->{'Host'};
 252         my $stat = $s->{'Status'} // "?";
 253         my $jid = $s->{'Job'} // "";
 254         my $jname = ($jid eq "" ? "" : $queue->job_name($jid));
 255         my $jcnt = $job_cnt{$mach};
 256         if ($jcnt->{'running'}) {
 257                 if ($jcnt->{'failed'}) {
 258                         $C->bkgdset(COLOR_PAIR(4) | A_BOLD);
 259                 } else {
 260                         $C->bkgdset(COLOR_PAIR(3) | A_BOLD);
 261                 }
 262         } else {
 263                 if ($jcnt->{'failed'}) {
 264                         $C->bkgdset(COLOR_PAIR(4));
 265                 } else {
 266                         $C->bkgdset(0);
 267                 }
 268         }
 269         my $r = $s->{'Row'} + 1;
 270         $C->addstr($r, 0, sprintf("%-20.20s", $mach));
 271         if ($jcnt->{'failed'}) {
 272                 $C->bkgdset(COLOR_PAIR(4));
 273                 $C->addstr(sprintf("%3dE ", $jcnt->{'failed'}));
 274         } else {
 275                 $C->bkgdset(0);
 276                 $C->addstr("     ");
 277         }
 278         $C->bkgdset(0);
 279         $C->addstr(sprintf("%3dD %3dW", $jcnt->{'done'}, $jcnt->{'ready'}));
 280         if ($stat eq 'DONE') {
 281                 if (defined $host_last_fail_stat{$mach}) {
 282                         $C->bkgdset(COLOR_PAIR(4));
 283                         $C->addstr(sprintf("  %-8s %s", $host_last_fail_stat{$mach}, $queue->job_name($host_last_fail_job{$mach})));
 284                 }
 285         } else {
 286                 my $text = sprintf("  %-8s %s", $stat, $jname);
 287                 $C->addstr($text);
 288         }
 289         $C->clrtoeol;
 290         $C->refresh;
 291 }
 292
 293 sub update($$$$) {
 294         my ($ui, $mach, $jid, $stat) = @_;
 295         my $s = get_slot($mach);
 296         given ($stat) {
 297                 when ('READY') {
 298                         # Pseudo-state generated internally
 299                         $ui->set_host_status($mach, 'ready');
 300                         $ui->set_job_status($mach, $jid, 'ready');
 301                 }
 302                 when ('OK') {
 303                         $ui->set_job_status($mach, $jid, 'done');
 304                 }
 305                 when (['FAILED', 'INTERR', 'NOPING', 'PREPFAIL']) {
 306                         $ui->set_job_status($mach, $jid, 'failed');
 307                         $host_last_fail_job{$mach} = $jid;
 308                         $host_last_fail_stat{$mach} = $stat;
 309                 }
 310                 when ('DONE') {
 311                         if ($job_cnt{$mach}{'failed'}) {
 312                                 $ui->set_host_status($mach, 'failed');
 313                         } else {
 314                                 $ui->set_host_status($mach, 'done');
 315                         }
 316                 }
 317                 when ('INIT') {
 318                         $ui->set_host_status($mach, 'running');
 319                         $ui->set_job_status($mach, $jid, 'running') if defined $jid;
 320                 }
 321                 when ('LOCKED') {
 322                         if (defined $jid) {
 323                                 $ui->set_job_status($mach, $jid, 'failed');
 324                         } else {
 325                                 for my $j (keys %{$job_state{$mach}}) {
 326                                         $ui->set_job_status($mach, $jid, 'failed');
 327                                 }
 328                                 $ui->set_host_status($mach, 'failed');
 329                                 $host_last_fail_job{$mach} = $jid;
 330                                 $host_last_fail_stat{$mach} = $stat;
 331                         }
 332                 }
 333                 when (['START', 'PING', 'SEND', 'RUN']) {
 334                 }
 335                 default {
 336                         $ui->err("Received unknown job status $stat");
 337                 }
 338         }
 339         $s->{'Job'} = $jid;
 340         $s->{'Status'} = $stat;
 341         redraw_slot($s);
 342         if ($stat eq 'DONE') { delete_slot($s); }
 343         $ui->refresh_status;
 344 }