#!/afs/athena/contrib/perl/perl
# (we use perl4 for easy Ultrixability)

# This script creates a new-hierarchy-style tarball from a running
# old- or new-style server.  It misses sendmail aliases, though.

### Set up variables.

$old_cfg = 'usr/athena/lib/olc';          # configuration files under Ultrix
$old_spool = 'usr/spool/olc';             # queue files under Ultrix
$old_quest = 'usr/spool/olc';             # questions under Ultrix

$new_cfg = 'etc/athena/olc';              # configuration files under Solaris
$new_spool = 'var/athena/olc';            # queue files under Solaris
$new_quest = 'var/athena/olc/questions';  # questions under Solaris

( -f "/$old_cfg/translations" )
  || die "Can't find old configuration directory???\n";

( -f "/$old_spool/backup.dat" )
  || die "Can't find old spool directory???\n";

$backup = "/$old_spool/backup.ascii";
$backup = "/$old_spool/backup.temp.ascii" unless ( -f $backup );

( -f $backup )
  || die "Can't find ASCII backup file!\n";

### Parse args: '-n' => dry run, '-0' => no tar output (but do make symlinks)

$will = 'will';

ARG:
while (@ARGV) {
  
  if (($ARGV[0] eq '-cfg') && !$do_data) {
    $do_cfg = 1;
    shift(@ARGV);  next ARG;
  } elsif (($ARGV[0] eq '-data') && !$do_cfg) {
    $do_data = 1;
    shift(@ARGV);  next ARG;

  } elsif ($ARGV[0] eq '-n') {
    $will = 'would';
    $dryrun = 1;
    shift(@ARGV);  next ARG;
  } elsif ($ARGV[0] eq '-0') {
    $notar = 1;
    shift(@ARGV);  next ARG;
  }
  die "usage: server-tar {-cfg|-data} [-n|0]\n";
}

die "usage: server-tar {-cfg|-data} [-n|-0]\n" unless $do_cfg || $do_data;

### deal with configuration files

if ($do_cfg) {

  # set up links
  &arrange_link($old_cfg, $new_cfg);

  # collect filenames
  print "Configuration:\n";

  %Cfg = &mkmap('database', 'ds_prefix', 'hours', 'services',
		'motd', 'motd_timeout', 'topics', 'translations');

  foreach (<$new_cfg/*>) {
    next if ($_ eq 'acls') || ($_ eq 'specialties');
    ((m@/([^/]*)$@ && $Cfg{$1}) || m@/olcm_default_(header|reply)[a-z_]*$@)
      && (push(@files, $_), next);

    print "$will ignore $_\n";
  }

  print "Acls:\n";
  %Acl = &mkmap('olc', 'admin', 'consult', 'gmessage', 'gask', 'gchtopic',
		'gcomment', 'grab', 'gresolve', 'monitor', 'motd', 'on');
  for (<$new_cfg/acls/*>) {
    ((m@/([^/]*)\.acl$@ && $Acl{$1}) || m@/README@)
      && (push(@files, $_), next);
    print "$will ignore $_\n";
  }

  open(TOPICS, "$new_cfg/topics");
  local(@topics) = grep(!/^\#/, <TOPICS>);
  close(TOPICS);
  for (@topics) { s/\s.*\n?//; }
  %Topic = &mkmap(@topics);

  print "Specialties:\n";
  for (<$new_cfg/specialties/*>) {
    ((m@/([^/]*)\.acl$@ && $Topic{$1}) || m@/README$@)
      && (push(@files, $_), next);
    print "$will ignore $_\n";
  }

  # make tarball
  &tar_create('/tmp/olc-cfg.tar', @files);
  @files = ();
}

### deal with spool files

if ($do_data) {

  # set up links
  &arrange_link($old_quest, $new_quest);

  # read ASCII backup, ignore logs not listed
  open(BACKUP, $backup) || die "open($backup): $!";
  local(@backup) = grep(/file:/, <BACKUP>);
  close(BACKUP);
  for (@backup) { s/\s*\n?$//; s@.*\s/@@g; s@$old_quest@$new_quest@g; }
  %Active = &mkmap(@backup);

  print "Questions:\n";
  for (<$new_quest/*>) {
    ($Active{$_} || (m@\.censored$@ && $Active{$`}))
      && (push(@files, $_), next);
    ($_ eq $backup) && next;
    print "$will ignore $_\n";
  }

  &tar_create('/tmp/olc-data.tar', @files);

  # set up links
  &arrange_link($old_spool, $new_spool);
  @files = ( "$new_spool/donelogs" );

  push(@files, "$new_spool/stats/ask_stats")
    if -f "$new_spool/stats/ask_stats";
  push(@files, "$new_spool/stats/res_stats")
    if -f "$new_spool/stats/res_stats";

  &tar_add('/tmp/olc-data.tar', @files);

  &fix_ascii_backup($backup, 'var/athena/olc/backup.ascii');
  &tar_add('/tmp/olc-data.tar', 'var/athena/olc/backup.ascii');
}

### helper functions are here

# create path
sub _mkpath {
  local($path, @path) = @_;
  local($link) = pop(@path);
  die "[$path][@path][$link]: absolutely anchored!\n" unless $path;
  &do_system('rm', '-rf', $path);
  &do_mkdir($path, 0777);
  while (@path) {
    $path .= '/' . shift(@path);
    (-d $path) || &do_mkdir($path, 0777);
  }
}

# create link from path src to dst, creating directories to make src.
sub arrange_link {
  local($dst, $src) = @_;
  if ($dst eq $src) {
    chdir('/') || die "chdir(/): $!";
  } else {
    chdir('/tmp') || die "chdir(/tmp): $!";
    &_mkpath(split(m@/@, $src));
    $dryrun || symlink("/$dst", $src) || die "symlink($dst, $src): $!";
  }
}


# create copy of dst in src(!!!), creating directories to make src.
sub arrange_copy {
  local($dst, $src) = @_;
  if ($dst eq $src) {
    chdir('/') || die "chdir(/): $!";
  } else {
    chdir('/tmp') || die "chdir(/tmp): $!";
    &_mkpath(split(m@/@, $src));
    &do_system('cp', '-f', "/$dst", $src);
  }
}

# ARGH! Old-style ascii backups may have newlines in "title:" field.
sub fix_ascii_backup {
  local($src, $dst) = @_;
  chdir('/tmp') || die "chdir(/tmp): $!";
  &_mkpath(split(m@/@, $dst));

  open(ARGH, $src) || die "can't open $src for reading: $!";
  open(FIXIT, "> $dst") || die "can't open $dst for writing: $!";

  while (<ARGH>) {
    /^topic_code:/ && ($active = 1);
    /^title:/ && $active && (print(FIXIT  "title:        \n"),
			     $punting = 1, next);
    /^note:/ && ($active = 0, $punting = 0);
    $punting && next;

    s@/$old_quest/@/$new_quest/@;
    print FIXIT;
  }

  close(FIXIT);
  close(ARGH);
}

# convert (a, b, ...) to (a, 1, b, 1, ...)
sub mkmap {
  local(@l) = @_;
  local(@x);
  while (@l) {
    push(@x, shift(@l), 1);
  }
  @x;
}

sub tar_create {
  local($dryrun) = $dryrun || $notar;
  &do_system('tar', 'cf', @_);
}
sub tar_add {
  local($dryrun) = $dryrun || $notar;
  &do_system('tar', 'rf', @_);
}

sub do_system {
  if ($dryrun) {
    print STDERR "% @_\n";
  } else {
    local ($status) = system(@_);
    local ($ret, $sig) = (int($status/256), $status%256);
    $status && die "system(@_) returned $ret [$sig]\n";
  }
}
sub do_mkdir {
  if ($dryrun) {
    print STDERR "> mkdir($_[0],$_[1])\n";
  } else {
    mkdir($_[0],$_[1]) || die "mkdir($_[0],$_[1]): $!"
  }
}