#! /usr/bin/perl -w
# /usr/sbin/dphys-admin - install/upgrade packages
# authors dsbg and franklin, last modification 2004.07.30
#
# intended for calling by  init  at boot time and by  cron  daily at 06:00
#   first parameter ($ARGV[0]) is "init" or "cron" or "" depending on caller
#
# controlled by /var/lib/$name/pkglist
#   # blah blah: comment, don't do anything, same for empty line
#   ? blah blah: write this text out to user
#   | cmd param param: execute this command by an shell (pipe)
#   - pack1 pack2: delete packages (subtract)
#   * pack1 pack2: delete packages with --purge (splat, squash)
#   + pack1 pack2: install packages (add)
#   ! pack1 pack2: install packages even if already inst (force, early upgrade)
#   < input pack1 pack2: install packages with  yes input  (stdin)
#   pack1 pack2: install packages (old syntax for +, deprecated)
#
# we originally used an site package with an large Depends: list
#   unfortunately apt-get loads stuff in an unpredictable row
#   this lead to conflicts where packages did not find stuff they needed
#   Predepends: was not reliable either, when we need something configured


# --- get ready to work

# sanitise this place, else ssh rsh-style non-logins fail in dpkg
$ENV{PATH} = "/sbin:/bin:/usr/sbin:/usr/bin";

# package name, for config files, subdirectories and file names
my $name = "dphys-admin";


# --- set user config

# our package list(s) server
#   don't use "my" here, else the  require;  below fails to access these
$conf_baseurl = "http://not-configured-server/not/configured";

# address to send error/warning/log/info Mails to
#   this is needed because this program usually runs unattended
#   this is in '' and not "", because perl dislikes an @ in strings
$conf_mailaddress = 'root@localhost';

# separate user config file, preferrably set stuff in this
#   first try Debian typical place, then more general place
$conffile = "/etc/" . $name;
$dconffile = "/etc/default/" . $name;
if ( -f $conffile) {
  require $conffile; }
if ( -f $dconffile) {
  require $dconffile; }


# --- what files to use

# from where in packages list server
my $hostname = `hostname`;
chomp $hostname;
# file with our pre main (host dependant) package list
my $prepkgurl   = "$conf_baseurl/hostconfig/$hostname/host.pre.pkglist";
# file with our main (host independant) package list
my $mainpkgurl  = "$conf_baseurl/main.pkglist";
# file with our post main (host dependant) package list
my $postpkgurl  = "$conf_baseurl/hostconfig/$hostname/host.post.pkglist";


# to where in filesystem
my $pkglistdir  = "/var/lib/" . $name;
my $prepkgpath  = $pkglistdir . "/host.pre.pkglist";
my $mainpkgpath = $pkglistdir . "/main.pkglist";
my $postpkgpath = $pkglistdir . "/host.post.pkglist";

# for merging the 3 above files
# old merged name, only for "tidy up" test/unlink
my $mergedpkgpath = $pkglistdir . "/merged.pkglist";
# revert to old name for consistency filename to var names and error messages
my $pkgpath = $pkglistdir . "/pkglist";


# logging stuff, as this program runs unattended
my $logdir = "/var/log/";

# log to an separate session file, mail that off, then add to collected file
#   this prevents old failled sessions from disturbing analysis of new session
# session logfile for mailing
my $logpath = $logdir . $name . ".session.log";
# no logswitching to backup, old log file only for "tidy up" test/unlink
my $baklogpath = $logdir . $name . ".log.bak";
# collected logfile, to also analyse it later, possibly use logrotate on this
my $colllogpath = $logdir . $name . ".log";


# flag file, any script can  touch  and so demand an reboot
#   reboot must be done after  apt-get  and  postinst  else we are screwed
my $need_reboot = "/root/NEED-REBOOT";
my $need_mail = "/root/NEED-REBOOT-MAIL";

# flag file, any script can  cat >>  and so demand an script
#   script run is intended for stuff after  apt-get  and  postinst
#   usually because this stuff wants to use the debconf database itsself
my $need_script = "/root/NEED-SCRIPT";


# --- parse command line parameters, set operating mode

# by who are we being called, cron or init
my $called_by = $ARGV[0];

# user forgot or did not know to enter mode, or is simply testing
if (! defined $called_by) {
  print("$0: WARNING: no mode (init or cron) given, defaulting to 'none'\n");
  $called_by = "none"; }

if ($called_by ne "init" && $called_by ne "cron" && $called_by ne "none") {
  print("$0: ERROR: unknown mode $called_by, bailing out ...\n");
  exit (1); }


# --- start logging

# begin output, better for processing and recognizing trouble
print("$0 is updating the software collection ...\n");

# delete an possible left over old style backup logfile
#   done here and not in installing postinst script
#     to avoid scattered replicated pathnames, and changes getting forgotten
if ( -f $baklogpath) {
  unlink $baklogpath; }

# first announce the start of this run
#   reset the session log file to nothing, for this first log line
#   for all others then add to the file, else it would not be a log
open(LOGPATH, ">$logpath");
print LOGPATH "@@@ $0 $called_by started: " . `/bin/date -R` ."\n";
close(LOGPATH);


# --- spread package server load

# avoid load peak on the package server from over 100 machines at same time
#   delay cron jobs of various machines up to 1 hour, do not affect init jobs
#   therefore we random wait for 0..3599 seconds before working
if ($called_by eq "cron") {
  print("waiting for our time slot (0-3599s) ...\n");
  sleep int(rand(3600));
  print(" done\n");

  open(LOGPATH, ">$logpath");
  print LOGPATH "@@@ load spreading waited to: " . `/bin/date -R` ."\n";
  close(LOGPATH); }


# --- tidy up from previous runs

# we are booting, reboot has been done, we will not need to do it any more
#   this may be due to admin rebooting, user reset, power faillure, ...
#   so kill any open reboot requests, in case one was not deleted
# done here and not in init.d script to avoid scattered duplicate filename defs
if ($called_by eq "init") {
  if (-f $need_reboot) {
    print("$0: WARNING: deleting stray $need_reboot flag file ...\n");
    open(LOGPATH, ">>$logpath");
    print LOGPATH "@@@ stray $need_reboot deleted: " . `/bin/date -R` . "\n";
    close(LOGPATH);
    unlink $need_reboot; }

  if (-f $need_mail) {
    print("$0: WARNING: deleting stray $need_mail flag file ...\n");
    open(LOGPATH, ">>$logpath");
    print LOGPATH "@@@ stray $need_mail deleted: " . `/bin/date -R` . "\n";
    close(LOGPATH);
    unlink $need_mail; } }


# --- update apt package database

# update package database first, so that we also can see new packages
print("updating package database ...\n");
open(LOGPATH, ">>$logpath");
print LOGPATH "@@@ package database update: " . `/bin/date -R` . "\n";
close(LOGPATH);
system("/usr/bin/nice /usr/bin/yes ''" .
  " | /usr/bin/apt-get update >>$logpath 2>>$logpath\n");
system("/usr/bin/apt-cache dumpavail > /var/cache/apt/available\n");
system("/usr/bin/dpkg --update-avail /var/cache/apt/available" .
  " >>$logpath 2>>$logpath\n");
unlink "/var/cache/apt/available";


# --- update package list

# fetch package list
print("fetching package list ...\n");
open(LOGPATH, ">>$logpath");
print LOGPATH "@@@ wget package list: " . `/bin/date -R` . "\n";
close(LOGPATH);

# CVS keeps on deleting our empty directory, so we (re-)create it from here
if (! -d "$pkglistdir") {
  if (-e "$pkglistdir") {
    unlink "$pkglistdir"; }
  mkdir "$pkglistdir", 0700; }

# delete an possible left over old name merged.pkglist file
#   done here and not in installing postinst script
#     to avoid scattered replicated pathnames, and changes getting forgotten
if ( -f $mergedpkgpath) {
  unlink $mergedpkgpath; }

# check for valid URL of package list server
if ((system("/usr/bin/wget -q -O /dev/null $conf_baseurl\n") >> 8) != 0) {
  # invalid base URL, can not fetch files from there
  print("$0: ERROR: invalid base URL $conf_baseurl, bailing out ...\n");
  # log this error so that we know it
  open(LOGPATH, ">>$logpath");
  print LOGPATH "@@@ ERROR: invalid base URL $conf_baseurl: " .
    `/bin/date -R` . "\n";
  close(LOGPATH);

  # warn the admin if we can
  my $mail_subject = "$0 $called_by ERROR invalid URL on " . `hostname`;
  open(MAIL, "|/usr/bin/mail -s \"$mail_subject\" $conf_mailaddress");
  print MAIL "$0 given invalid base URL $conf_baseurl\n";
  close(MAIL);

  # add the logfile to the collected log, so not lost because of abort
  collect_log();
  # and bail out
  exit (1); }

# fetch the possibly updated package lists
if (-x "/usr/bin/wget") {
  system("/usr/bin/wget -O $prepkgpath  $prepkgurl " .
    " >>$logpath 2>>$logpath\n");
  system("/usr/bin/wget -O $mainpkgpath $mainpkgurl" .
    " >>$logpath 2>>$logpath\n");
  system("/usr/bin/wget -O $postpkgpath $postpkgurl" .
    " >>$logpath 2>>$logpath\n"); }

# merge pre|main|post package lists
if (-f $prepkgpath || -f $mainpkgpath || -f $postpkgpath) {
  open(PKGPATH, ">$pkgpath");
  if (-f $prepkgpath) {
    open(PREPKGPATH, "<$prepkgpath");
    print PKGPATH while <PREPKGPATH>;
    close(PREPKGPATH); }
  if (-f $mainpkgpath) {
    open(MAINPKGPATH, "<$mainpkgpath");
    print PKGPATH while <MAINPKGPATH>;
    close(MAINPKGPATH); }
  if (-f $postpkgpath) {
    open(POSTPKGPATH, "<$postpkgpath");
    print PKGPATH while <POSTPKGPATH>;
    close(POSTPKGPATH); }
  close(PKGPATH); }

if (! -f $pkgpath || -z $pkgpath) {
  # package list never (so also not now) fetched, or empty, so we can not work
  print("$0: ERROR: no or empty $pkgpath package list, bailing out ...\n");
  # log this error so that we know it
  open(LOGPATH, ">>$logpath");
  print LOGPATH "@@@ ERROR: missing or empty package list: " .
    `/bin/date -R` . "\n";
  close(LOGPATH);

  # warn the admin if we can
  my $mail_subject = "$0 $called_by ERROR no pkglist on " . `hostname`;
  open(MAIL, "|/usr/bin/mail -s \"$mail_subject\" $conf_mailaddress");
  print MAIL "$0 found no (or empty) $pkgpath\n";
  close(MAIL);

  # add the logfile to the collected log, so not lost because of abort
  collect_log();
  # and bail out
  exit (1); }


# --- collect already installed stuff, to later eliminate it from installing

my %installed;
open(DPKGGETSEL, "dpkg --get-selections|");

while (<DPKGGETSEL>) {

  my $package;
  my $state;
  chomp;
  ($package, $state) = split;
  $installed{$package} = $state; }

close(DPKGGETSEL);


# --- do the actual install work

# evaluate package list and load/eliminate packages
print("installing or removing packages in $pkgpath ...\n");
open(LOGPATH, ">>$logpath");
print LOGPATH "@@@ install/remove: " . `/bin/date -R` . "\n";
close(LOGPATH);
open(PKGLIST, "<$pkgpath") or die "Can't open $pkgpath";

while (<PKGLIST>) {

  chomp;


  # eliminate blanks at begin and end of line
  s/^\s+(.*)s+$/$1/;

  # empty line, ignore
  if (/^$/) {
    next; }


  # get first character, which says what to do with this line
  m/^(.)(.*)$/;


  #  #  = comment line, ignore
  if ($1 eq "\043") {
    next; }


  #  ?  = tell user what is happening, print it out
  elsif ($1 eq "?") {

    # first newline to terminate line of progress log lines
    print "?\n$2\n"; }


  #  |  = execute (pipe) of any random command
  elsif ($1 eq "|") {

    # first newline to terminate line of progress log lines
    print "|\n";
    system("$2\n"); }


  #  -  = uninstall (subtract) some packages
  #  *  = destroy ("splat", squashed insect) some packages
  elsif ($1 eq "-" || $1 eq "*") {

    my $operation;
    my $dpkg_opt;
    my $packages;
    $operation = $1;
    if ($1 eq "-") {
      $dpkg_opt = "--remove"; }
    else {
      $dpkg_opt = "--purge"; }
    $packages = $2;

    # do not remove stuff that is not installed, to save time an error messages
    # split list of $packages, one per line ...
    my @packages;
    @packages = split(/\s+/, $packages);
    # ... elliminate the not installed ones ...
    foreach $package (@packages) {
      if (! exists $installed{$package}) {
        $package = ""; } }
    # ... and put the remaining back together
    $packages = join (" ", @packages);
    # elliminate leading spaces (= all spaces if nothing left, -> empty)
    $packages =~ s/^\s+//;
    # if no packages now empty string -> nothing to remove
    if ($packages eq "") {
      next; }

    system("/usr/bin/nice /usr/bin/yes ''" .
      " | /usr/bin/dpkg $dpkg_opt $packages >>$logpath 2>>$logpath\n");
    print $operation; }


  #  +  = install (add) some packages
  #  !  = install ("yes", "really"), even if already installed (early upgrade)
  #  <  = input ("stdin") install some packages with stdin input provided
  #     = also normal install, old syntax

  else {

    my $operation;
    my $input;
    my $packages;
    $operation = $1; 
    if ($1 eq "+") {
      $input = ""; $packages = $2; }
    elsif ($1 eq "!") {
      $input = ""; $packages = $2; }
    elsif ($1 eq "<") {
      # split into first character, and first word, and rest of line
      m/^(.) ([^ ]*) (.*)$/;
      $input = "$2"; $packages = $3; }
    else {
      # some other charakter, so line may be just package name(s), treat as +
      $operation = "+";
      $input = ""; $packages = $_; }

    # unless forced install for forcing early upgrade, before rest upgraded
    #   do not install stuff that is already installed, to save time
    if ($operation eq "+" || $operation eq "<") {
      # split list of $packages, one per line ...
      my @packages;
      @packages = split(/\s+/, $packages);
      # ... elliminate the already installed ones ...
      foreach $package (@packages) {
        if (exists $installed{$package}) {
          $package = ""; } }
      # ... and put the remaining back together
      $packages = join (" ", @packages);
      # elliminate leading spaces (= all spaces if nothing left, -> empty)
      $packages =~ s/^\s+//;
      # if no packages now empty string -> nothing to install
      if ($packages eq "") {
        next; } }

    system("/usr/bin/nice /usr/bin/yes '$input'" .
      " | /usr/bin/apt-get install $packages >>$logpath 2>>$logpath\n");
    print $operation; }

  test_need_script("install");
  test_need_reboot("install"); }


# finish off all the progress log lines
print "\n";

close(PKGLIST);


# --- upgrade the already installed packages

# is after install/remove/purge, so we do not upgrade "vanishing" packages
print("dist upgrading existing packages ...\n");
open(LOGPATH, ">>$logpath");
print LOGPATH "@@@ apt-get dist-upgrade: " . `/bin/date -R` . "\n";
close(LOGPATH);
system("/usr/bin/nice /usr/bin/yes ''" .
  " | /usr/bin/apt-get dist-upgrade >>$logpath 2>>$logpath\n");

test_need_script("update");
test_need_reboot("update");


# --- warn admin if some package wanted reboot and was ignored

test_need_mail();


# --- apt-get clean to free disk space, unlikely to re-install, and we have LAN

# is after upgrade, so nothing added after cleaning
print("cleaning apt cache ...\n");
open(LOGPATH, ">>$logpath");
print LOGPATH "@@@ apt-get clean: " . `/bin/date -R` . "\n";
close(LOGPATH);
system("/usr/bin/nice /usr/bin/yes ''" .
  " | /usr/bin/apt-get clean >>$logpath 2>>$logpath\n");


# --- final logging

# tell waiting user that we are finished
print("\n$0 is done with upgrading software collection\n");

# and log to file that we are finished
open(LOGPATH, ">>$logpath");
print LOGPATH "@@@ $0 $called_by ended: " . `/bin/date -R` . "\n";
close(LOGPATH);

# and also mail log to admin that we are finished
my $mail_subject = "$0 $called_by INFO has run on " . `hostname`;
open(MAIL, "|/usr/bin/mail -s \"$mail_subject\" $conf_mailaddress");
open(LOGPATH, "<$logpath");
print MAIL while <LOGPATH>;
close(LOGPATH);
close(MAIL);

collect_log();

exit(0);


# --- subroutines

sub test_need_script {

  local($act) = @_;

  # if one or more of the packages wants a script run
  #   it will install, or more likely generate, this file containing command(s)
  if (! -f $need_script) {
    return; }

  open(LOGPATH, ">>$logpath");
  print LOGPATH "@@@ $act need script(s): " . `/bin/date -R` . "\n";
  close(LOGPATH);

  # first newline to terminate line of progress log lines
  print "\n";

  open(NEEDSCRIPT, "<$need_script") or die "Can't open $need_script";
  while ($script = <NEEDSCRIPT>) {
    system($script); }
  close(NEEDSCRIPT);

  unlink $need_script; }


sub test_need_reboot {

  local($act) = @_;

  # if one or more of the packages installed/upgraded wants a reboot
  #   it will install, or more likely generate, this flag file to tell us so
  if (! -f $need_reboot) {
    return; }

  if ($called_by eq "init") {
    # we is booting anyway, so no user in the middle of working
    #   we can reboot immediately without any question
    open(LOGPATH, ">>$logpath");
    print LOGPATH "@@@ $act need reboot: " . `/bin/date -R` . "\n";
    close(LOGPATH);

    # add logfile to the collected log, so not lost after restart/continue
    collect_log();

    # we are rebooting now, so no need to do it any more, delete flag file
    unlink $need_reboot;

    # /sbin/reboot only sends signal, then returns
    system("/sbin/reboot\n");
    # prevent further action before reboot, resulting in partial install
    exit (0); }

  else {
    # nightly cron job run, so perhaps a user is working
    #   we are not allowed to reboot, as this would interrupt work
    # so no reboot, need reboot file not deleted, later test for this and mail
    #   for now just log that it would have happend, for each occurance
    open(LOGPATH, ">>$logpath");
    print LOGPATH "@@@ $act need reboot *ignored*: " . `/bin/date -R` . "\n";
    close(LOGPATH);

    # we need to send an warning mail to get an user/admin to reboot, flag this
    open(NEEDMAIL, ">$need_mail");
    close(NEEDMAIL);

    # we have logged need, so no need to do it any more, delete flag file
    unlink $need_reboot; } }


sub test_need_mail {

  # if reboot was not done (and flag file renamed instead of deleted)
  if (! -f $need_mail) {
    return; }

  # this will catch this case and mail the admin for help
  open(LOGPATH, ">>$logpath");
  print LOGPATH "@@@ need reboot *mailed*: " . `/bin/date -R` . "\n";
  close(LOGPATH);

  my $mail_subject = "$0 $called_by WARNING need reboot on " . `hostname`;
  open(MAIL, "|/usr/bin/mail -s \"$mail_subject\" $conf_mailaddress");
  print MAIL "$0 has made an $need_reboot file, not rebooted\n";
  close(MAIL);

  # sent the mail, so no need to do it any more, delete flag file
  unlink $need_mail; }


sub collect_log {

  # add this sessions logfile to the collected log file
  #   the collected log file will be shortened by user or logrotate

  open(COLLLOGPATH, ">>$colllogpath");

  # separator between log sessions
  print COLLLOGPATH "\n";
  print COLLLOGPATH "------ session ------\n";
  print COLLLOGPATH "\n";

  open(LOGPATH, "<$logpath");
  print COLLLOGPATH while <LOGPATH>;
  close(LOGPATH);

  close(COLLLOGPATH); }