#!/usr/bin/perl -wT
#
# (C) 2012 D. V. Wiebe
#
#############################################################################
#
# 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 pogram; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

use strict;

# globals
my $RECONFIG = 0;

# the version of this script
my $VERSION=20121010;

# this shouldn't change
my $ROOT_UUID = "71d80df6-c937-4ee8-90eb-07a323dfb10a";

# filenames
my $MCE_DSP = "/proc/mce_dsp";
my $MCC_ID = "/etc/mcc_id";
my $MCC_SERIAL = "/etc/mcc_serial";
my $HOSTS = "/etc/hosts";
my $HOSTNAMEfile = "/etc/hostname";
my $SSH_KEY = "/etc/ssh/ssh_host_rsa_key";

# don't use this ssh fingerprint (it's the ssh fingerprint of the UBC Master)
my $BAD_FINGERPRINT = "0e:f3:91:a4:51:d1:47:7b:4a:a0:16:18:3d:d8:a1:0e";

# taint management
$ENV{PATH} = "/sbin:/bin:/usr/sbin:/usr/bin";

sub Usage {
  die <<'EOF';
Copyright (C) 2012 D. V. Wiebe

Usage
  cd / && mcc_init config [OPTION]...
or
  cd / && mcc_init reconfig [OPTION]...

This program performs the basic configuration required to initialise a new MCE
Control Computer (MCC).  It can also be used to reconfigure an existing system.

The first argument to this function must be either "config" (if configuring a
new system) or "reconfig" (if reconfiguring a previously initialised system.
(This is simply a mechanism to deter inadvertant execution: only one of these is
appropriate in any situation; choosing the wrong one will result in the script
doing nothing.

Other options available:

  hostname=HOSTNAME  Set the hostname to HOSTNAME.  In config mode, if not
                     specified the default is used.  In reconfig mode, this
                     will rename the host.

  id=N               Set the MCC system id to N.  In config mode, you will be
                     prompted for this if not specified here.  In reconfig mode,
                     this is ignored.

  newkey             Create a new SSH key.  This is done automatically if the
                     default key is detected.

  remaster=0         Reinitialise /data0.  Doing this will delete everything on
                     the partition (including /home).

  remaster=1         Reinitialise /data1.  Doing this will delete everything on
                     the partition.

  remaster=0,1       Reinitialise both /data0 and /data1.  This is done
                     automatically in config mode.

  duplicate          Make /data1 a duplicate of /data0.  This is useful if you
                     wish to replace the drive containing /data0 without losing
                     the current /home.  This will delete everything on /data1.
                     Also note: the contents of /data0/mce (ie. acquired data)
                     are not copied over to the new drive.  This option is
                     mutually incompatible with the 'remaster' option.  Ignored
                     in config mode.

  noupdate           Don't try to self-update before operation.

WARNING: cavalier use of this program may result in data loss or render the
         system unusable.  Use with caution.

Please send reports of bugs and other communication to:
         D. V. Wiebe <dvw@phas.ubc.ca>

This program comes with no warranty, not even for merchantability or fitness
for a particular purpose.  See the GNU General Public License for more details.
EOF
}

# partition a data device via fdisk ... sfdisk would be easier to use, but
# doesn't do the right thing.
sub Fdisk {
  my $dev = shift;
  print "  ... running fdisk to partition $dev\n";

  open FDISK, "|fdisk $dev >/dev/null"
    or die "FATAL! Couldn't spawn fdisk: $!\n";

  local $SIG{PIPE} = sub { die "FATAL: Unexpected close from fdisk!" };

  # the following is ten fdisk inputs:
  # "d\n1\n -> delete partition 1
  # "d\n2\n -> delete partition 2
  # "d\n3\n -> delete partition 3
  # "d\n4\n -> delete partition 4
  # "n\n" -> create a new partition
  # "\n" -> primary partition (default)
  # "\n" -> partition number 1 (default)
  # "\n" -> first sector 2048 (default)
  # "\n" -> last sector (default is use entire device)
  # "w\n" -> write and exit
  print FDISK "d\n1\nd\n2\nd\n3\nd\n4\nn\n\n\n\n\nw\n";

  close FDISK or die "FATAL! Bad spool on fdisk: $!";
}

# run a system command and make sure it was successful
sub ForkExec {
  my ($cmd, $exit, $message) = @_;

  my $return = qx/$cmd/;

  if ($? == -1) {
    die "Unexpectedly unable to execute `$cmd`: $!\n";
  } elsif ($? & 127) {
    die "Command `$cmd` unexpectedly died with signal ", ($? & 127), "\n";
  } elsif ($?) {
    if ($message) {
      print "$message: error code ", ($? >> 8), "\n";
    } else {
      print "FATAL! " if ($exit);
      print "Command `$cmd` exited abnormally: error code ", ($? >> 8), "\n";
    }
    exit 1 if ($exit);
  }

  chomp $return;
  $return
}

# try to unmount a device
sub Umount {
  my ($dev, $mount) = @_;
  $dev = "/dev/$dev";

  # is the mountpoint busy?
  my $lsof = qx/lsof $mount/;
  my $busy = not ($? >> 8);

  print "Trying to unmount $dev from $mount:\n";
  if ($busy) {
    # collect pids
    my @pids;
    for (split /\n/, $lsof) {
      if (/^[^ ]* *([0-9]+)/) {
        push @pids, $1;
      }
    }
    print "PID=$$\n";
    print join ",", @pids, "\n";
    print "  ... HUPing all processes using $mount\n";
    kill "HUP", @pids;
    sleep 1;
    print "  ... TERMing all processes using $mount\n";
    kill "TERM", @pids;
    sleep 1;
    print "  ... KILLing all processes using $mount\n";
    kill "KILL", @pids;
  }

  ForkExec("umount $dev", 1);
}

# create/overwrite a file containing something
sub CatFile {
  my ($name, $data, $quiet) = @_;
  print "  ... Recreating $name\n" unless $quiet;
  open OUT, ">$name";
  print OUT $data;
  close OUT
}

# do a substitution on a file
sub SedFile {
  my ($name, $old, $new) = @_;
  local $/; # slurp

  print "  ... Modifying $name\n";
  #read in
  open IN, "<$name";
  my $file = <IN>;
  close IN;
  
  #substitute
  $file =~ s/$old/$new/g;

  #write back
  CatFile($name, $file, 1);
}

# Ensure we're root
if ($> != 0) {
  print "This program must be run as root.\n";
  exit 1;
}

# salutations
print "MCC Init version $VERSION\n";

# foolproofing
Usage() if ($#ARGV < 0);

if ($ARGV[0] eq "reconfig") {
  $RECONFIG = 1
} elsif ($ARGV[0] ne "config") {
  Usage();
}
shift @ARGV;

# collect options
my ($HOSTNAME, $ID, $NEWKEY, $DUPLICATE, $REMASTER, $NOUPDATE);
for (@ARGV) {
  # strip leading dashes
  s/^-+//;

  if (/^hostname=([0-9A-Za-z-]+)$/) {
    $HOSTNAME = $1;
  } elsif (/^id=([0-9]+)$/) {
    $ID = $1;
  } elsif (/^remaster=(0|1|0,1)$/) {
    $REMASTER = $1;
  } elsif (/^duplicate$/) {
    $DUPLICATE = 1;
  } elsif (/^newkey$/) {
    $NEWKEY = 1;
  } elsif (/^noupdate$/) {
    $NOUPDATE = 1;
  } else {
    Usage();
  }
}
print "\n";

die "Okay.\n";

die "ERROR: You may not specify both 'duplicate' and 'remaster'.\n" if (
  defined $REMASTER and $DUPLICATE);

# check running environment
my $CWD = `pwd`;
die "ERROR: This program must be run from /.  Try 'cd /' first.\n" unless (`pwd`
  eq "/\n");


# self-update
unless ($NOUPDATE) {
  print "Self-updating:\n";
  my $LATEST_IS = ForkExec("wget --quiet http://e-mode.phas.ubc.ca/mce/mcc/LATEST_IS -O-");
  if ($LATEST_IS) {
    chomp $LATEST_IS;
    print "  ... latest program version available: $LATEST_IS\n";

    if ($LATEST_IS > $VERSION) {
      die "Blaaaarg.";
    }
  } else {
    print "  ERROR: Can't talk to server, self-update skipped.";
  }
}
die;

# hardware detection
print "Hardware detection commencing:\n";

# figure out how many fibre cards we have.
$_ = ForkExec("cat $MCE_DSP", 1);
my $ncards = 1 + scalar(/^CARD/mg);
print "  ... found $ncards PCI fibre card" . (($ncards == 1) ? "" : "s") . "\n";
if ($ncards < 1 or $ncards > 2) {
  die "FATAL! Bizarre number of PCI fibre cards found.  Check your hardware.\n";
}

# which device is the CF card?
$_ = readlink "/dev/disk/by-uuid/$ROOT_UUID"
  or die "FATAL! Couldn't determine root partition: $!\n";

my ($rootdev) = /(sd[a-z])1/;
print "  ... found CF card on device $rootdev\n";

# find mounted devices
my @datas;
for (split '\n', ForkExec("mount 2> /dev/null")) {
  if (m#/dev/([a-zA-Z0-9_/-]+) on /data([01])#) {
    $datas[$2] = $1;
  }
}

print "  ... /dev/$datas[0] is mounted on /data0\n" if ($datas[0]);
print "  ... /dev/$datas[1] is mounted on /data1\n" if ($datas[1]);

# find hard drives
my ($ndrive, $nextra, $nsuppl) = (0, 0, 0);
my @devs;
for(split '\n', ForkExec('fdisk -l 2> /dev/null')) {
  if (m#^Disk /dev/(sd[a-z]): .*, ([0-9]*) bytes#) {
    my $dev = $1;
    next if ($dev eq $rootdev);

    my $capacity = $2;
    my $repcap;
    if ($capacity >= 1e13) {
      $repcap = sprintf "(%.2f TB)", $capacity / 1e9;
    } elsif ($capacity >= 1e10) {
      $repcap = sprintf "(%.2f GB)", $capacity / 1e9;
    } elsif ($capacity >= 1e7) {
      $repcap = sprintf "(%.2f MB)", $capacity / 1e6;
    } elsif ($capacity >= 1e4) {
      $repcap = sprintf "(%.2f kB)", $capacity / 1e3;
    } else {
      $repcap = sprintf "(%.2f  B)", $capacity;
    }

    if ($dev gt $rootdev) {
      print "  ... found supplemental (unconfigurable) device: $dev $repcap\n";
      $nsuppl++;
    } else {
      if ($ndrive == 2) {
        print "  ... found unexpected additional (unconfigurable) device: $dev "
        . $repcap . "\n";
        $nextra++;
      } else {
        printf "  ... found data device (/data$ndrive): $dev $repcap\n";
        $devs[$ndrive] = $dev;
        $ndrive++;
      }
    }
  }
}

print "\n";

# check whether we've been configured before.
my $CHECK_ID = ForkExec("cat $MCC_ID");
if ($CHECK_ID =~ /[^0-9]/) {
  # new system
  die "FATAL! can't reconfigure a configured system.\n" if $RECONFIG;

  # default operation
  $REMASTER = ($ndrive == 2) ? "0,1" : "0";
  $DUPLICATE=undef;

  # ask for ID if not given.
  until ($ID) {
    print "MCC ID: ";
    $_ = <>;
    
    #detaint
    if (defined $_ and /^([0-9]+)$/) {
      $ID = $1;
      print "\n";
    }
  }

  # generate hostname if necessary
  $HOSTNAME = sprintf("mcc%02i", $ID) unless $HOSTNAME;
} else {
  # already configured
  die "FATAL! can't configure a configured system.\n" unless $RECONFIG;
  $ID = $CHECK_ID;
}

# check whether the hardware jibes with the requested operation
die "FATAL! can't duplicate devices: not enough devices\n" if ($DUPLICATE and
  $ndrive < 2);
$REMASTER = "" unless (defined $REMASTER);
die "FATAL! can't remaster /data1: no available device\n" if ($REMASTER =~
  /1/ and $ndrive < 2);
die "FATAL! can't remaster /data0: no available device\n" if ($REMASTER =~
  /0/ and $ndrive < 1);

# grab some interesting numbers early

# MCC Image id
my $IMAGE = ForkExec("cat $MCC_SERIAL");

# MAC address
my ($MAC) = ForkExec("ifconfig eth0") =~ /HWaddr ([0-9A-Fa-f:]*)/;

# SSH fingerprint
my ($SSH) =
  ForkExec("ssh-keygen -lf $SSH_KEY.pub") =~ /^[0-9]* ([0-9A-Fa-f:]+)/;

# check for the bad key
$NEWKEY = 1 if (lc $SSH eq $BAD_FINGERPRINT);

# remember the old hostname
my $OLD_HOSTNAME = ForkExec("hostname");

# what do we need to unmount?
my @need_umount;
if ($DUPLICATE or $REMASTER ne "") {
  # unmount stuff as necessary
  $need_umount[0] = 1 if (defined $datas[0] and ($REMASTER =~ /0/ or
      (defined $devs[1] and $datas[0] eq $devs[1] and $REMASTER =~ /1/)));
  $need_umount[0] = 1 if (defined $datas[1] and ($DUPLICATE or $REMASTER =~ /0/
        or (defined $devs[0] and $datas[1] eq $devs[0] and $REMASTER =~ /1/)));
}

# it's a bad idea to get interrupted after this point
$SIG{INT} = $SIG{TERM} = sub {
  my $sig = shift;
  print "\nInterrupting this program now is not a good idea.\n",
  "But we won't stop you if you try the same thing again.\n";
  $SIG{$sig} = 'DEFAULT';
};

#unmount stuff!
Umount($datas[0], "/data0") if ($need_umount[0]);
Umount($datas[1], "/data1") if ($need_umount[1]);

# remount / read-write
ForkExec("mount / -o remount,rw", 1, "FATAL! Couldn't remount / read-write");

# record ID, if appropriate
if (not $RECONFIG) {
#  CatFile($MCC_ID, $ID . "\n");
}

# set the hostname if needed
if ($OLD_HOSTNAME ne $HOSTNAME) {
  print "Setting hostname to \"$HOSTNAME\":\n";
  CatFile($HOSTNAMEfile, $HOSTNAME . "\n");
  SedFile($HOSTS, "\\b$OLD_HOSTNAME\\b", $HOSTNAME);
  print "  ... running hostname\n";
  ForkExec("hostname $HOSTNAME");
  print "\n";
}

# generate a new ssh key, if needed
if ($NEWKEY) {
  print "Generating a new SSH key:\n";
  print "  ... running ssh-keygen\n";
  ForkExec("yes | ssh-keygen -t rsa -f $SSH_KEY -P \"\"");

  # capture the new fingerprint
  ($SSH) = ForkExec("ssh-keygen -lf $SSH_KEY.pub") =~ /^[0-9]* ([0-9A-Fa-f:]+)/;
  print "\n";
}

# Remaster /data0
if ($REMASTER =~ /0/) {
  my $dev = "/dev/$devs[0]";
  print "Remastering /data0:\n";
  Fdisk($dev);
  $dev .= "1";
  print "  ... running mkfs.ext4 to create a filesystem on $dev\n";
  ForkExec("mkfs.ext4 $dev >/dev/null", 1);
  print "  ... mounting $dev\n";
  ForkExec("mount $dev >/dev/null", 1);
}

# remount / read-only
ForkExec("mount / -o remount,ro", 0, "ERROR! Couldn't remount / read-only");

# summarise, I guess
print "\nSuccess!\n";
print "Here are some things you might want to write down:\n";
print "  MCC ID:               $ID\n";
print "  System Image Version: $IMAGE\n"; 
print "  MAC Address:          $MAC\n";
print "  Hostname:             $HOSTNAME\n";
print "  SSH Fingerprint:      $SSH\n";