grub2/grub2-once

#!/usr/bin/perl
#
# (C) 2014 mchang@suse.com
#
# 2014-02-20 jw@suse.de

use strict;

my $grub2_dir;
my $grub2_reboot;
my $grub2_editenv;
my $show_mapped;
my $id_name;
my @menuentry;
my @enumentry;
my %E;

sub dPrint($) {
  #print( STDERR @_[0]);
}

sub sh_test($) {
  my ( $exp ) = @_;

  dPrint( "?? '$exp' ");
  $exp .= " ]" if ( $exp =~ m{^\[.*[^\]]\s*$} ); # gnaaa
  #my $t = qx{set -x; $exp};
  my $t = qx{$exp};
  my $ret = $? >> 8;
  $ret = ($ret == 0) ? 1 : 0;
  dPrint("=> $ret ($t)\n");
  return $ret;
}

sub read_cfg($$) {
    my ($dir, $cfg) = @_;

    my $fh;
    my $m = "";
    my $state = 1; # 1 == normal, 010 == if-false, 011 == if-true, 110 == else-false, 111 == else-true 
    my @State = ();

    if ($dir) {
      %E = ( "config_directory" => $dir );
      dPrint("# VE: 'cd'='$dir'\n");
      $dir .= "/";
      if ($> == 0) {
	open($fh, "$grub2_editenv - list |") || die "cannot read grub2 environment: $!\n";
	while (<$fh>) {
	  chomp;
	  if ( m{^([^\s=]+?)=(.*)$} ) {
	    my ($k, $v) = ($1, $2);
	    $v =~ s{^"([^"]*)"$}{$1};
	    dPrint("# VE: '$k'='$v'\n");
	    $E{$k} = $v;
	  }
	}
	close($fh);
      }
    }

    dPrint("# open($dir$cfg)\n");
    open($fh, "<$dir$cfg") || die "cannot read $cfg in $dir: $!\n";

    LINE: while ( <$fh> ) {
      s{^#.*$}{}; 	# get rid of trailing comments,
      s{\s+$}{}; 	# trailing whitespace
      s{\s*;$}{};   	# including semicolons
      next if (m{^\s*$});	# and empty lines.
      s{^\s*}{ }; 	# force leading whitespace to one

      dPrint(sprintf("#%d: '%s'  [%s]%04b\n", $., $_, join(",",@State), $state));
      if ( m{^ fi$} ) {
	$state = pop( @State);
	$m .= "$_\n";
	dPrint(sprintf(">FI: [%s]0b%04b\n", join(",",@State), $state));
	next;
      }
      if ($state & 0b10) {	# {if,else}-*
	if  ( m{^ elif\s+(.*?)\s*; then$} && !($state & 0b1000)) {
	  if ($state & 0b1) {
	    $state = 0b110;  # else-false
	  } else {
	    $state = 0b010 + sh_test( $1);  # if-?
	    dPrint(sprintf("=EI: 0b%03b\n", $state));
	    $m .= "$_\n";
	    next;
	  }
	} elsif ( m{^ else$} && !($state & 0b1000)) {
	  if (($state & 0b111) == 0b010) {  # in 'if' but neither 'else' nor 'true'
	    $state = 0b111;  # else-true
	  } else {
	    $state = 0b110;  # else-false
	  }
	  $m .= "$_\n";
	  dPrint(sprintf("=EL: 0b%03b\n", $state));
	  next;
	}
      }
      if ($state & 0b1) { # *-true or normal
	dPrint("-I1: $_\n");
      } else { # *-false
	dPrint("-I0: $_\n");
	if ( m{^ if (.*?)\s*; then$} ) {
	  push( @State, $state);
	  $state = 0b1000;
	  $m .= "$_\n";
	}
	next;
      }

      while ( m'(?:[^\\])(\$(?:{([^}]+?)}|([A-Za-z0-9_]+)))' ) {
	my ($s, $k1, $k2) = ($1, $2, $3);
	my $k = (defined($k1)) ? $k1 : $k2;
	dPrint("# VT: '$k'\n");
	if (exists( $E{$k})) {
	  $s =~ s{([\$\{\}\"])}{\\$1}g;
	  dPrint("# VB: '$_'\n");
	  s{$s}{$E{$k}} || die;
	  dPrint("# VR: '$_'\n");
	} else {
	  $s =~ s{([\$\{\}\"])}{\\$1}g;
	  s{$s}{} || die;
	  dPrint("# VR: '$_'\n");
	}
      }

      if ( m{^ if (.*?)\s*; then$} ) {
	push( @State, $state);
	$state = 0b010 + sh_test( $1);
	dPrint(sprintf("<IF: 0b%03b [%s]\n", $state, join (",", @State)));
      } elsif ( m{^ (?:set\s+)?([^\s=]+?)=(.*)$} ) {
	my ($k, $v) = ($1, $2);
	$v =~ s{^"([^"]*)"$}{$1};
	dPrint("# VA: '$k'='$v'\n");
	$E{$k} = $v;
      } elsif ( m{^ source\s+(\S+)$} ) {
	my $f = $1;
	$f =~ s{^"([^"]+)"$}{$1} &&
	dPrint("# f='$f'\n");
	if ( -r $f ) {
	  $m .= read_cfg("", $f);
	}
	next;
      }
      $m .= "$_\n";
    }
    close ($fh);
    return ($m);
}

sub parse_menuentry($$$) {

    my ($parent, $pId, $menu) = @_;
    my $c = 0;
    my @m = $menu =~ /(submenu|menuentry) \s+ (.*?) ( \{ (?: [^{}]* | (?3))* \} )/sxg;

    for (my $i = 0; $i <= $#m; $i += 3) {

        my $type  = $m[$i];
        my $title = `printf "%s\n" $m[$i+1] | head -1 | tr -d '\n'`;
        my $data  = $m[$i+2];
        my $name = ($parent) ? "$parent>$title" : "$title";
        my $eId = (($pId ne "") ? "$pId>" : "") . $c++;

        if ($type eq "menuentry") {
            push @menuentry, $name;
            push @enumentry, [$name, $eId];
        } elsif ($type eq "submenu") {
            parse_menuentry ($name, $eId, $data);
        }
    }
}

# Enable restore grubenv service (bnc#892358)
# Restore grubenv settings for booting default entry to workaround the grub2-once cannot
# work and function properly on lvm, md and s390.
sub enable_restore_grubenv_service {

    my $systemctl="/usr/bin/systemctl";

    if (-x $systemctl) {
      system "$systemctl --no-reload enable grub2-once >/dev/null 2>&1";
    } 
}

$id_name = "";
if (@ARGV == 2 && ($ARGV[0] eq "--show-mapped")) {
    $show_mapped = 1;
    $id_name = $ARGV[1];
} elsif (@ARGV == 1) {
    $show_mapped = 0;
    $id_name = $ARGV[0];
} 

die "wrong command line options, try --help\n" if ($id_name eq "");

open(SYSCONF, "</etc/sysconfig/bootloader") || die "cannot read bootloader sysconfig: $!\n";

$grub2_dir = "";
while (<SYSCONF>) {
    if (/^#/) {
	next
    };
    if (/LOADER_TYPE="(.*)"/) {
        my $bl = $1; 
        if ($bl eq "grub2" || $bl eq "grub2-efi") {
            $grub2_dir = "/boot/grub2";
            $grub2_reboot = "/usr/sbin/grub2-reboot";
            $grub2_editenv = "/usr/bin/grub2-editenv";
        }
        last;
    }
}

close (SYSCONF);

if ($id_name eq "--help" or $id_name eq "-h")
  {
    print "Usage: grub2-once [--show-mapped ID | --list | ID | NAME_SUBSTRING ]\n";
    system "$grub2_reboot \"--help\"";
    exit 0;
  }

die "no grub2_dir" if ($grub2_dir eq "");

my $m = read_cfg( $grub2_dir, "grub.cfg");
# Note: only *one* top-level call to parse_menuentry() is possible
# or else it will start again with 0 (and no parent)!
parse_menuentry ("", "", $m);

my $ret = "";
my $name = "";
my $id = -1;

if ($id_name eq '--enum') {
    foreach my $e (@enumentry)  {
        printf "%-7s %s\n", $e->[1], $e->[0];
    }
    exit 0;
}

if ($id_name eq '--list')
  {
    my $c = 0;
    foreach my $e (@menuentry) 
      {
        printf "%6d %s\n", $c, $e;
	$c++;
      }
    exit 0;
  }

if ($id_name =~ m!^[0-9]+$!) {

    if ($id_name < @menuentry) {
        $id = $id_name;
        $name = $menuentry[$id];
        $ret = $name;
    }

} else {

    my $i = -1;
    my $c = 0;

    $name = $id_name;

    foreach my $e (@menuentry) {
        if ($e =~ qr!\Q$name\E!) {
            $i = $c;
            last;
        }
    } continue {
        ++$c;
    }

    if ($i >= 0) {
        $id = $i;
        $name = $menuentry[$id];
        $ret = "$id";
    }
}

if ($show_mapped > 0) {
    print $ret;
} else {
    system "$grub2_reboot \"$name\"";
    enable_restore_grubenv_service;
}