#!/usr/bin/perl -w
# $Id: elilo.pl,v 0.42 2011/11/25 17:07:26 rw Exp $
use strict;

my $C = $0; $C =~ s{^.*/}{};

my $dbg = (exists( $ENV{"ELILO_DEBUG"})) ? $ENV{"ELILO_DEBUG"} : "";
my $Edition = q(3.14-0.10.11.11);
my $Arch = q(i586);
my $LibD = q(/usr/lib);
my $MPold  = "$dbg/boot";
my $MPnew  = "$dbg/boot/efi";
my $Dlibold  = "$dbg$LibD/elilo";
my $Dlib     = "$dbg$LibD/efi";
my $Fconf = "elilo.conf";
my $Flist = "elilo.list";
my %Flist = ();
my $Sconf = "$dbg/etc/" . $Fconf;
my $Xconf = "xen.cfg";

my $Reserved = qr{(efi-mountpoint|vendor-directory|elilo-origin|precious|
		(?:y|e)bm-label)}ox;
my %Sconf = ();
my @Econf = ();
my %Xconf = ();
my @Xconf = ();
my %Labels = ();
my @Files = ();

my $keep = -1;
my $test = 0;
my $verbose = 0;
my $warn = 0;
my $optional = 1;
my $MP = "";		# Mount-Point for EFI/FAT partition
my $VD = "SuSE";	# vendor-specific directory in $MP/efi
my $D = "";		# will be $MP.$VD

my $Disclaimer = <<EoD;
# This file has been transformed by /sbin/elilo.
# Please do NOT edit here -- edit /etc/elilo.conf instead!
# Otherwise your changes will be lost e.g. during kernel-update.
#
EoD

$| = 1;

sub Version() {
  my $v = q($Revision: 0.42 $ );
  $v =~ s/^\$ Rev.*:\ ([0-9.]+)\ \$\ /$1/x;
  $v .= " (part of elilo-$Edition)" if ( $Edition ne "\@EDITION\@" );
  print "$C version $v\n";
  exit( 0 );
}
sub Info ($$) {
  print STDERR $_[1] if ( $verbose >= $_[0] );
}
sub Warn ($) {
  print STDERR "$C: Warning: $_[0]";
  $warn ++;
}
sub Panic ($$) {
  print STDERR "$C: $_[1]";
  exit( $_[0]) if ( $_[0] );
  $warn ++;
  print STDERR "...trying to proceed anyway!\n";
}
sub System($@) {
  my( $fatal, @C) = @_;
  my $cmd = $C[0];

  foreach my $c ( @C[1..$#C] ) {
    if ( $c =~ /[\s\\]/ ) {
      $cmd .= " '$c'";
    } else {
      $cmd .= " $c";
    }
  }
  Info( 1, "> $cmd\n");
  return 0 if ( $test );

  system @C;
  if ($? == -1) {
    Panic( $fatal, "$C[0]: failed to execute: $!\n");
  } elsif ($? & 127) {
    Panic( $fatal, sprintf( "$C[0]: died with signal %d, %s coredump\n",
           ($? & 127),  ($? & 128) ? 'with' : 'without'));
  } elsif ( $? >> 8 != 0 ) {
    Panic( $fatal, "$C[0]: failed\n");
  }
}
sub Rename($$$) {
  my( $loglvl, $oldname, $newname) = @_;
  Info( $loglvl, "> mv $oldname $newname\n");
  if ( -e $newname ) {
    Info( $loglvl+2, ">> unlink( $newname)\n");
    unlink( "$newname") unless ($test);
  }
  Info( $loglvl+2, ">> rename( $oldname, $newname)\n");
  rename( $oldname, $newname) unless ($test);
  # fixme: add failure-detection and handling?
}
sub Write($$$$@) {
  my( $loglvl, $msg, $mode, $file, @lines) = @_;
  my $tmp = ($mode ne ">>");
  my $out = ($tmp) ? "$file.tmp" : "$file";
  my $mstr = ($tmp) ? "create" : "append";
  my $fh;

  Info( $loglvl, $msg);
  if ( $test && $verbose >= $loglvl + 1 ) {
    Info( $loglvl, " STDOUT\n");
    open( $fh, ">&STDOUT");
  } elsif ( $test ) {
    Info( $loglvl, " nowhere\n");
    open( $fh, ">> /dev/null");
  } elsif ( ! open( $fh, "$mode $out") ) {
    Warn( "$out: failed to $mstr: $!\n");
    return 1;
  } else {
    Info( $loglvl, " '$out'\n");
  }

  print( $fh @lines) || Panic( 1, "$out: failed to write: $!\n");
  close( $fh);

  if ( ! $test && $mode ne ">>" ) {
    Rename( $loglvl, $out, $file);
  }
}
sub Merge($$) {
  my( $target, $source) = @_;
  my $in;
  my @l = ();

  Info( 2, "### check file list of previous installs:");
  if ( ! open( $in, "<  $source") ) {
    Warn( "could not open < '$source': $!\n");
    return 1;
  }
  while ( <$in> ) {
    chomp;
    next if (m{/} || exists( $Flist{$_}));
    push @l, "$_\n";
  }
  close( $in);
  if ( $#l < 0) {
    Info( 2, " none!\n");
  } else {
    my $n = $#l + 1;
    Info( 2, " $n missing\n");
    Write( 2, "### appending to", ">>", $target, @l);
  }
}
sub Install($$$$) {
  my( $f, $o, $s, $d) = @_;
  my @C = ( "install", $o, $s, $d);

  if ( $o eq "-p" ) {
    @C = ( "cp", "--preserve=timestamps", $s, $d);
  }
  System( $f, @C);
}
sub Parse($$) {
  my( $in, $verbosity) = @_;
  my $ov = $verbose;
  $verbose = ($verbosity < 0 ) ? $ov : $verbosity;

  $Sconf{xencfg} = 0;
  open( IN, "< $in") || Panic(1, "$in: failed to open: $!\n");
  Info( 1, "## parsing '$in'...\n");
  while ( <IN> ) {
    chomp;
    s{^##YaST - boot_efilabel =}{ybm-label=};
    if ( m/^$Reserved\s*(?:\=\s*(?|"([^"]+)"|([^"].*?)))?\s*$/xo ) {
      $Sconf{$1} = (defined($2)) ? $2 : "true";
    } elsif ( m/^(append|root|timeout)\s*=\s*(?|"([^"]+)"|([^"].*?))\s*$/xo ) {
      $Sconf{$1} = $2;
    } elsif ( m/^(default|prompt|relocatable)\s*(?:\=\s*(.+))?\s*$/xo ) {
      $Sconf{$1} = (defined($2)) ? $2 : "true";
    } elsif ( m/^(vmm)\s*\=\s*(?|"([^"]+)"|([^"].*?))\s*$/xo ) {
      my ($k, $v) = ($1, $2);
      next unless (defined( $v));
      $Sconf{$k} = $v;
      if ( $v =~ m/^(\S+.efi)(?:\s+(.*))?$/ ) {
	$Sconf{vmm} = $1;
	$Sconf{vmmopts} = (defined( $2) ? $2 : "");
	$Sconf{xencfg} = 1;
      } else {
	Info( 1, "$C: $in: $.: ignoring non-efi based VMM. ($Sconf{vmm})\n");
      }
    } elsif ( m/^image\s*=/ ) {
      last;
    } else {
      next;
    }
    Info( 3, ">>>  $1 = '$Sconf{$1}'\n");
  }
  my( $c, %f, $opt);
  my $default_label = "";
  my $default_loc;
  my $image = "";
  my %current = ();
  my %fp = ();
  $opt = $optional;
  seek( IN, 0, 0);
  while ( <IN> ) {
    if ( m/^\s*$Reserved\s*(?:\=\s*(.+))?\s*$/xo ) {
      $current{$1} = (defined($2)) ? $2 : "true";
      next;
    }
    if ( m{^\s*(?:image|initrd|vmm)\s*=\s*} ) {
      my $orig = $_;
      chomp;
      s{(vmm\s*=\s*)"([^"]+)"\s*(#.*)?$}{$1$2};
      s{^(\s*(image|initrd|vmm)\s*=\s*)(/\S+/)?([^/\s]+)\s*(.*?)\s*$}{$1$4};
      my( $k, $p, $f, $o) = ($2, $3, $4, $5);
      #Info( 0, "$C: $in: $.: k=$k p=$p f=$f\n");
      $_ .= "\n";
      if ( $k eq "image" ) {
	# new "image=" => finish up the previous one...
	$c += section2Econf( $in, $., %current);
	$c += section2Xconf( $in, $., %current) if (exists( $current{image}));
	%current = ();
      }
      if ( $k eq "vmm" && $f =~ m/\.efi$/ ) {
        $k = "VMM";
	$p = $Dlib . "/" unless (defined( $p));
	$p =~ s{^$dbg}{}o if ($dbg);
	$current{vmmopts} = $o;
	$current{xencfg} = $Sconf{xencfg} = 1;
      } elsif ( defined( $o) && $o ) {
	Warn( "$in: $.: ignoring trailing garbage...\n");
      }
      if ( ! defined( $p) ) {
	$p = "/boot/";
      }
      if ( ! defined( $f) ) {
	Warn( "$in: $.: invalid file-specification\n" .
	      ">> $orig");
	$c++;
      } elsif ( exists( $f{$f}) ) {
	if ( "$p$f" eq $fp{$f} ) {
	  Info( 4, "$in: $.: copy only once (previous: line $f{$f})\n" .
	        ">> $orig");
	} else {
	  Warn( "$in: $.: ambigous target '$f' (previous: $f{$f}: $fp{$f})\n" .
	        ">> $orig" . "=> first wins\n");
	}
	$current{$k} = $f;
	$current{"path2$k"} = $fp{$f};
      } else {
	my $fp = "$dbg$p$f";
	if ( -r $fp ) {
	  $current{$k} = $f;
	  $current{"path2$k"} = $fp;
	  push @Files, $fp;
	  $fp{$f} = $p . $f;
	  $f{$f} = $.;
	} elsif ( $opt ) {
	  Info( 0, "$C: Info: $in: $.: missing optional '$p$f' skipped\n");
	} else {
	  Warn( "$in: $.: missing '$p$f' skipped\n");
	}
      }
      next if ( $k eq "VMM" ); # omit efi-based "vmm" lines from elilo.conf!
    } elsif ( exists( $current{image}) &&
	      m{^(\s*description\s*=\s*)(?|"([^"]+)"|([^"].*?))\s*$}xo ) {
      my( $p, $d) = ($1, $2);
      my $image = $current{path2image};
      my $t = "";
      if ( $d =~ m{\%L} ) {
	if ( -l $image ) {
	  ($t = readlink( $image)) =~ s{^vmlinuz-}{};
	} else {
	  #($t = $image) =~ s{^.*vmlinux-}{};
	  $t = "no symlink";
	}
	Info( 2, "  \%L => '$t'\n");
	$d =~ s{\%L}{$t};
      } elsif ( $d =~ m{\%G} ) {
	my $cmd = "/sbin/get_kernel_version";
	if ( -x $cmd ) {
	  chomp( $t = `$cmd $image`);
	} else {
	  $t = "";
	}
	$d =~ s{\%G}{$t};
	Info( 2, "  \%G => '$t'\n");
      }
      $_ = $p . q{"} . $d . q{"} . "\n";
      $current{description} = $d;
    } elsif (m{^\s*(append|root)\s*=\s*(?|"([^"]+)"|([^"].*?))\s*$}xo ) {
      my( $k, $v) = ($1, $2);
      Info( 0, "$C: $in: $.: duplicate option (last wins)\n")
         if (exists( $current{$k}));
      $current{$k} = $v;
    } elsif (m{^(\s*label\s*=\s*)(\S+)}) {
      my ($pre, $label) = ($1, $2);
      $current{label_pre} = $pre;
      $current{label} = $label;
      $current{label_loc} = $#{$current{Econf}} + 1;
    } elsif (m{^\s*default\s*=\s*(\S+)}) {
      $default_label = $1;
      $default_loc = $#{$current{Econf}} + 1;
    } elsif (m{^\s*read-only\s*$}) {
      $_ = "#read-only # Deprecated!" .
	"  (Add comment in '$Sconf' to overrule.)" .
	"\n";
      Info( 2, "  $in: $.: deprecated 'read-only' ignored.\n");
    } elsif (m{^\s*relocatable\s*$} && $Arch =~ m{86}) {
      $_ = "#relocatable # Unsupported on this architecture!\n" .
	"#  (May be forced by adding a comment in '$Sconf'.)\n";
      Info( 2, "  $in: $.: unsupported 'relocatable' ignored.\n");
    }
    push @{$current{Econf}}, $_;
  }
  if ( exists( $current{image})) {
    $c += section2Econf( $in, $., %current);
    $c += section2Xconf( $in, $., %current);
  }
  if ($default_label ne "" && !exists $Labels{Econf}{$default_label}) {
    $Econf[$default_loc] = "#" . $Econf[$default_loc];
    Info( 0, "undefined default label '$default_label' discarded in $Fconf\n");
  }
  close( IN);
  $Sconf{'__warn-count'} = $c;

  Info( 2, "## end of $in\n") unless $test;
  $verbose = $ov;
}
sub Transfer ($$) {
  my( $in, $dir) = @_;
  my $c = $Sconf{'__warn-count'};

  if ( $Sconf{xencfg} ) {
    my $l = "global";
    my $k = "default";
    my %Xlabels = %{$Labels{Xconf}};
    push @Xconf, "[$l]\n";
    push @Xconf, "#" if (exists( $Sconf{$k}) &&
		     ! exists( $Xconf{$Sconf{$k}}{kernel}));
    push @Xconf, "$k=$Sconf{$k}\n" if (exists( $Sconf{$k}));
    foreach my $k ( ("time-out", "gfx-mode") ) {
      push @Xconf, "$k=$Sconf{$k}\n" if (exists( $Sconf{$k}));
    }
    push @Xconf, "\n";
    foreach my $l ( sort { $Xlabels{$a} <=> $Xlabels{$b} } keys %Xlabels ) {
      next unless (exists( $Xconf{$l}{kernel}));
      push @Xconf, "[$l]\n";
      foreach my $k ( sort( keys( %{ $Xconf{$l} })) ) {
        push @Xconf, "$k=$Xconf{$l}{$k}\n";
      }
      push @Xconf, "\n";
    }
  }

  foreach ( @Files ) {
    if ( ! -r $_ ) {
      Warn( "$_: not found\n");
      $c++;
    }
  }
  if ( $c ) {
    Panic( 2, "$in: broken references\n");
  }

  Output( $dir, $Fconf, @Econf);

  # create xen.cfg
  Output( $dir, $Xconf, @Xconf) if ( $Sconf{xencfg} );

  $Sconf{'__warn-count'} = $c;
}

my $labelc = 0;
sub mkLabel($$) {
  my( $label, $namespace) = @_;

  if (exists( $Labels{$namespace}{$label})) {
    my $t = 1;
    my $l = $label;
    while ( exists $Labels{$namespace}{$l} ) {
      $l = sprintf "%s.%d", $label, $t++;
    }
    Warn( "duplicate label '$label', replaced with '$l' in $namespace\n");
    $label = $l;
  }
  $Labels{$namespace}{$label} = ++$labelc;
  Info(4,"L($namespace)= ".join(", ",sort(keys(%{$Labels{$namespace}})))."\n");
  return $label;
}
sub section2Econf($$%) {
  my( $in, $lnr, %current) = @_;

  if ( $current{xencfg} && ! $current{precious} ) {
    Info( 3, "$in: $lnr: skipping $current{label} for $Fconf.\n");
    return( 0 );
  }
  if ( exists( $current{label}) ) {
    my $l = mkLabel( $current{label}, "Econf"); 
    if ( $l ne $current{label} ) {
      $current{Econf}[$current{label_loc}] = $current{label_pre} . $l ."\n";
    }
  }
  foreach my $l ( @{$current{Econf}} ) {
    push @Econf, $l;
  }
  return( 0 );
}
sub section2Xconf($$%) {
  my( $in, $lnr, %current) = @_;
  my( $label, $image, $initrd, $append, $root, $vmmopts);

  if ( ! $current{xencfg} ) {
    Info( 3, "$in: $lnr: skipping $current{label} for $Xconf.\n");
    return( 0 );
  }
  if ( ! exists( $current{image}) ) {
    Warn( "$in: $lnr: no image: incomplete section skipped\n");
    return( 1 );
  }
  if ( ! exists( $current{image}) || ! exists( $current{label}) ) {
    Warn( "$in: $lnr: incomplete section skipped\n");
    return( 1 );
  }

  $label = mkLabel( $current{label}, "Xconf");
  $image = $current{image};
  $initrd = (exists( $current{initrd}) ? $current{initrd} :
  	(exists( $Sconf{initrd}) ? $Sconf{initrd} : ""));
  $append = (exists( $current{append}) ? $current{append} :
  	(exists( $Sconf{append}) ? $Sconf{append} : ""));
  $vmmopts = (exists( $current{vmmopts}) ? $current{vmmopts} :
  	(exists( $Sconf{vmmopts}) ? $Sconf{vmmopts} : ""));
  $root = (exists( $current{root}) ? $current{root} :
  	(exists( $Sconf{root}) ? $Sconf{root} : ""));
  $root = ($root ? " root=$root " : " "); 
  
  if ( exists( $current{vmm}) ) {
    Info( 1, "$in: $lnr: legacy vmm ($current{vmm}) skipped for $Xconf.\n");
    return( 0 );
  }
  $Xconf{$label}{options} = $vmmopts;
  $Xconf{$label}{kernel} = $image . $root . $append;
  $Xconf{$label}{ramdisk} = $initrd if ( $initrd);
  return( 0 );
}
sub addList($) {
  my( $f) = @_;
  $f =~ s{^.*/([^/]+)$}{$1};
  print( LIST "$f\n") if ( fileno( LIST) );
  $Flist{$f} = $_[0];
}
sub Output($$@) {
  my( $dir, $file, @lines) = @_;
  my $out = "$dir/$file";

  if ( ! $test || $verbose > 3 ) {
    unshift @lines, $Disclaimer;
  }
  Write( 1, "## ... writing '$file' to", ">", $out, @lines);
  addList( $out);
}
sub Purge($) {
  my( $d) = @_; 

  if ( -r "$d/$Flist" ) {
    Info( 4, "## skip old removal of files from '$d'\n");
    return 0;
  }
  if ( $keep > 0) {
    Info( 1, "## skip removal of old files from '$d'\n");
    return 0;
  }
  Info( 1, "## remove old files from '$d'\n");
  my @F = glob( "$d/*");
  foreach my $f ( @F ) {
    next if ( $f !~ m{.*/(((vm|)linu(x|z)|initrd)(|[-.]\S+)|xen.cfg)$} );
    Info( 1, "> rm $f\n");
    unlink( $f) unless ($test);
  }
}

sub Obsolete($) {
  my( $d) = @_; 
  my $fh;
  my $F = "$d/$Flist";
  my $Fn = "$F.new";

  if ( $keep > 0 && -r $F ) {
    Info( 1, "## skip removal of obsolete files from '$d'\n");
    Merge( $Fn, $F);
  } elsif ( ! -r $F ) {
    Info( 2, "## no removal of obsolete files during migration\n");
  } else {
    my @obs = ();
    if ( ! open( $fh, "< $F") ) {
      Warn( "could not open '$F' for reading: $!\n");
    }
    while ( <$fh> ) {
      chomp;
      next if (m{/} || exists( $Flist{$_}));
      push @obs, $_;
    }
    close( $fh);
    Info( 1, "## remove obsolete files according to '$F'\n")
      if ( $#obs >= 0 );
    foreach ( @obs ) {
      Info( 1, "> rm $d/$_\n");
      unlink( "$d/$_") unless ($test);
    }
  }
  Info( 2, "## establish new file list in '$d'\n");
  Rename( 2, $Fn, $F);
}

sub InstallFPSWA($) {
  my ( $d) = @_;
  my $Dfpswa = $Dlib;

  $d .= "/efi/Intel Firmware";
  $Dfpswa = $Dlibold unless ( -r "$Dfpswa/fpswa.efi" );

  return 0 unless ( -r "$Dfpswa/fpswa.efi" );

  my $head = "## fpswa: Floating Point Software Assist\n";
  if ( -d $d && -r "$d/fpswa.efi" ) {
    # check, if we need to update and failing that do nothing?!
    my $c = "$Dfpswa/fpswa-cmp-version";
    if ( -x $c ) {
      my $chk = `$c "$d/fpswa.efi" "$Dfpswa/fpswa.efi"`;
      if ( $chk =~ /older/ ) {
	Info( 1, $head .
	      "##    Update '$d/fpswa.efi'.\n");
	Info( 2,
	      "##      $chk");
	Install( 0, "-p", "$Dfpswa/fpswa.efi", $d);
      } else {
	Info( 1, $head .
	      "##    Do NOT update '$d/fpswa.efi'.\n");
	Info( 2,
	      "##      $chk");
      }
    } else {
      use File::Compare;
      if ( compare( "$d/fpswa.efi", "$Dfpswa/fpswa.efi") == 0 ) {
	Info( 2, $head .
	      "##    Already installed.\n");
      } else {
	Info( 1, $head .
	      "##    Unable to compare versions.\n" .
	      "##      Installation skipped!\n");
      }
    }
  } else {
    Info( 1, $head . "##    Install 'fpswa.efi' to '$d'.\n");
    System( 0, "mkdir", $d) unless ( -d $d );
    Install( 0, "-p", "$Dfpswa/fpswa.efi", $d);
  }
}


sub isMounted($) {
  my ( $d) = @_;
  my @D  = stat( $d);
  my @P  = stat( $d . "/..");
  return( $D[0] != $P[0] ); 
}

sub MP($) {
  my ( $d) = @_;
  my @I = ("/proc/mounts", "/etc/mtab", "/etc/fstab");
  Info( 3, "### isMP($d):");
  foreach my $f ( @I ) {
    open( IN, "< $f") || next;
    while ( <IN> ) {
      chomp;
      next if ( m{^#} );
      my @F = split;
      if ( $F[1] eq $d ) {
	Info( 3, " found in '$f' line $. => true\n");
        close( IN);
        return( $F[0]);
      }
    }
    close( IN);
  }
  Info( 3, " not found in [" . join( ", ", @I) . "] => false\n");
  return( 0);
}

sub ebc($$$$) {
  my( $label, $dev, $part, $path) = @_;
  my @C = ("efibootmgr", "-v", "-wcL", $label,
		"-d", "$dev", "-p", $part, "-l", $path);
  my @out;

  my $cmd = $C[0];
  foreach my $c ( @C[1..$#C] ) {
    if ( $c =~ /[\s\\]/ ) {
      $cmd .= " '$c'";
    } else {
      $cmd .= " $c";
    }
  }
  Info( 1, "> $cmd\n");

  open( my $olderr, ">&STDERR") or die "Can't dup STDERR: $!\n";
  open( STDERR, ">/dev/null");
  open( EBM, "-|", @C) ;
  while (<EBM>) {
    chomp;
    push @out, $_;
  }
  close( EBM);
  open( STDERR, ">&", $olderr) or die "Can't restore STDERR: $!\n";
  return( @out );
}
sub ebr($) {
  my( $num) = @_;
  my @C = ("efibootmgr", "-q", "-B", "-b" , $num);

  $C[1] = "-v" if ( $verbose > 1 );
  System( 0, @C);
}
sub hwpEqual($$) {
  my( $s1, $s2) = @_;
  my $hex = qr{[0-9a-f]+}i;
  my $hexi = qr{[0-9a-f-]+}i;
  my @S1 = ($s1 =~ m{HD\(($hex),($hex),($hex),($hexi)\)}o);
  my @S2 = ($s2 =~ m{HD\(($hex),($hex),($hex),($hexi)\)}o);
  Info( 5, sprintf( "'%s' - '%s'\n", $S1[3],  $S2[3]));
  return( $s1 eq $s2 );
}
sub ebm($$$$);
sub ebm($$$$) {
  my( $label, $dev, $part, $path) = @_;
  my @C = ("efibootmgr", "-v", "-wcL", $label,
		"-d", "$dev", "-p", $part, "-l", $path);
  my @out;
  my $entry;

  if ( $test ) {
    System( 0, @C);
    return;
  }
  @out = ebc( $label, $dev, $part, $path);
  $entry = pop @out;
  $entry =~ m{^Boot([0-9A-Fa-f]{4})[\* ] (.*?)\s+((?:HD|ACPI).+)File(.+)$} ||
    Panic( 2, "parse error '$entry'\n");
  my ( $num, $lbl, $hwp, $file) = ($1, $2, $3, $4);
  Info( 1, "num=$num hwp=$hwp\n");

  foreach my $e ( @out) {
    $e =~ m{^Boot([0-9A-Fa-f]{4})[\* ] (.*?)\s+((?:HD|ACPI).+)File(.+)$} ||
	next;
    next unless ( hwpEqual( $hwp, $3) );
    if ( $file eq $4 ) {
      if ( $lbl eq $2 ) {
	# delete label with higher number
	my $n = ($num lt $1) ? $1 : $num;
	ebr( $n);
	$num = $1;
      }  else {
        # delete old/invalid label
        ebr( $1);
        if ( $num > $1 ) {
	  # now we have a hole!
	  ebr( $num);
	  ebm( $label, $dev, $part, $path);
	  return;
        }
      }
    }
  }
}

sub Refresh($) {
  my ( $device) = @_;
  my ($dev, $part, $path, $label, $ret);
  my ($elilo, $xen) = ("elilo.efi", "xen.efi"); # hardcoded for now!

  # device & partition
  if ( $device =~ m{^(.*)[-_]part(\d+)$} ) {
    $dev = $1;
    $part = $2;
  } elsif ( $device =~ m{^(.*/c\d+d\d+)p(\d+)$} ) {
    $dev = $1;
    $part = $2;
  } elsif ( $device =~ m{^(/dev/\D+)(\d+)$} ) {
    $dev = $1;
    $part = $2;
  } else {
    Panic( 2, "parse error on EFI partition $device.\n"); 
  }
  Info( 4, "dev=$dev, part=$part\n");
  # path
  $path = "\\efi\\$VD\\";
  Info( 4, "path=$path\n");
  # label
  if ( exists( $Sconf{'ebm-label'}) ) {
    $label = $Sconf{'ebm-label'};
  } elsif ( exists( $Sconf{'ybm-label'}) ) {
    $label = $Sconf{'ybm-label'};
  } else {
    $label = "Linux";
  }
  Info( 4, "label=$label\n");
  # create new entry for xen
  if ( $Sconf{xencfg} ) {
    $ret = ebm( "XEN ".$label, $dev, $part, $path . $xen);
  } 
  $ret = ebm( $label, $dev, $part, $path . $elilo);
}

my %Opt = ();
{
  use Getopt::Long;
  use Pod::Usage;
  $Getopt::Long::debug = 0;
  $Getopt::Long::ignorecase = 0;
  $Getopt::Long::bundling = 1;
  $Getopt::Long::passthrough = 0;

  pod2usage(2) unless ( GetOptions( \%Opt,
     'help|h', 'man|m', 'version|V', 'verbose|v+',
     'test|t', 'keep|k', 'purge|K', "refresh-EBM") &&
			( ! $Opt{'purge'} || ! $Opt{'keep'} ) &&
			! $Opt{'help'} );

  Version() if ( $Opt{'version'} );
  pod2usage(-exitstatus => 0, -verbose => 2) if ( $Opt{'man'} );
  pod2usage(1) if ( $Opt{'help'} );
  $test = 1 if ( $Opt{'test'} );
  $keep = 0 if ( $Opt{'purge'} );
  $keep = 1 if ( $Opt{'keep'} );
  $verbose += $Opt{'verbose'} if ( $Opt{'verbose'} );
}

# run-time init
if ( $Arch =~ m{ARCH} ) {
  chomp( $Arch = qx{uname -m});
  Info( 3, "### Arch: '$Arch'\n");
}
if ( $Dlib =~ m{LIBDIR} ) {
  $Dlib = "$dbg/usr/lib" . (($Arch eq "x86_64") ? "64/" : "/");
  $Dlibold = $Dlib . "elilo";
  $Dlib = $Dlib . "efi";
  $Dlib = $Dlibold if (! -r "$Dlib/elilo.efi" && -r "$Dlibold/elilo.efi");
  Info( 3, "### Dlib: '$Dlib'\n");
}

# try to read variables from $Sconf
Parse( $Sconf, ($Opt{'refresh-EBM'}) ? 0 : -1);

# check environment
if ( exists( $Sconf{"efi-mountpoint"}) ) {
  $MP = $dbg . $Sconf{"efi-mountpoint"};
  Panic( 2, "EFI partition specification in $Sconf invalid.\n")
     unless ( -d $MP );  # or is it "$MP/efi"?
} elsif ( -d $MPnew . "/efi/" . $VD || MP($MPnew) ) {
  $MP = $MPnew;
} elsif ( -d $MPold . "/efi/" . $VD ) {
  $MP = $MPold;
} else {
  Info( 1, "## Neither new ($MPnew/efi/$VD) nor old ($MPold/efi/$VD)?\n");
  Panic( 2, "EFI partition not found.\n");
}
Info( 2, "## Mount-point '$MP'...\n");

if ( $Opt{'refresh-EBM'} ) {
  Refresh( MP( $MP));
  exit 0;
}

if ( ! isMounted( $MP) ) {
  Panic( 2, "EFI partition (". MP( $MP) .") not mounted at $MP.\n");
}

if ( exists( $Sconf{"vendor-directory"}) ) {
  $VD = $Sconf{"vendor-directory"};
  Info( 1, "## Don't forget: '$VD != SuSE'--NVRAM (efibootmgr) issue!\n") 
     unless ( $VD eq "SuSE" );
}
if ( exists( $Sconf{"precious"}) && $keep < 0 ) {
  $keep = 1;
}

$D = $MP . "/efi/" . $VD;
Info( 2, "## output directory '$D'...\n");
System( 2, "mkdir", "-p", $D) unless ( -d $D );

if ( -r $Sconf ) {
  my $initializing = ( ! -r "$D/elilo.efi" && ! -r "$D/$Fconf" );
  if ( ! $test ) {
    open( LIST, "> $D/$Flist.new") ||
       Warn( "cannot open '$D/$Flist.new' for writing: $!\n");
  }
  # extract kernels, etc. and write fixed .conf
  Transfer( $Sconf, $D);
  # remove old files
  Purge( $D) unless ($initializing);
  # copy stuff 
  Info( 1, "## copy new files to '$D'\n");
  unshift @Files, "$Dlib/elilo.efi";
  foreach ( @Files ) {
    Install( 0, "-p", $_, $D);
    addList( $_);
  }
  close( LIST);
  # remove old files
  Obsolete( $D) unless ($initializing);
  # take care of FPSWA
  InstallFPSWA( $MP);
} elsif ( $MP eq $MPold && -r "$D/$Fconf" ) {
  # assume old setup with only '/vmlinuz' and '/initrd'
  Install( 2, "-p", "$Dlib/elilo.efi", $D);
  InstallFPSWA( $MP);
} elsif ( $MP eq $MPold ) {
  Panic( 2, "$D/$Fconf: not found\n");
} elsif ( ! -e $Sconf ) {
  Panic( 2, "$Sconf: not found\n");
} else {
  Panic( 2, "$Sconf: not readable\n");
}

if ( $warn > 0 ) {
  Panic( 1, sprintf("%d warning%s encountered.\n", $warn, ($warn==1)?"":"s"));
}
exit( 0);

__END__

=head1 NAME

elilo - Installer for the EFI Linux Loader

=head1 SYNOPSIS

/sbin/elilo [options]

 Options:
      --refresh-EBM     refresh EFI boot menu
   -k --keep            don't purge old files
   -t --test            test only
   -v --verbose         increase verbosity
   -h --help            brief help message
      --man             full documentation
   -V --version         display version

=head1 OPTIONS

=over 8

=item B<--refresh-EBM>

Recreate EFI boot manager menu entries based on information in
C</etc/elilo.conf>.

=item B<--test>

Test only. Do not really write anything, no new boot configuration nor
kernel/initrd images.
Use together with B<-v> to find out what B<elilo> is about to do.

=item B<--verbose>

Increase level of verbosity.

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--version>

Prints the version information and exits.

=back

=head1 DESCRIPTION

This program will perform all steps to transfer the
necessary parts to the appropriate locations...



=head1 LIMITATIONS

For now, I<all> image-entries are treated as "optional" in
order to more closely match the behavior of the real
loader (i.e. C<elilo.efi>), which silently ignores missing files
while reading the configuration.

This may be considered a bug by experienced B<LILO> users,
where only those specifically marked as such are treated that way.

It is planned to introduce keywords like C<mandatory> and C<optional>
in future releases though.

=head1 SEE ALSO

/usr/share/doc/packages/elilo

=cut
