install.pl

伯克利做的SFTP安全文件传输协议

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