#!/usr/bin/perl -w
# SafeTP install script
# assumptions:
#   run as root
#   binaries already available
#   safetp user already created
# version history:
#   1.21    made root check not a state, but always performed
#           removed partial test
#           added -noninter flag for easier testing (and
#             *possibly* useful for unattended installs, if the
#             defaults are *all* correct)
#   1.20    switching to interactive prompting instead of forcing
#           the user to edit the script itself, lots of other 
#           general improvements
#   1.11b   working on a check for brace expansion functionality
#           fixed troublshooting reference (trouble.txt)
#   1.11    added more support for keeping keys across upgrades
#             (the intent was never that people would re-run the install
#             script for an upgrade, just replace binaries.. maybe should
#             have an upgrade script..?)
#           fixed some problems with the way the test programs were run,
#             specifically, eliminating use of 'su' (since I usually run
#             with no shell for the 'safetp' user)
#   1.10    rewritten in perl (was in csh), with (at least) these benefits:
#             - eliminated need for helper scripts (is self-contained now)
#             - improved config-file modification by using Perl's internal
#               pattern matching and string substitution mechanisms, and
#               ability to do all editing in-memory (eliminating error-prone
#               tmp1/tmp2 game)
#             - improved error handling
#             - easier maintenance, due to language superiority over csh
#             - other benefits of being able to define subroutines.. :)
#           removed stuff about -3, since it's unnecessary now
#           added -9 to the default options list
#   1.02    corrected/improved some of the comments below
#           updated sftpc syntax for 1.20 sftpc, inc. -X
#           removed now-redundant ^D eat-extra stuff
#   1.01    added ability to not simply co-opt ftp's port, for krb5 compat.
#   1.00    all previous..

use strict 'subs';   # disallow barewords
use English;         # mnemonics for things like EUID

# subroutines (all defined & documented at end of file)
sub processCommandLineOptions;
sub readSavedAnswers;
sub appendState;
sub forgetLastAnswer;
sub firstLine;
sub pval;
sub runDontDie;
sub run;
sub complainAndQuit;
sub printStackTrace;
sub cd;
sub beginModifying;
sub finishModifying;
sub appendUninstall;
sub appendToFile;
sub prependUninstall;
sub hupInetdOrAskUser;
sub hupInetd;
sub getAllProcesses;
sub getAllProcessesInner;
sub doUninstall;
sub readFile;
sub writeFile;
sub packageCmd;
sub appendUninstallCmd;
sub prependUninstallCmd;
sub makeSymlink;
sub askStringQuestion;
sub askQuestionNotSaved;
sub askBooleanQuestion;
sub startSection;
sub endSection;
sub dropRoot;
sub resumeRoot;
sub diagnostic;


# ------------------ script-wide globals -------------
# directory for storing install state files
$work_dir = "/etc/safetp";

# file for recording script state
$state_file = "$work_dir/safetp_install_state";

# name of the uninstall script commands
$uninstall_file = "$work_dir/uninstall.cmds";

# names of system files to modify
$etc_services = "/etc/services";
$etc_inetd_conf = "/etc/inetd.conf";
$etc_motd = "/etc/motd";

# some systems don't have this file
$has_etc_motd = (-f "/etc/motd");

# assume we will not be doing a dry run
$dry_run = 0;

# but if we do, we will use this directory to play in
$drydir = "/tmp/dry";

# and don't start in debug mode
$debug_mode = 0;

# when true, we avoid anything that would require an
# interactive response
$noninteractive = 0;


# ----------------- preliminaries -----------------------
getHostType();

# do before acting on $work_dir since we might change it
processCommandLineOptions();

# test for being root (right after cmdline, since it is there
# we might set $dry_run)
if ($EUID != 0 && !$dry_run) {
  # $EUID is effective user id, 0 is user id of root
  die "You must be root to install the SafeTP daemon.\n";
}

mkdirIfNotAlready($work_dir);

readSavedAnswers();


# ------------------ question and answer ---------------------
# now, we ask the user a bunch of questions.  if the user has
# already answered some of them, they won't be asked again

#
# first tell the user what's going to happen
#
$message = <<EOF;

Welcome to the SafeTP install script.

You should already have done these things:
  - compiled the binaries; see compile.txt
  - created a user for sftpd to run as, such as "safetp"
  - became root to run this script
If you have not done these things, stop now, read install.txt,
and come back later.

First, I will ask you a bunch of questions.  For most of them, if not
all, the default answer will be fine; just hit Enter.  Otherwise, enter
a different value and press Enter.

If you make a mistake, use ^C to quit the script.  The answers you have
given so far, including default answers, are stored in
$state_file; delete this file to start over.

After the questions I will begin the install itself.  If something goes
wrong I will stop.  When you fix whatever is wrong, simply re-start the
script, and it will resume by trying the last thing that failed.
EOF

$proceed = askBooleanQuestion("$message\nAre you ready to begin? ", 1);
if (!$proceed) {
  forgetLastAnswer();
  exit();
}

#
# this is the user on whose behalf the sftpd daemon will run
# (and the user that will have ownership of the daemon files)
#
$daemon_user = askStringQuestion(
  "What is the name of the user that\nsftpd should run as? ",
  $dry_run? firstLine(`whoami`) : "safetp");
if (!getpwnam($daemon_user)) {
  print("I don't see user `$daemon_user' in the passwd file; that should\n",
        "be fixed first.  Perhaps you should say 'useradd $daemon_user'.\n");
  forgetLastAnswer();
  exit();
}

#
# grab stuff from passwd file
#
($_, $_, $daemon_uid, $daemon_gid, $_, $_, $_, $daemon_home) =
  getpwnam($daemon_user);
($daemon_group) = getgrgid($daemon_gid);
if (!getgrnam($daemon_group)) {
  print("I don't see group `$daemon_group' in the group file; that should\n",
        "be fixed first.\n");
  forgetLastAnswer();
  exit();
}

#
# This string will appear in the DSA public key, and ftp users
# will see it upon connection.  The name should be something
# users will recognize.  Comment this out to get the normal
# interactive prompt from 'makekeys'.
#
$hostname = getFQDN();
$branding_string = askStringQuestion(
  "Your DSA public key will include a descriptive name, called its\n" .
  "\"brand\", that users will see when they connect to your server.\n" .
  "This string should be something users will recognize.  What brand\n" .
  "would you like? ",
  "SafeTP at $hostname");

#
# this is where the pre-built binaries are.  the needed binaries are:
#   sftpc        - SafeTP unix client
#   sftpd        - SafeTP daemon itself
#   makekeys     - program to generate ElGamal (client) and DSA (server) keys
#   viewkey      - program to base64 a binary key file
#   addent       - entropy-gathering tool
#
$binary_source = askStringQuestion(
  "Where are the SafeTP binaries, such as 'sftpd',\nlocated now? ",
  ".");
if (! -f "${binary_source}/sftpd") {
  print("I don't see 'sftpd' in '$binary_source'.\n");
  forgetLastAnswer();
  exit();
}

#
# this is where the binaries will be placed, where inetd
# will find them; ideally, this is on the local machine
#
$binary_dest = askStringQuestion(
  "Where should the SafeTP binaries be placed for ongoing use?  Since\n" .
  "many network file system protocols, such as NFS, are insecure, this\n" .
  "should be on the local machine which will run the SafeTP daemon.\n",
  $dry_run? $drydir : $daemon_home);

#
# this is where symbolic links to binaries that users will
# typically run will be placed
#
$user_binary_dest = askStringQuestion(
  "For user convenience, I can put symlinks to the SafeTP binaries in some\n" .
  "conventional place.  Where should I put these symlinks?\n",
  $dry_run? "$drydir/links" : "/usr/local/bin");

#
# this is where the server keys will be placed (actually, they
# will go into a DSA subdirectory of this directory); this
# *really must* be on the local machine (otherwise the private
# key is vulnerable while being fetched over the network)
#
$key_dest = askStringQuestion(
  "Where should I put the DSA server keys?  It is imperative that the\n" .
  "directory specified here be on the local machine, because if the\n" .
  "server keys are sniffed then SafeTP is compromised.  (Note also that\n" .
  "you need to think carefully about how/whether these keys are part\n" .
  "of any automatic backup procedures.)\n",
  $dry_run? $drydir : $daemon_home);

#
# raw (unencrypted) FTP service will be installed on this port
#
$raw_ftp_port = askStringQuestion(
  "To which port should I move the existing FTP daemon?  Since SafeTP uses\n" .
  "this daemon, you can't just remove it entirely.  ",
  351);

#
# this is the port sftpd will listen to
# (if it is desired to install sftpd on a port other than 21,
# we recommend 353; the Windows client depends on it using 353)
#
$sftpd_port = askStringQuestion(
  "Which port should SafeTP listen to?  Normally you should make SafeTP\n" .
  "listen to port 21, the default FTP port.  However, if for some reason\n" .
  "you want it to listen to a different port, 353 is the recommended\n" .
  "alternative.  ",
  21);

#
# command-line switches to sftpd.  common ones are:
#    -pN            listen for incoming connections on port N
#    -fN            contact ftpd on port N
#    -s             use stdin as control connection (for use with inetd)
#    -d1            log diagnostic (debugging) messages
#    -9             disallow RFC 959 (unencrypted) connections
#    -y<directory>  specify working directory (default is cwd)
#    -o             send debug output to log file instead of syslog
#    -l<filename>   specify logging file (use with -o)
#    -3             disable the 3rd-party transfer optimization
# (additional options available: "sftpd -h")
# (additional docs: http://safetp.cs.berkeley.edu/sftpd.html)
#
$sftpd_options = "-f${raw_ftp_port} -s -y${key_dest}";
if (!askBooleanQuestion(
      "Do you want SafeTP to accept unencrypted connections as well as\n" .
      "encrypted connections?  It makes the transition path easier for\n" .
      "users but also eliminates the forcing function for them to switch\n" .
      "to using SafeTP.  Accept unencrypted?  ",
      0)) {
  $sftpd_options .= " -9";
}
$extra_options = askStringQuestion(
  "The current argument string to sftpd is:\n" .
  "  sftpd $sftpd_options\n" .
  "You can enter additional arguments here if you want:\n",
  "");
$sftpd_options .= " " . $extra_options;

#
# amount of entropy to gather; the default (1024) requires
# approximately 200 keystrokes; reduce to suit keymashing
# tolerance... (setting it to 0 will effectively add only
# the current date/time as the entropy, which is insecure)
#
$bits_of_entropy = 1024;

#
# length of DSA keys (recommended: 1024)
#
$dsa_key_len = 1024;

#
# controls whether a full test is performed post-install
#
$do_full_test = askBooleanQuestion(
  "After installing, do a full (interactive) test? ", 
  $noninteractive? 0 : 1);

#
# Additional parameters to sftpc during the full test (if it
# is done at all); the one that makes most sense here, if any,
# is "-n", which does protocol negotiation only.  This should be
# used after the install works right on one machine, with a real
# full test, and it is desired to install on other machines
# noninteractively.
#   -X   accept new key silently
#
$sftpc_full_extras = "-X";
#$sftpc_full_extras = "-X -n";

#
# if this is 1, we edit /etc/motd to tell users that
# a secure FTP server has been installed (some systems
# overwrite /etc/motd during boot...)
#
if ($has_etc_motd) {
  $do_edit_motd = askBooleanQuestion(
    "After install, should I add a blurb to /etc/motd telling users\n" .
    "that SafeTP is installed? ", 1);
}
else {              
  # don't modify it if it's not there
  $do_edit_motd = 0;
}

#
# some sites like to have admins put their login name in a
# comment next to config changes; the following string will
# be appended to comment strings inserted
#
$comment_extra = askStringQuestion(
  "When I modify system files, I will tag the modifications with the name\n" .
  "of the admin responsible.  What tag should I use?\n",
  $dry_run? "dry_run" : "");

#
# how to retrieve a list of all processes; only set this if
# you have reason to believe that getAllProcesses() (at end
# of file) isn't working
#
#$allProcsCmd = "ps aux";


# ------------ less-used configuration options ----------------
#
# permissions for various files; see install.txt for summary
# of minimum and convenient permissions; the defaults here
# are the "convenient" permissions
#
$binary_dir_perm = "755";
$key_dir_perm = "755";
$binary_perm = "755";
$seed_perm = "600";
$key_subdir_perm = "711";
$privkey_perm = "600";
$pubkey_perm = "644";
$pubkeytxt_perm = "644";

#
# length of elgamal keys (used for testing only)
#
$elgamal_key_len = 1024;

#
# grab a datestamp and timestamp
#
$datestamp = firstLine(`date +%x`);
  die "date failed" if $?;
$timestamp = firstLine(`date +%Y.%m.%d.%H.%M.%S`);
  die "date failed" if $?;

  
# ------------- other globals ---------------------
#
# grab two temp file names
#
$tmp1 = "/tmp/safetp.$$.tmp1";
#$tmp2 = "/tmp/safetp.$$.tmp2";    # no longer used..


# list of binaries to copy
@bins = qw(sftpc sftpd makekeys viewkey addent);


# (part of) comment to append to modified lines of config files
$comment = "by SafeTP install ${datestamp} ${comment_extra}";

# directory where server keys, and client test keys, will be created
$ENV{SAFETP_CONFIG} = $key_dest;


# A quick note to those who maintain this file:
#   It's important to keep in mind that restarting the
# install script causes different parts to run with
# different ${timestamp} values.  This is why, for example,
# an atomic section (like modifying /etc/services) must
# go all the way to the point where the uninstall info is
# written; breaking it in the middle could break the
# uninstall script.


# --------------- installation proper ---------------------


if (startSection()) {
  # start an uninstall script commands file
  if (-e "$uninstall_file") {
    # move the old one first
    run("mv $uninstall_file ${uninstall_file}.${timestamp}");
  }

  appendUninstall("# this is somewhere in $uninstall_file");

  # the uninstall script should remove the state file, even if the
  # install only partially succeeded, on the presumption that a
  # re-install attempt will follow
  appendUninstallCmd("removing install state", "rm $state_file");

  endSection("started the uninstall file");
}


if (startSection()) {
  # copy the required binaries
  foreach $bin (@bins) {
    run("cp ${binary_source}/$bin $binary_dest");

    # write uninstall info
    prependUninstallCmd("removing $bin", "rm ${binary_dest}/$bin");
  }

  endSection("copied the binaries to $binary_dest");
}


if (startSection()) {
  # set ownership and permissions
  run("chmod $binary_dir_perm $binary_dest",
      "chown $daemon_user $binary_dest");

  foreach $bin (@bins) {
    run("chmod $binary_perm ${binary_dest}/$bin",
        "chown $daemon_user ${binary_dest}/$bin",
        "chgrp $daemon_group ${binary_dest}/$bin");
  }

  endSection("set the permissions on the binaries");
}


if (startSection()) {
  # as a convenience during debugging of this script, permit
  # an existing randomSeed to be used
  if (-e "$key_dest/randomSeed") {
    print("${key_dest}/randomSeed already exists, skipping entropy-gathering...\n");
  }

  elsif ($noninteractive && $dry_run) {  
    # *only* do this for a dry run; a real install must not be
    # allowed to proceed without entropy!
    #
    # makekeys below will generate the randomSeed file, and
    # it won't prompt for entropy because of 3rd arg
    print("skipping addent because it's noninteractive dry run\n");
  }

  else {
    # gather entropy
    cd("$key_dest");
    run("${binary_dest}/addent $bits_of_entropy");

    # (no longer have to eat keystrokes, because addent takes care of it)
  }

  # write uninstall info
  #prependUninstallCmd("removing seed", "rm ${key_dest}/randomSeed");
  # like the keys, leave the seed

  endSection("gathered entropy");
}


if (startSection()) {
  # permit use of existing keys to keep keys across upgrades
  if (-e "${key_dest}/DSA") {
    print "DSA keys already exist, skipping key generation...\n"
  }

  else {
    # generate keys (client also, for testing, to share randomSeed)
    cd("$key_dest");
    $cmd = "${binary_dest}/makekeys $elgamal_key_len $dsa_key_len 0";
    if ($branding_string) {
      print "Supplying branding string: $branding_string\n";
      run("echo \"$branding_string\" | $cmd");
    }
    else {
      run("$cmd");
    }
  }

  # write uninstall info
  #prependUninstallCmd("removing keys", "rm -rf ${key_dest}/DSA ${key_dest}/ElGamal");
  #prependUninstallCmd("removing cached host keys", "rm -rf ${key_dest}/keys");
  # we don't want to delete keys, esp. server keys, since we want people to use
  # the same server keys across an upgrade.. if someone truly wants to delete
  # the keys, they'll have to do it themselves

  endSection("generated keys");
}


if (startSection()) {
  # create a text file for users to view the public key
  cd("$key_dest");
  run("${binary_dest}/viewkey DSA/public.key > " .
        "${key_dest}/DSA/public.key.txt");

  # don't bother with uninstall info because the above
  # deletion of ${key_dest}/DSA will get public.key.txt

  endSection("created public.key.txt");
}


if (startSection()) {
  # set permissions for key files and directories
  run("chmod $key_dir_perm $key_dest",
      "chmod $seed_perm ${key_dest}/randomSeed",
      "chmod $key_subdir_perm ${key_dest}/DSA",
      "chmod $privkey_perm ${key_dest}/DSA/private.key",
      "chmod $pubkey_perm ${key_dest}/DSA/public.key",
      "chmod $pubkeytxt_perm ${key_dest}/DSA/public.key.txt",
      "chmod 700 ${key_dest}/ElGamal",
      "chmod 600 ${key_dest}/ElGamal/*",
      "chown -R $daemon_user $key_dest",
      "chgrp -R $daemon_group $key_dest");

  # no explicit uninstall necessary because these files are deleted
  # during other stages' uninstalls

  endSection("set the permissions on the keys");
}


# there used to be a "partial" test here, but I decided it wasn't
# worth the hassle of making it work reliably, and its diagnostic
# value was not very much


if (startSection()) {
  # backup, read
  beginModifying($etc_services);

  # append a block of section break comments
  @file = (@file,
    "#\n",
    "# added $comment\n",
    "#\n");

  # put a safetp line
  if ($sftpd_port == 21) {
    # modify existing ftp line
    my $numSubsts = 0;      # count number of times we substitute
    foreach $line (@file) {
      # in this regexp, $1 is the required part (ftp...21/tcp) and
      # $2 is the rest of the line (other service names and possibly
      # a comment)
      $numSubsts +=
        $line =~ s[^(ftp\s+21/tcp)(.*)]
                  [$1\t\tsafetp$2\t\t# safetp added $comment];
    }

    if ($numSubsts != 1) {       # too many, or too few, substitutions
      print("error: While computing the new $fn, I made $numSubsts\n",
            "       changes, instead of the expected 1 change.  Thus, I\n",
            "       screwed up, most likely.\n\n");

      if (open(TMP1, ">$tmp1")) {
        print TMP1 @file;
        close(TMP1);
        print("       I wrote the botched $fn to $tmp1,\n",
              "       so you can inspect it.\n\n");
      }
      else {
        print("       I tried to write the botched $fn to $tmp1,\n",
              "       but failed to open $tmp1...?\n\n");
      }

      print("       See if you can figure out what went wrong, and modify\n",
            "       $fn to try to fix it, then re-run $0.\n");
      exit(4);
    }
  }

  else {
    # add a new line for safetp
    @file = (@file,
      "safetp\t\t${sftpd_port}/tcp\t\t# added $comment\n");
  }

  # add the raw-ftp line
  @file = (@file,
    "raw-ftp\t\t${raw_ftp_port}/tcp\t\t# added $comment\n");

  # write computed contents to /etc/services
  finishModifying();

  endSection("modified /etc/services");
}


if (startSection()) {
  # backup, read
  beginModifying($etc_inetd_conf);

  # grab the current ftp line
  @ftp_lines = grep /^ftp\s/, @file;
  if (@ftp_lines > 1) {
    # this shouldn't happen unless /etc/inetd.conf has mulitple entries for ftp!
    print("error: I am confused as to which of these is the ftp line:\n");
    printIndented(@ftp_lines);
    print("If you (temporarily) comment-out all but one, I will use that one.\n");
    exit(2);
  }

  # check that there is an ftp line
  if (@ftp_lines == 0) {
    print("error: I don't see any ftp lines in $fn.  Please add a line for\n",
          "       the ftp service so I can move it around.\n");
    exit(2);
  }

  # turn off existing ftp if it would conflict with sftpd
  if ($sftpd_port == 21) {
    # here, comment is put in front, to emphasize that it must be removed
    # completely for this line to be re-activated
    my $numSubsts = 0;
    foreach $line (@file) {
      $numSubsts +=
        $line =~ s[(^ftp\s.*)]
                  [# (removed ${comment}) $1];
    }
    if ($numSubsts != 1) {
      die "I goofed modifying $fn";
    }
  }

  # going to append, so insert a section break
  # this is the only comment that appears for these lines, because inetd.conf
  #   doesn't allow comments on the same line as a non-comment line
  # append a block of section break comments
  @file = (@file,
    "#\n",
    "# added $comment\n",
    "#\n");

  # modify existing ftp line (currently in $ftp_lines[0])
  @file = (@file,
    "raw-${ftp_lines[0]}");

  # add the safetp line
  @file = (@file,
    "safetp\tstream\ttcp\tnowait\t$daemon_user\t" .
    "${binary_dest}/sftpd sftpd ${sftpd_options}\n");

  # write to /etc/inetd.conf
  finishModifying();

  endSection("modified /etc/inetd.conf");
}


if (startSection()) {
  # HUP it; this causes it to re-read /etc/inetd.conf
  hupInetdOrAskUser();

  # write uninstall info; note that, for this, we *append* rather
  # than prepend, because hup'ing inetd should wait until everything
  # else is back in order
  appendUninstall("hupInetdOrAskUser();");

  endSection("sent HUP signal to inetd");
}


if (startSection()) {

  if ($do_full_test == 1) {
    # temporarily switch to $daemon_user
    dropRoot($daemon_uid, $daemon_gid);

    # run sftpc
    cd("/tmp");    # run from /tmp to avoid cwd=cwd problem
    askQuestionNotSaved(
      "Instructions:  I'm about to start sftpc so you can test it.\n" .
      "You need to give four responses:\n" .
      "  username: any valid user name on this system\n" .
      "  password: the corresponding password\n" .
      "  sftpc> test      (at first sftpc prompt)\n" .
      "  sftpc> quit      (at second sftpc prompt)\n" .
      "When ready, hit Enter: ",
      "");

    my $sftpc_cmd = "${binary_dest}/sftpc ${sftpc_full_extras} " .
                    "localhost ${sftpd_port}";
    if (!runDontDie($sftpc_cmd)) {
      print("\n",
            "error: The full test failed.  Since the protocol test\n",
            "       above already succeeded, the error here is most\n",
            "       likely something wrong with inetd.\n",
            "\n",
            "  sftpc command line used:\n",
            "    env SAFETP_CONFIG=" . $ENV{SAFETP_CONFIG} . "\n",
            "    ${sftpc_cmd}\n",
            "\n",
            "       See http://safetp.cs.berkeley.edu/trouble.html\n",
            "       for some ideas on how to fix this.\n");
      exit(2);
    }

    # restore uid/gid
    resumeRoot();

    print "full test: SUCCESS!\n";
  }

  endSection("did full test");
}


if (startSection()) {
  # link to the unix client
  makeSymlink("${binary_dest}/sftpc", "${user_binary_dest}/sftpc");

  # links to keys and entropy utilities; I make the symlink name
  # include "sftpc-" to avoid executable namespace pollution
  makeSymlink("${binary_dest}/makekeys", "${user_binary_dest}/sftpc-makekeys");
  makeSymlink("${binary_dest}/addent", "${user_binary_dest}/sftpc-addent");

  # uninstall info
  prependUninstallCmd("removing client binary symlinks",
                      "rm -f ${user_binary_dest}/sftpc " .
                            "${user_binary_dest}/sftpc-makekeys " .
                            "${user_binary_dest}/sftpc-addent");

  endSection("created symlinks");
}


if (startSection()) {

  if ($do_edit_motd) {
    # backup, read
    beginModifying($etc_motd);

    # append banner, including pointer to public key text file
    # (syntax:  "foo" x 3  yields  "foofoofoo")
    @file = (@file,
      "\n",
      "  $datestamp  SafeTP installed.  See http://safetp.cs.berkeley.edu\n",
      "  " . " " x length($datestamp) .
                  "  Public key: ${key_dest}/DSA/public.key.txt\n");

    # write changed file to disk
    finishModifying();
  }

  endSection("edited /etc/motd");
}


if (startSection()) {
  print <<EOF;

  --------------------------------------------------
  -- The SafeTP install has finished!  Excellent! --
  --------------------------------------------------

  Summary of changes:
    - binaries were copied to $binary_dest
    - symlinks were created in $user_binary_dest
    - keys were created in $key_dest
    - $etc_services:
      - added 'safetp' as port $sftpd_port
      - added 'raw-ftp' as port $raw_ftp_port
    - $etc_inetd_conf:
      - added 'safetp' -> 'sftpd'
      - removed 'ftp' -> 'ftpd' (if safetp port is 21)
      - added 'raw-ftp' -> 'ftpd'
    - $etc_motd: optionally added a blurb
    - put backups and diffs of modified files in $work_dir
    - created $uninstall_file

  Executing '$0 -u' will un-install SafeTP.

EOF

  endSection("printed final success message");
}

else {
  # only executed if we skipped final section, which only happens
  # if someone re-runs install script after it's finished
  print("This is the end of the install script.  If you need to\n",
        "re-run this install script, remove the file
         ${state_file}.\n");
}


# end of install script!
exit(0);


# ----------------- helper subroutines ----------------------
# interpret -u to mean uninstall, die on any other
sub processCommandLineOptions {
  my $op;
  while ($op = shift @ARGV) {
    if ($op eq "-u") {
      doUninstall();
      exit();
    }
    elsif ($op eq "-hostTest") {
      print("Here is my guess at a complete process list:\n");
      printIndented(getAllProcesses());

      hupInetdOrAskUser();

      print("I think the host type is: $hostType\n");

      printf("I think the fqdn is %s\n", getFQDN());

      exit();
    }
    elsif ($op eq "-debug") {
      $debug_mode = 1;
      diagnostic("debug mode is on");
    }
    elsif ($op eq "-test") {
      # setup things for dry run
      $dry_run = 1;

      $work_dir = "$drydir/safetp";
      $state_file = "$work_dir/safetp_install_state";
      $uninstall_file = "$work_dir/uninstall.cmds";

      mkdirIfNotAlready($drydir);
      mkdirIfNotAlready("$drydir/links");

      $etc_services = dryRunFile($etc_services, "$drydir/services");
      $etc_inetd_conf = dryRunFile($etc_inetd_conf, "$drydir/inetd.conf");
      if ($has_etc_motd) {
        $etc_motd = dryRunFile($etc_motd, "$drydir/motd");
      }
    }
    elsif ($op eq "-noninter") {
      $noninteractive = 1;
    }
    else {
      print("Supported options:\n",
            "  (no option)   - run the installer\n",
            "  -u            - run the uninstaller\n",
            "  -hostTest     - test some system-specific stuff\n",
            "  -debug        - turn on debugging diagnostics\n",
            "  -test         - dry-run test install as non-root\n",
            "  -noninter     - use all the defaults, don't do final test\n",
           );
      exit(1);
    }
  }
}


# read in state from a prior run of this script, so we can resume
# where we left off; also, arrange to keep appending new state
sub readSavedAnswers {
  if (!open(STATE, "<$state_file")) {
    # this is the first run
    @savedAnswers = ();
    diagnostic("this is the first run");
  }
  else {
    # grab what we have
    @savedAnswers = <STATE>;

    # strip newlines from all the answers
    for ($i = 0; $i < @savedAnswers; $i++) {
      chomp($savedAnswers[$i]);
    }
    diagnostic("read $i saved answers");

    close(STATE) or die;
  }
}


# write a single line of state to the state file
sub appendState {
  my ($line) = @_;
  appendToFile($line, "$state_file");
}


# remove last saved answer
sub forgetLastAnswer {
  diagnostic("forgetting last answer");
  @answers = readFile($state_file);
  pop(@answers);
  writeFile($state_file, @answers);
}


# return the first line of a (possibly) multi-line value,
# throwing away the newline as well
sub firstLine {
  my ($line) = @_;     # grab first line, with \n
  $line =~ s/\n//;     # throw away \n
  return $line;
}


# print the value of a variable, given a string containing its name
sub pval {
  my ($name) = @_;
  print "$name = " . $$name . "\n";
    # $$name means, map 'name' to its scalar value (a string), then map
    # that string to *its* scalar value
}


# run a command (or list of commands), and if it fails, return false
# either way, set global $lastCmdTried to command tried
sub runDontDie {
  my $cmd;
  while ($cmd = shift @_) {
    $lastCmdTried = $cmd;
    print("executing: $cmd\n");
    if (system($cmd) != 0) {    # error
      return 0;
    }
  }
  return 1;
}


# run a command (or list of commands), and if it fails, print a message and exit
sub run {
  if (!runDontDie(@_)) {
    complainAndQuit($lastCmdTried);
  }
}


# print a message about what went wrong, and print the call stack too
sub complainAndQuit {
  my ($context) = @_;
  print("error: ");
  printStackTrace(1);
  print("this failed:\n",
        "  $context\n",
        "Try to correct the problem, and re-run $0\n");
  exit(4);
}


# print the stack trace (except the last n frames)
sub printStackTrace {
  my ($n) = @_;
  my @info;
  my $outputLine = 1;
  while (@info = caller($n++)) {
    if ($outputLine++ == 1) {
      print("At ");
    }
    else {
      print(", called from\n   ");
    }
    print("line $info[2] of $info[1]");
  }
  print(":\n");
}


# change to a directory; require that it succeed
sub cd {
  my ($dir) = @_;
  chdir("$dir") or complainAndQuit("chdir $dir");
}


# begin modifying $fn; sets these globals:
#   $fn      - file name of current file being modified
#   $oldfn   - name of file before modifications
#   @file    - array of file's contents, one line per array entry
sub beginModifying {
  ($fn) = @_;     # fn is global

  my $base = basename($fn);

  # make a backup
  $oldfn = "$work_dir/${base}.${timestamp}";
  run("cp $fn $oldfn");

  # read the file into memory
  return @file = readFile($fn);
}


# write contents of @file to $fn, create a patch file
# to restore $fn to $oldfn, and write uninstall line
sub finishModifying {
  # write the file
  writeFile($fn, @file);

  my $base = basename($fn);

  # create a patch file
  my $pt = "$work_dir/${base}.changes.${timestamp}";
  runDontDie("diff -c $fn $oldfn > $pt");
    # diff returns nonzero to indicate that there were
    # differences, rather than failure.. not sure what's
    # a good way to check diff for failure
  print("You can inspect changes to $fn in $pt\n");

  # write uninstall info
  prependUninstallCmd("restoring $fn", "cp -f $fn $work_dir/${base}.bak && patch $fn $pt");
}


# append a line to the uninstall file
sub appendUninstall {
  my ($cmd) = @_;
  appendToFile($cmd, $uninstall_file);
}


# append a line to a file; create it if it doesn't exist
sub appendToFile {
  my ($line, $file) = @_;
  diagnostic("appending to file $file: $line\n");
  if (! -e $file) {
    open(UN, ">$file")    or die("can't create $file: $!");
  }
  else {
    open(UN, ">>$file")   or die("can't open $file for append: $!");
  }
  print UN ("$line\n");
  close(UN)               or die("can't close $file: $!");
}


# prepend a line to the uninstall file
sub prependUninstall {
  my ($cmd) = @_;

  # read the file's contents
  my @lines = readFile($uninstall_file);

  # prepend the line
  @lines = ("$cmd\n", @lines);

  # write the new contents
  writeFile($uninstall_file, @lines);
}


# try to hup inetd automatically, but fall back to letting
# the user do it
sub hupInetdOrAskUser {
  if (!hupInetd()) {
    askQuestionNotSaved(
      "I failed to send inetd the HUP signal.  Please do so manually\n" .
      "(see kill(1)) in another shell and then press Enter here.\n" .
      "Enter: ",
      "");
  }
}


# find inetd's process id, and send it the HUP signal; return
# false if we fail
sub hupInetd {
  # grab process list
  my @procs = getAllProcesses();
  if (@procs < 1) {
    # failed to get process list
    return 0;
  }

  # filter for inetd
  my @inetd = grep { /inetd/ && /^\s*root/ } @procs;

  if (@inetd == 0) {        # too few
    print("Here's what I see:\n");
    printIndented(@procs);
    print("I don't see any process that looks like inetd.\n");
    return 0;
  }

  if (@inetd > 1) {         # too many
    print("I can't tell which of these is inetd:\n");
    printIndented(@procs);
    return 0;
  }

  # extract the process id
  my @temp = split(" ", $inetd[0]);
  my $inetdPid = $temp[1];
  print("I believe inetd is process id $inetdPid; sending HUP signal...\n");

  # send it the HUP signal
  if (!kill("HUP", $inetdPid)) {
    print("failed to HUP inetd: $!\n");
    return 0;
  }

  # wait a little, and do it again, since it often fails to
  # re-bind ports whose service handlers are changing
  sleep(3);
  if (!kill("HUP", $inetdPid)) {
    print("failed to HUP inetd: $!\n");
    return 0;
  }

  return 1;
}


# get the process list but without newlines
sub getAllProcesses {
  @res = getAllProcessesInner();
  for ($i = 0; $i < @res; $i++) {
    chomp($res[$i]);
  }
  return @res;
}


# return a list of all processes, with usernames in column 1,
# process ids in column 2, and executable names anywhere else;
# returns an empty list if it fails
sub getAllProcessesInner {
  # if user has told me how, use it, and assume it's correct
  if ($allProcsCmd) {
    return `$allProcsCmd`;
  }

  # for some OSes, I know how to do it
  if ($hostType eq "linux"    ||
      $hostType eq "solaris") {
    return `ps -aux`;
  }
  elsif ($hostType eq "hp"    ||
         $hostType eq "osf") {
    return `ps -ef`;
  }

  # try to figure out how to get a list of all processes

  # try /bin/ps -ef, which I at one point thought worked on
  # all systems, and is normal BSD method
  my @out = `/bin/ps -ef`;
  my @lineOne = split(" ", $out[0]);
  if ($lineOne[0] eq "USER" && $lineOne[1] eq "PID") {
    return @out;
  }

  # try ps -aux, which works on (all?) System V
  @out = `ps -aux`;
  @lineOne = split(" ", $out[0]);
  if ($lineOne[0] eq "USER" && $lineOne[1] eq "PID") {
    return @out;
  }

  # give up
  print("I couldn't figure out how to get a process list.\n");

  return ();
}


# the uninstall routine
sub doUninstall {
  # check for my commands list
  if (!-e $uninstall_file) {
    print("The uninstall routine requires $uninstall_file to exist;\n",
          "this file is generated automatically during an install.\n",
          "\n",
          "If you don't have this file, the steps to manually uninstall are:\n",
          "  - /etc/inetd.conf:\n",
          "    - remove (or comment-out) the 'safetp' line\n",
          "    - change 'raw-ftp' to 'ftp'\n",
          "    - send inetd the HUP signal\n",
          "  - /etc/services (optional):\n",
          "    - remove the 'safetp' and 'raw-ftp' lines\n",
          "  - cleanup user safetp (optional):\n",
          "    - remove /home/safetp\n",
          "    - delete the user 'safetp'\n",
          "  - remove /etc/safetp (optional)\n",
          "\n");
    exit(4);
  }

  # read the commands into a big string
  my $cmds = join("", readFile($uninstall_file));

  # evaluate them
  eval($cmds);
  if ($@) {
    die("uninstall failed: $@\n");
  }

  print("\n",
        "   --- SafeTP successfully uninstalled ---\n",
        "\n");
}


# read the contents of a file into an array of newline-terminated lines
sub readFile {
  my ($fname) = @_;

  open(FD, "<$fname")   or die("can't open $fname for reading: $!\n");
  my @ret = <FD>;
  close(FD)             or die("can't close $fname: $!\n");

  return @ret;
}


# write an array to a file; array elts are assumed to have newlines
sub writeFile {
  my ($fname, @lines) = @_;

  open(FD, ">$fname")   or die("can't open $fname for writing: $!\n");
  print FD @lines;
  close(FD)             or die("can't close $fname: $!\n");
}


# package a comment and a command as a perl string to be eval'd
sub packageCmd {
  my ($comment, $cmd) = @_;

  # assume we don't care to check the command for failure
  return qq[ print("$comment\\n"); system("$cmd"); ];
}


# append/prepend uninstall commands
sub appendUninstallCmd {
  appendUninstall(packageCmd(@_));
}
sub prependUninstallCmd {
  prependUninstall(packageCmd(@_));
}


# create a symbolic link, removing a prior *link*, if there is one
sub makeSymlink {
  my ($source, $dest) = @_;

  if ($source eq $dest) {
    # we're trying to link something to itself.. skip it
    return;
  }

  if (-l $dest) {
    # a link already exists, remove it
    run("rm $dest");
  }

  # finally, create the link
  run("ln -s $source $dest");
}


# ask a question, or if we already have an answer, use that
sub askStringQuestion {
  my ($question, $defaultAnswer) = @_;

  if (@savedAnswers > 0) {
    # use existing answer
    $ans = shift(@savedAnswers);
    diagnostic("using prior answer: $ans");
    return $ans;
  }

  # print question, get answer
  $ans = askQuestionNotSaved($question, $defaultAnswer);

  # save the answer for a future run
  appendState($ans);
  
  return $ans;
}


# ask a question, but don't use the saved-answers mechanism
sub askQuestionNotSaved {
  my ($question, $defaultAnswer) = @_;

  # print the question and the default answer
  print("\n");
  print($question);
  print("[$defaultAnswer]");
  if (length($defaultAnswer) > 15) {
    # put prompt on its own line
    print("\n> ");
  }
  else {
    # same-line prompt
    print(" > ");
  }

  # prompt for the answer
  if ($noninteractive) {
    $ans = "";                        # take the default
    print("(using default)\n");       # user input normally causes newlines
  }
  else {
    $ans = <STDIN>;                   # read from terminal
  }
  chomp($ans);
  if (!$ans) {
    # user just pressed Enter
    diagnostic("user pressed Enter");
    $ans = $defaultAnswer;
  }

  return $ans;
}


# ask a question with a yes/no answer
sub askBooleanQuestion {
  my ($question, $defaultAnswer) = @_;

  $response = askStringQuestion($question, $defaultAnswer? "y" : "n");
  if ($response eq "y") {
    return 1;
  }
  elsif ($response eq "n") {
    return 0;
  }
  else {
    forgetLastAnswer();

    # ask again
    return askBooleanQuestion(
      "You have to answer 'y' or 'n' to this question: ",
      $defaultAnswer);
  }
}


# at the top of a section; return true if the section needs to
# be executed, and false if it doesn't
sub startSection {
  if (@savedAnswers > 0) {
    # already did this section; skip it
    my $section = shift(@savedAnswers);
    diagnostic("skipping section: $section");
    return 0;
  }
  else {
    # haven't done the section
    return 1;
  }
}


# at the end of a section, mark it as done
sub endSection {
  ($name) = @_;

  diagnostic("end of section: $name");

  # at least for now, just append the name and that will suffice
  appendState($name);
}


# drop root privileges, assuming uid/gid given
sub dropRoot {
  my ($uid, $gid) = @_;

  if (!$dry_run) {    # can only do this when really running as root
    $EUID = $uid;
    $EGID = $gid;
  }
}


# resume root privileges
sub resumeRoot {
  if (!$dry_run) {
    $EUID = $UID;
    $EGID = $GID;
    if ($EUID != 0) {
      die("restoring uid failed..?!\n");
    }
  }
}


# try to get a fully-qualified domain name
sub getFQDN {
  # let's try this..
  $name = firstLine(`hostname`);
  if ($name =~ /\./) {
    # it has a dot, so it probably worked
    return $name;
  }

  if (system("/bin/sh -c dnsdomainname > /dev/null 2>&1") == 0) {
    # if it exists, append it
    $dn = `dnsdomainname`;
    if ($dn) {
      $name .= "." . firstLine($dn);
    }
  }

  return $name;
}


# rudimentary host detection
sub getHostType {
  my $type = firstLine(`uname -a`);

  if ($type =~ /Linux/) {
    $hostType = "linux";
  }
  elsif ($type =~ /SunOS/) {
    $hostType = "solaris";
  }
  elsif ($type =~ /HP-UX/) {
    $hostType = "hp";
  }
  elsif ($type =~ /OSF/) {
    $hostType = "osf";
  }
  else {
    $hostType = "unknown";
  }
}


# print a list of things with two spaces of indentation; newlines on
# the items will be chomped if present (so only one newline is printed)
sub printIndented {
  while ($line = shift(@_)) {
    chomp($line);
    print("  $line\n");
  }
}


# copy a real system file to a place a non-root user can manipulate it;
# also return the name of the dry run file
sub dryRunFile {
  my ($realFile, $dryFile) = @_;

  # only do this if it hasn't been done
  if (! -f $dryFile) {
    run("cp -f $realFile $dryFile");
  }

  return $dryFile;
}


# print a debugging message if we're in debug mode
sub diagnostic {
  my ($msg) = @_;

  if ($debug_mode) {
    print("diagnostic: $msg\n");
  }
}


# create a directory if it doesn't already exist
sub mkdirIfNotAlready {
  my ($dir) = @_;
  
  if (! -d $dir) {
    run("mkdir $dir");
  }
}


# yield the directory and basename of a path
sub splitFilename {
  my ($fn) = @_;

  ($dir = $fn) =~ s%/[^/]*$%/%;    # leave trailing /
  ($base = $fn) =~ s%^.*/%%;       # no leading /

  return ($dir, $base);
}

  
# yield just the name without the directory
sub basename {
  my ($fn) = @_;
  ($_, $base) = splitFilename($fn);
  return $base;
}