#!/usr/bin/perl
##############################################################################################
# © Copyright 2000-2009 Hewlett-Packard Development Company, L.P
#
# This program is free software; you can redistribute it and/or modify it under the terms of 
# the GNU General Public License as published by the Free Software Foundation; either version 
# 2 of the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; 
# without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 
# See the GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along with this program; 
# if not, write to the Free Software Foundation, Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
##############################################################################################

# retrofit LinuxCOE 4.0 Bundles - leem@atl.hp.com
#
# To retrofit your system:
#  1) chmod +x retrofit (or whatever you named this file)
#  2) as root, run it with no arguments: # ./retrofit
#
# If you run this script with any argument, it won't install anything, but
#   will echo what it would have done.  Feel free to try this as a mortal user
#   to see what we're proposing.  Ex: '# ./retrofit LinuxRox'
#
# Here's what this script will attempt:
#  0)  Remove old LinuxCOE spcific RPMS if they exist
#  1) Send email with your MAC address for statistical purposes only!
#       - it's only your MAC, and we want to count unique installs...
#  2) Install APT, if it fails, create a rc snippet that will install it n
#      next boot.
#  3) Create /etc/opt/LinuxCOE/apt dir if it doesn't exist (owned by apt)
#  4) Create files for each requested coe_bundle in above dir
#  5) call Bundle installer to walk dir and install coe_bundles
#
# All our docs:  http://linuxcoe.corp.hp.com/documentation/
# Problems/Bugs: http://linuxcoe.corp.hp.com/sr/
#

# Create a logfile so we can help troubleshoot errors
my $log = "/var/log/LinuxCOE-retro.log";
open(LOG,">$log") ||  print STDERR "Cannot open $log : $!\n What's up with that? :)\n\n";

# Make everything hot, I'm forking...
select(LOG); $|=1;
select(STDOUT); $|=1;
select(STDERR); $|=1;

print LOG "Scroll down to ===START=== for the real action.\n";

# Load an %array of installed debs....
my %installed = &load_installed;

if ( $dont_do_it ) {
  print "Would have created APT/YUM breadcrumbs in /etc/opt/LinuxCOE/\n";
} else {
# LINUXCOE_PERL_HERE
}

# this %array created by /systemdesigner-cgi-bin/coe_retrofit
my %bundles = (

# REAL_DATA_HERE

);

# APT_DEPOTS_HERE

# Snatch the waystation they selected
#  note to self: do not name a valid bundle 'WaYsTaTiOn' ;p

my $waystation = $bundles{'WaYsTaTiOn'};
delete($bundles{'WaYsTaTiOn'}); # let's not load this one!

unless ( -d "/etc/opt/LinuxCOE" ) { system "/bin/mkdir -p /etc/opt/LinuxCOE" }
open(WAY,">/etc/opt/LinuxCOE/waystation");
print WAY "$waystation\n";
close(WAY);

print LOG " ===START=== \n";
print LOG "My Waystation is $waystation\n";

#
# main()  - here's the meat!
#

# Walk the default debs that are configured and install

print "\nLinuxCOE 4 post installation processing\n\n";
foreach $bundle (sort(keys(%bundles))) {
  &load_bundle($bundle,$bundles{$bundle},$waystation);
}

# final re-gen for re-retrofitz
my $syscall;
$syscall = "/opt/LinuxCOE/bin/configure_apt";
if ( $dont_do_it ) {
  print STDERR "I would have executed:\n\n$syscall\n\n";
} else {
  system $syscall;
}

my %coe_bundles = (
# COE_BUNDLES_HERE
);

my $ddir = 'apt';
foreach my $bundle (sort(keys(%coe_bundles))) {
  my $outfile = $bundle;
  $outfile =~ tr/a-zA-z0-9/_/cs;
  $outfile = "/etc/opt/LinuxCOE/$ddir/$outfile";
  if ( $dont_do_it ) {
    print STDERR "Would have created $outfile to install $bundle\n";
  } else {
    open(OUT,">$outfile") || die "Cannot open $outfile for writing : $!\n";
    print OUT "$bundle\n$coe_bundles{$bundle}\n";
    close(OUT);
  }
}
$syscall = "/opt/LinuxCOE/bin/install_bundles verbose";
if ( $dont_do_it ) {
  print STDERR "I would have executed:\n\n$syscall\n\n";
} else {
  system $syscall;
}


#
# End of main() - the rest is gravy...
#

sub load_bundle {

# Cycle through debs associated with this bundle, load as needed.

  my ($bundle,$files,$waystation) = @_;
  print LOG "Installing $bundle bundle from $waystation\n";
  print STDERR "Installing $bundle bundle from $waystation - ";
  my $test = $bundle;
  my $step = chop($test);
  my @needem;
  my @debs = split(' ',$files);

# Foreach deb, see if it's needed
  foreach $deb (@debs) {
    if ( &need_it($deb) ) { 
      print LOG " will install\n";
      push(@needem,$deb); 
    } else {
      print LOG " already got it\n";
    }
  }

# Do we need any?  If so, attempt to install them
  if (@needem) {
    my $line = join(" ",@needem);
    &load_debs($bundle,$line); 
  } else {
    print LOG "$bundle is installed or superseded...\n";
    print STDERR "already got it, continuing...\n";
  }

}

sub need_it {

# is the deb passed needed?

  my $deb = shift;
  # Rip off all the leading path cruft;
  my @data = split('/',$deb);
  $deb = pop(@data);        # grab the deb name sans path
  (@data) = split('\.',$deb);
  pop(@data); pop(@data);   # Get rid of .arch.deb
  my ($name,$ver) = &parse_deb(join('.',@data));
  print LOG "$name, comparing new $ver to installed $installed{$name}";
  if (( $ver gt $installed{$name} ) || ( ! $installed{$name} )) { return(1) }  # we need it!
  return;  # they got it!

}

sub parse_deb {

# ii  xlibs-data                 4.3.0.dfsg.1-8             X Window System client data

  my $data = shift(@_);
  if ( $data =~ /^ii / ) {
    my ($ii,$test,$ver,@rest) = split(' ',$data);
    return($test,$ver);
  } else {
    my @arr = split('-',$data);
    my ($test,@p);
    while ( $test = shift(@arr) ) {
      last if ( $test =~ /^[0-9]/ );
      push(@p,$test);
    }
    return(join('-',@p),join('-',$test,@arr));
  }

}

sub load_installed {

# Create the %array of installed debs.

 my %installed;
# Make the screen 'wide' so package names don't get truncated
  my $cols = $ENV{'COLUMNS'};
  $ENV{'COLUMNS'} = 500;
  open(IN,"/usr/bin/dpkg -l |") ||
    die "Cannot fork dpkg : $!\n";
  while(<IN>) {
    next unless /^ii/;
    chomp;
    my ($product,$rev) = &parse_deb($_);
    $installed{$product} = $rev;
    print LOG "Found installed product $product - $rev\n";
  }
  #$ENV{'COLUMNS'} = $cols;
  return(%installed);

}

sub make_snippet {

# Create a /etc/rc.d/init.d snippet to try again next reboot  # BUG!

  ($bundle,$debs) = @_;
  my @debnames;
  my @deblist = split(' ',$debs);
  chdir "/tmp";
  open(RC,">/etc/init.d/LinuxCOE-$bundle");
  print RC "#!/bin/sh\nchdir /tmp\n";
  foreach my $url (@deblist) {

# Fetch each deb locally

    my @data = split("/",$url);
    $debnames .= pop(@data) . " ";
    print RC qq[system "/usr/bin/wget $url >>/tmp/coe_wget.log 2>&1"\n];
  }
  print RC qq{/usr/bin/dpkg -i $debnames
if [ \$? -eq 0 ]
then
  /bin/rm /etc/rc*.d/*LinuxCOE-$bundle
  /bin/rm /etc/init.d/LinuxCOE-$bundle
  [ -x /etc/init.d/LinuxCOE-Bundles ] && /etc/init.d/LinuxCOE-Bundles start
else
  /bin/rm $debnames
fi
};
system "/bin/chmod +x /etc/init.d/LinuxCOE-$bundle";
system "/bin/ln -s /etc/init.d/LinuxCOE-$bundle /etc/rc2.d/S99LinuxCOE-$bundle";
system "/bin/ln -s /etc/init.d/LinuxCOE-$bundle /etc/rc3.d/S99LinuxCOE-$bundle";
system "/bin/ln -s /etc/init.d/LinuxCOE-$bundle /etc/rc4.d/S99LinuxCOE-$bundle";
system "/bin/ln -s /etc/init.d/LinuxCOE-$bundle /etc/rc5.d/S99LinuxCOE-$bundle";

}

sub load_debs {

# Attempt to install the debs passed via HTTP

  my ($bundle,$line) = @_;
  my @urls = split(' ',$line);
  my $debs;
  foreach $url (@urls) {
    system "/usr/bin/wget $url >>${log}.dpkglog 2>&1";        # Fetch the debs
    my @data = split('/',$url);
    my $deb = pop(@data);   # grab the filename
    $debs .= " $deb";
  }  
  my $syscall = "/usr/bin/dpkg -i $debs >>${log}.dpkglog 2>&1";
  print LOG "Installing $bundle with:\n ";
  print LOG "$syscall";
  system $syscall;
  if ( $? != 0 ) {
    print LOG " $bundle failed, making rc.d snippet, will retry on next boot.\n";
    &make_snippet($bundle,$line,$debs);
    print STDERR " failed \n";
  } else {
    print STDERR " ok!\n";
  }
  system "/bin/rm $debs";		# Remove the files

}

sub Remove_Old {

  if ( $dont_do_it ) {
     print "Would have removed OLD LinuxCOE-specific config stuff\n";
     return;
  }

  # Get rid of old configuration breadcrumbs (just in case)

  my @dirs = qw(/etc/opt/LinuxCOE/apt.sources /etc/opt/LinuxCOE/yum.sources);
  foreach my $dir (@dirs) {
    next unless ( -d $dir );
    open(DIR,"$dir") || die "Cannot open $dir : $!\n";
    my @files = sort(readdir(DIR));
    closedir(DIR);
    shift(@files); shift(@files);  # Toss . and ..
    foreach my $file (@files) {
      unlink "$dir/$file";
    }
  }

}

