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 Getopt::Long;
   8 use POSIX;
   9
  10 use lib 'lib';
  11 use BEX;
  12
  13 my $queue_name;
  14 my $screen_session = 'BEX';
  15 my $text_mode;
  16
  17 GetOptions(
  18         "q|queue=s" => \$queue_name,
  19         "session=s" => \$screen_session,
  20         "text!" => \$text_mode,
  21 ) or die <<AMEN ;
  22 Usage: bprun [<options>] [[!]<machine-or-class> ...]
  23
  24 Options:
  25 -q, --queue=<name>      Run jobs in the given queue
  26     --session=<name>    Job windows should be opened within the given screen
  27                         session (default: BEX)
  28     --text              Use textual user interface instead of curses
  29 AMEN
  30
  31 system 'screen', '-S', $screen_session, '-X', 'select', '.';
  32 !$? or die "Screen session $screen_session not found\n";
  33
  34 my @machines = BEX::Config::parse_machine_list(@ARGV ? @ARGV : '*');
  35 my $queue = BEX::Queue->new($queue_name);
  36
  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 %running = ();
  45 my $max = $BEX::Config::max_parallel_jobs;
  46
  47 while (keys %running || @machines) {
  48         if (@machines && keys %running < $max) {
  49                 my $mach = shift @machines;
  50                 my @jobs = $queue->scan($mach);
  51                 @jobs or next;
  52                 $ui->update($mach, undef, 'START');
  53                 my @scr = ('screen', '-t', $mach);
  54                 push @scr, '-S', $screen_session if defined $screen_session;
  55                 push @scr, '-X', 'screen', './brun', "--status-fifo=$fifo_name", $mach;
  56                 system @scr;
  57                 !$? or $ui->update($mach, undef, 'INTERR');
  58                 $running{$mach} = 'START';
  59                 next;
  60         }
  61         $_ = <FIFO>;
  62         chomp;
  63         my ($mach, $jid, $stat) = /^! (\S+) (\S+) (\S+)$/;
  64         if (!defined $stat) {
  65                 $ui->err("Received invalid status message <$_>");
  66                 next;
  67         }
  68         if (!defined $running{$mach}) {
  69                 $ui->err("Received status message <$_> for a machine which does not run");
  70                 next;
  71         }
  72         $running{$mach} = $stat;
  73         $ui->update($mach, ($jid eq '-' ? undef : $jid), $stat);
  74         if ($stat eq 'DONE') {
  75                 delete $running{$mach};
  76         }
  77 }
  78
  79 close FIFO;
  80 unlink $fifo_name;
  81 $ui->done;
  82
  83 package BEX::bprun::text;
  84
  85 sub new($) {
  86         return bless {};
  87 }
  88
  89 sub done($) {
  90 }
  91
  92 sub update($$$$) {
  93         my ($ui, $mach, $jid, $stat) = @_;
  94         print +($mach // '-'), (defined($jid) ? ":$jid" : ""), " $stat\n";
  95 }
  96
  97 sub err($$) {
  98         my ($ui, $msg) = @_;
  99         print STDERR "ERROR: $msg\n";
 100 }
 101
 102 package BEX::bprun::curses;
 103
 104 use Curses;
 105
 106 my $C;
 107
 108 my $nrows;
 109 my @by_row = ();
 110 my %by_host = ();
 111
 112 sub new($) {
 113         $C = new Curses;
 114         start_color;
 115         has_colors && COLORS >= 8 && COLOR_PAIRS >= 8 or die "Your terminal is too dumb for me\n";
 116         cbreak; noecho;
 117         $C->intrflush(0);
 118         $C->keypad(1);
 119         $C->meta(1);
 120         $C->clear;
 121         init_pair(1, COLOR_YELLOW, COLOR_BLUE);
 122         $nrows = $C->getmaxy - 2;
 123         if ($BEX::Config::max_parallel_jobs > $nrows) {
 124                 $BEX::Config::max_parallel_jobs = $nrows;
 125         }
 126         return bless {};
 127 }
 128
 129 sub done($)
 130 {
 131         endwin;
 132 }
 133
 134 sub get_slot($) {
 135         my ($mach) = @_;
 136         my $s;
 137         if (defined ($s = $by_host{$mach})) {
 138                 delete $s->{'Gone'};
 139         } else {
 140                 my ($best, $besti);
 141                 for my $i (0..$nrows-1) {
 142                         my $r = $by_row[$i];
 143                         if (!defined $r) {
 144                                 $besti = $i;
 145                                 $best = undef;
 146                                 last;
 147                         } elsif ($r->{'Gone'} && (!$best || $best->{'Gone'} > $r->{'Gone'})) {
 148                                 $besti = $i;
 149                                 $best = $r;
 150                         }
 151                 }
 152                 if ($best) {
 153                         delete $by_host{$best->{'Host'}};
 154                 }
 155                 $s->{'Host'} = $mach;
 156                 $s->{'Row'} = $besti;
 157                 $by_host{$mach} = $s;
 158                 $by_row[$besti] = $s;
 159         }
 160         return $s;
 161 }
 162
 163 my $gone_counter = 1;
 164 sub delete_slot($) {
 165         my ($s) = @_;
 166         $s->{'Gone'} = $gone_counter++;
 167 }
 168
 169 sub redraw_slot($) {
 170         my ($s) = @_;
 171         my $mach = $s->{'Host'};
 172         my $stat = $s->{'Status'} // "?";
 173         my $jid = $s->{'Job'} // "";
 174         my $jname = ($jid eq "" ? "" : $queue->job_name($jid));
 175         my $text = sprintf("%-20s %-10s %s", $mach, $stat, $jname);
 176         if ($stat eq 'DONE') {
 177                 $C->bkgdset(0);
 178         } else {
 179                 $C->bkgdset(COLOR_PAIR(1) | A_BOLD);
 180         }
 181         $C->addnstr($s->{'Row'}, 0, $text, $C->getmaxx);
 182         $C->clrtoeol;
 183         $C->refresh;
 184 }
 185
 186 sub update($$$$) {
 187         my ($ui, $mach, $jid, $stat) = @_;
 188         my $s = get_slot($mach);
 189         $s->{'Job'} = $jid;
 190         $s->{'Status'} = $stat;
 191         redraw_slot($s);
 192         if ($stat eq 'DONE') { delete_slot($s); }
 193 }