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