#!/usr/bin/perl -w
# /usr/sbin/dphys-admin - install/upgrade packages
# authors dsbg and franklin, last modification 2006.11.23
# copyright ETH Zuerich Physics Departement
#   use under either modified/non-advertising BSD or GPL license
#
# 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 /etc/dphys-admin.list, format is:
#
#   ? blah blah: write this text out to user ("whats up?")
#   | cmd param param: execute this command by an shell ("pipe")
#   - pack1 pack2: delete packages ("subtract")
#   * pack1 pack2: delete packages with --purge ("splat", squash like insect)
#       also gets rid of config files that are not wanted any more
#   + pack1 pack2: install packages ("add")
#   ! pack1 pack2: install packages even if already inst ("yes really!")
#       may be used for early upgrade or reload of an package
#   < input pack1 pack2: install packages with  input  ("stdin")
#       space-less string  input  is repeated on stdin for each wanted line
#       may be used to input  yes  to an broken package that asks questions
#   pack1 pack2: install packages (old syntax for +, deprecated)
#
#   anything behind an # is a comment, ignore it and the # sign
#     same applies for empty lines, both are simply discarded
#
# we originally used an site description package, with an large Depends: list
#   and this loading config packages which set up stuff from postinst scripts
#   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
#   se we need to set off multiple apt-get calls, in controlled sequence


### ------ configuration for this site

# don't use "my" here, else the  require;  below fails to access these

# list file telling us what to install or remove
$conf_listfile = "/etc/dphys-admin.list";

# address to send error/warning/note/info/log mails to
#   this is needed because this program usually runs unattended
#   this is in '' and not "", because perl dislikes an @ in "" strings
#   setting this to '' with nothing in it disables mailing
$conf_mailaddress = 'root@localhost';


### ------ actual implementation from here on
# no user settings any more below this point


# --- get ready to work

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


# --- config file stuff

# what we are
my $name = "dphys-admin";
my $pname = "dphys-admin";

# check user config file(s), let user override settings
if (-f "/etc/$pname") {
  require "/etc/$pname"; }


# --- what files to use

# logging output and errors, as this program usually 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/$pname.session.log";
# collected logfile, to also analyse it later, possibly use logrotate on this
my $colllogpath = "$logdir/$pname.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: NOTE: 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


# log a line, with time stamp, so we know when something happened
sub log_with_time {

  # $text contains text to log
  local($text) = @_;

  my $date = `date -R`;
  open(LOGPATH, ">>", $logpath);
  # bigbrother tests this line, don't change format, or also change there
  print LOGPATH "@@@ $text: $date\n";
  close(LOGPATH); }


# add this sessions log to the collected log file, call this at abort or end
#   the collected log file will be shortened by the user/admin or logrotate
sub collect_log {

  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); }


# 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
unlink $logpath;


# begin output, announce the start of this run
#   better for processing and recognizing trouble
print("$0 is updating the software collection ...\n");
log_with_time("$0 $called_by started");


# --- 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");
  log_with_time("load spreading waiting at");

  sleep int(rand(3600));

  print(" done\n");
  log_with_time("load spreading waited to"); }


# --- test and possibly handle $need_reboot und $need_mail files

sub test_need_reboot {

  # $act contains text "install" or "update", only used for log output
  local($act) = @_;

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

  if ($called_by eq "init") {
    # we are booting anyway, so no user in the middle of working
    #   we can therefore reboot immediately without any questions
    print("$0: rebooting due to $act ...\n");
    log_with_time("$act needs reboot");
    # add logfile to the collected log, so not lost after restart/continue
    collect_log();

    # we are rebooting now, so delete the flag file
    unlink $need_reboot;
    # reboot only sends an signal to process 1, then returns
    system("reboot");

    # prevent further action before reboot, resulting in partial installs
    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
    print("$0: ignoring rebooting due to $act ...\n");
    log_with_time("$act needs reboot, but *ignored*");

    # we have logged need, dont want log for every package, delete flag file
    #   but need to send warning mail to admin for reboot, so convert flag file
    rename $need_reboot, $need_mail; } }


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
  print("$0: maining reboot request ...\n");
  # bigbrother tests this line, don't change format, or also change there
  log_with_time("needs reboot *mailed*");

  # warn the admin about the missing reboot, if we can
  if ($conf_mailaddress ne "") {
    my $host = `hostname`;
    my $mail_subject = "$0 $called_by WARNING need reboot on $host";
    open(MAIL, "|-", "mail -s \"$mail_subject\" \"$conf_mailaddress\"");
    print MAIL "$0 has made an $need_reboot file, but not rebooted\n";
    close(MAIL); }

  # we have sent the mail, so no need to do it any more, delete flag file
  #   but need to restore reboot flag, so admin can see outstanding reboots
  #   so convert flag file back, will be deleted when (re)boot runs dphys-admin
  rename $need_mail, $need_reboot; }


# --- tidy up flag files from previous runs

if (-f $need_mail) {
  # there is a $need_mail file left over, not re-converted back to $need_reboot
  #   this should have been handled at the end of the last run
  #     so most likely something went wrong, retry to send the delayed mail
  # converts $need_mail into $need_reboot, so handle this first

  print("$0: NOTE: stray $need_mail flag file, processing ...\n");
  log_with_time("stray $need_mail needed processing");
  # file exists, call this just for generating the mail
  test_need_mail(); }


if (-f $need_reboot) {

  # there is a $need_reboot file left over, not deleted, possibly not acted on
  #   this may be above $need_mail file that has just been converted

  if ($called_by eq "init") {

    # we are booting, reboot has been done, we will not need to do it any more
    #   may be due to admin actually rebooting, user reset, power faillure, ...
    #   so kill any pending and not deleted reboot requests, they are now stale

    print("$0: NOTE: stray $need_reboot flag file, deleting ...\n");
    log_with_time("stray $need_reboot needed deleting");
    # no need to reboot, as we are already booting, so just delete, no action
    #   also no need to collect the log, so don't use test_need_reboot()
    # done here, not init.d script to avoid scattered duplicate filename defs
    unlink $need_reboot; }

  else {

    # we are running cron or none (=admin) session, no reboot done or allowed

    print("$0: NOTE: pending $need_reboot flag file, saving it ...\n");
    # bigbrother tests this line, don't change format, or also change there
    log_with_time("pending $need_reboot to do");
    # file exists, call this just for setting the mail flag file
    test_need_reboot("install"); } }


# --- check valid package list

# fetch package list
print("checking package list ...\n");
log_with_time("checking package list");

if (! -f $conf_listfile || -z $conf_listfile) {
  # package list nonexistant or empty, so we can not work
  print("$0: ERROR: no or empty $conf_listfile pkg list, bailing out ...\n");
  log_with_time("ERROR: missing or empty package list");
  # add the logfile to the collected log, so not lost because of abort
  collect_log();

  # tell the admin about the error, if we can
  if ($conf_mailaddress ne "") {
    my $host = `hostname`;
    # bigbrother tests this line, don't change format, or also change there
    my $mail_subject = "$0 $called_by ERROR no pkglist on $host";
    open(MAIL, "|-", "mail -s \"$mail_subject\" \"$conf_mailaddress\"");
    print MAIL "$0 found no (or empty) $conf_listfile\n";
    close(MAIL); }

  # and bail out
  exit (1); }


# --- update apt package database

# update package database first, so that we also can see new packages
print("updating package database ...\n");
log_with_time("package database update");

system("nice yes '' | apt-get update >>$logpath 2>>$logpath");
my $avail = "/var/tmp/dphys-admin-$$-available";
system("apt-cache dumpavail > $avail");
system("dpkg --update-avail $avail >>$logpath 2>>$logpath");
unlink "$avail";


# --- detect already installed stuff, to later prevent re-installing it

my %installed;
open(DPKGGETSEL, "-|", "dpkg --get-selections") or die "Can't run dpkg: $!";

while (<DPKGGETSEL>) {

  # get rid of newline, perl does not do this automatically, grrr
  chomp;

  my ($package, $state) = split;
  if ($state eq "install") {
    $installed{$package} = $package; } }

close(DPKGGETSEL);


# --- test and possibly run scripts listed in $need_script file

sub test_need_script {

  # $act contains text "install" or "update"
  local($act) = @_;

  # if one or more of the packages wants a script run
  #   it will add with >> a line to this file containing command(s)
  if (! -f $need_script) {
    return; }

  # first print an newline to terminate line of progress display lines
  print("\n");

  print("$0: running scripts due to $act ...\n");
  log_with_time("$act needs script(s)");

  # file may contain multiple commands, of multiple packages added something
  open(NEEDSCRIPT, "<", $need_script) or die "Can't open $need_script: $!";
  while (my $script = <NEEDSCRIPT>) {
    system($script); }
  close(NEEDSCRIPT);

  unlink $need_script; }


# --- do the actual install work

# evaluate package list and load/eliminate packages
print("installing or removing packages in $conf_listfile ...\n");
log_with_time("install/remove");
open(PKGLIST, "<", $conf_listfile) or die "Can't open $conf_listfile: $!";

while (my $line = <PKGLIST>) {

  # get rid of newline, perl does not do this automatically, as sed would, grrr
  chomp $line;

  # get rid of comments, chop off first # and anything following it
  #    needs testing with \043 because # there made rest of line into comment!
  $line =~ s/\043.*$//;

  # process any `` commands to substitute command for output
  #   there may be multiple in one line, so loop until none left
  while (1) {
    my ($front, $tickcmd, $rest) = split /`/, $line, 3;
    if (! defined $tickcmd) {
      last; }
    if (! defined $rest) {
      $rest = ""; }
    open(TICKOUT, "-|", $tickcmd) or die "Can't execute \"$tickcmd\": $!";
    my @tickout = <TICKOUT>;
    chomp @tickout;
    $tickout = join " ", @tickout;
    $line = join "", $front, $tickout, $rest; }


  # get rid of blanks at begin and end of line (may be after killing comment)
  $line =~ s/^\s*//;
  $line =~ s/\s*$//;

  # get rid of empty lines (may be emptied lines), by fetching next line
  if ($line eq "") {
    next; }


  # get first character, which says what to do with this line
  #   and split off intervening blanks, leaving rest of command as parameter
  $line =~ /^(.)\s*(.*)$/;
  my $operation = $1;
  my $parameter = $2;


  #  ?  = tell ("whats up?") user what is happening, print it out
  if    ($operation eq "?") {

    # simply print out parameter as text, nothing else needs to be done
    print("? $parameter\n"); }


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

    # print out so user knows what is happening, and do it
    print("| $parameter\n");
    system($parameter); }


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

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

    # do not remove stuff that is not installed, to save time an error messages
    # split list of $packages, one per line ...
    my @packages = split(/\s+/, $packages);
    # ... elliminate the not installed ones ...
    foreach my $package (@packages) {
      if (! defined $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; }

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

    # remove packages from list of installed ones, in case later + or !
    #   @packages still exists, so no need for an split
    foreach my $package (@packages) {
      if (defined $installed{$package}) {
        undef $installed{$package}; } } }


  #  +  = 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 (add), old syntax

  else {

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

    # 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 = split(/\s+/, $packages);
      # ... elliminate the already installed ones ...
      foreach my $package (@packages) {
        if (defined $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; } }

    print("$operation $packages\n");
    system("nice yes \"$input\" | " .
      "apt-get -V install $packages >>$logpath 2>>$logpath");

    # add packages to list of installed ones, in case later - or * (unlikely)
    my @packages = split(/\s+/, $packages);
    foreach my $package (@packages) {
      if (! defined $installed{$package}) {
        $installed{$package} = $package; } } }


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


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");
log_with_time("apt-get dist-upgrade");

# use tee so we also get this on screen when running manually
system("nice yes '' | apt-get -u -V dist-upgrade 2>>$logpath | " .
    "tee >>$logpath");

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


# --- warn admin if some package(s) wanted reboot and was/were ignored

# this also restores $need_mail to $need_reboot state
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");
log_with_time("apt-get clean");
system("nice yes '' | apt-get clean >>$logpath 2>>$logpath");


# --- final logging

# tell the waiting user that we are finished, and log it to file
print("\n$0 is done with upgrading software collection\n");
log_with_time("$0 $called_by ended");
# add logfile to the collected log, so not lost after next session
collect_log();

# and also mail the log to admin, now that we are finished
if ($conf_mailaddress ne "") {
  my $host = `hostname`;
  # bigbrother tests this line, don't change format, or also change there
  my $mail_subject = "$0 $called_by INFO has run on $host";
  open(MAIL, "|-", "mail -s \"$mail_subject\" \"$conf_mailaddress\"");
  open(LOGPATH, "<", $logpath);
  print MAIL while <LOGPATH>;
  close(LOGPATH);
  close(MAIL); }

exit(0);