lib/bin/bex-prun

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