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