#####################
#####################
##
## Defines
##
#####################
#####################


#################################################################
#################################################################
#
# Option Handling
#
# Initialize a command-line option handling module for use in 
# testing: http://perldoc.perl.org/Getopt/Long.html.
#
# We can only call Getopt::Long::GetOptions once, but we wish to
# parse options specific to hook-subs as well as those specific 
# to client scripts. As a workaround, a client script can populate 
# the global @OPT_SPECS list with Getopt::Long option specifications
# _before_ including hook-subs. We would provide a subroutine here 
# 
#
#################################################################
use Getopt::Long;
@OPT_SPECS = ();
%OPTS = ();
$OPTS_PARSED = 0;

#################################################################
# register_opts
# 
# Arguments:
#   @optSpecs (list of option specifications to register)
# Returns: Nothing
#
# Register the given option specifications into our global array; 
# e.g. push @optSpecs onto @OPT_SPECS.
#
sub register_opts {
   my @optSpecs = @_;
   if ( ! $OPTS_PARSED ) {
      push @OPT_SPECS, @optSpecs;
   } else {
      log_debug("register_opts: unable to register " . scalar @optSpecs . " new specifications; options already parsed");
   }
}

#################################################################
# get_opts
#
# Arguments: None
# Returns: Nothing
#
# Thin wrapper around Getopt::Long::GetOptions; parse the option
# specifications registered with register_opts and store the
# option value in %OPTS.
#
# Handle any options specific to hook-subs that must be triggered
# immediately.
#
sub get_opts {
   if ( $OPTS_PARSED ) {
      log_debug("get_opts: options already parsed");
      return;
   }

   log_debug("get_opts: parsing " . scalar @OPT_SPECS . " option specifications");

   eval {
      GetOptions(\%OPTS, @OPT_SPECS);
   };
   if ($@) {
      log_warning("get_opts: error invoking Getopt::Long::GetOptions");
   } else
   {
      $OPTS_PARSED = 1;
   }

   # Set up logging to stdout if requested
   $OPTS{'logLevel'} =~ tr/A-Z/a-z/;
   if ( exists($logLevels{ $OPTS{'logLevel'} }) ) {
      log_init("&STDOUT", $logLevels{ $OPTS{'logLevel'} });
   }
}

################################################################
# Option Definitions
#
# Register the options specific to hook-subs. Note that the 
# client must call get_opts for these to become available.

register_opts("logLevel=s", # allow logging to stdout
              "noOp",       # fake run_command
              "print"       # run_command logs command strings (verbose)
             );


#################################################################
#################################################################
#
# Logging
#
# The following functions implement our hooks logging scheme.
# log_init is called first with the pathname to a logfile to use
# for future calls, and the logging verbosity level to associate 
# with this log. Subsequent calls to log_init add additional log 
# files, each with their own verbosity level. log_<level> 
# wrappers can then be used to write a message to any opened logs 
# with a sufficient verbosity level. log_close should then be 
# called to flush and close out open logfiles before exit.
#
#################################################################

#################################################################
# Logging verbosity levels
#

$ABORT = 0;
$logLevels{'abort'} = $ABORT;
$WARNING = 1;
$logLevels{'warning'} = $WARNING;
$ERROR = 2;
$logLevels{'error'} = $ERROR;
$INFO = 3;
$logLevels{'info'} = $INFO;
$DEBUG = 4;
$logLevels{'debug'} = $DEBUG;
$VERBOSE = 5;
$logLevels{'verbose'} = $VERBOSE;


#################################################################
# log_init
#
# Arguments:
#   $logFile (filename to use)
#   $logLevel (logging verbosity level to set)
# Returns: Nothing
#
# Create the logfile and allow anyone to write to it (mode bits rw-rw-rw-).
# The log will collect any messages with verbosity level <= $logLevel.
#
# Remember to call this as a user that has write access to the
# file/directory in question.
#
# Special case: if --logLevel=<level> has been specified on the command
# line, we avoid initing any log entries rather than the one on stdout.
#
# XXX - should this really set mode 666?
#
sub log_init {
   my ($logFile, $logLevel) = @_;
   my $numLogs = scalar keys %LOGS;

   $OPTS{'logLevel'} =~ tr/A-Z/a-z/;
   if ( exists($logLevels{ $OPTS{'logLevel'} }) && $numLogs > 0 ) {
      warn "Logging already initialized on stdout; not initing new log in '$logFile'";
      return;
   }

   my $logHandle;
   if ( !open($logHandle, ">>$logFile") ) {
      warn "Unable to create logfile '$logFile': $!";
      return;
   }
   if (-f $logFile) {
      chmod($mode_wrt, $logFile) || 
          warn "Unable to set logfile mode bits: chmod $mode_wrt $logFile: $!";
   }
   $LOGS{$logFile}{'handle'} = $logHandle;
   $LOGS{$logFile}{'level'} = $logLevel;
}

sub log_prefix {
   my ($prefix) = @_;
   foreach $logFile (keys %LOGS) {
      $LOGS{$logFile}{'prefix'} .= "$prefix: ";
   }
}


#################################################################
# log_close_one
#
# Arguments:
#   $logFile (filename to use)
# Returns: Nothing
#
# Close out the single specified log file.
#
sub log_close_one {
   my ($logFile) = @_;
   close($LOGS{$logFile}{'handle'}) or
       warn "Unable to close logfile '$logFile': $!";
   delete $LOGS{$logFile};
}

#################################################################
# log_close_except
#
# Arguments:
#   $logFiles (hash reference to log filenames)
# Returns: Nothing
#
# Close out all open log files except those appearing in the given
# hash of filenames. Used to close any additional logs opened by
# run-parts scripts.
#
sub log_close_except {
   my ($logFiles) = @_;
   foreach $logFile (keys %LOGS) {
      if ( ! exists( ${$logFiles}{$logFile} ) ) {
         log_close_one($logFile); # won't invalidate iterator over (keys %LOGS) copy
      }
   }
}


#################################################################
# log_close
#
# Arguments: None
# Returns: Nothing
#
# Close out all open log files.
#
sub log_close {
   log_close_except();
}


#################################################################
# log_copy
#
# Arguments:
#   $newLOGS (hash reference to target of copy)
#   $oldLOGS (hash reference to source of copy)
# Returns: Nothing
#
# Perform a deep copy between the given %LOGS hash references.
#
sub log_copy {
   my ($newLOGS, $oldLOGS) = @_;
   %{$newLOGS} = ();
   foreach $logFile (keys %{$oldLOGS}) {
      %{${$newLOGS}{$logFile}} = %{${$oldLOGS}{$logFile}};
   }
}


#################################################################
# log_write
#
# Arguments:
#   @logLevel (logging verbosity level of this message)
#   @message (message to write out)
# Returns: Nothing
#
# Write a message to any opened logfile whose logging verbosity
# level permits.
# Each line is stamped with the time and the user-id trying to log in.
#
# XXX - it'd be nice to not assume that $user will be set.  Indeed, at
# startup it won't be.
#
sub log_write {
  my ($logLevel, $logLevelStr, @message) = @_;
  my ($now);
  $now = localtime;
  $numLogs = scalar keys %LOGS;
  if ($numLogs > 0) {
     foreach $logFile (keys %LOGS) {
        if ($logLevel <= $LOGS{$logFile}{'level'})
        {
           print { $LOGS{$logFile}{'handle'} } $now, " ", $logLevelStr, " ", $LOGS{$logFile}{'prefix'}, @message, "\n";
        }
     }
  } else {
     if ($logLevel <= $INFO) {
        warn $now, " ", $logLevelStr, " ", @message, " (log unavailable)\n";
     }
  }
}


#################################################################
# log_<level>
#
# Arguments:
#   @message (message to log)
# Returns: Nothing
#
# Simple wrappers of log_write to pass along the relevant log level.
#
sub log_verbose {
   log_write $VERBOSE, '[VRBS]', @_;
}
sub log_debug {
   log_write $DEBUG, '[DEBG]', @_;
}
sub log_info {
   log_write $INFO, '[INFO]', @_;
}
sub log_warning {
   log_write $WARNING, '[WARN]', @_;
}
sub log_error {
   log_write $ERROR, '[ERROR]', @_;
}


#################################################################
# log_abort
#
# Arguments:
#   @message (abort message to log)
# Returns: Does not return
#
# Abort the script after writing a failure message
# Note: Exiting with a non-zero status causes LoginWindow under
# 10.1-10.3 to hang,  so we always exit cleanly.
# This is not a viable method for aborting a login process.
#
# XXX - how do we handle different abort cases in different hooks?
#
sub log_abort {
   log_write $ABORT, '[ABORT] ', @_;
   die @_;
}


#################################################################
#################################################################
#
# Hooks Control Utilities
#
#################################################################

#################################################################
# run_parts
#
# Arguments:
#   $type - type of hook parts to run
# Returns: Nothing (may abort)
#
# Runs all pertinent hook parts of the type specified
#
sub run_parts {
  my ($type) = @_;
  my ($saveduid, $savedgid);
  $saveduid = $>;
  $savedgid = $)+0;
  my $savedLOGS;
  log_copy(\%savedLOGS, \%LOGS);
  $ACTIVEHOOK = $type;
  if (!opendir(HOOKPARTS, "/etc/cmu/hooks/$type.d")) {
    log_warning("Could not open /etc/cmu/hooks/$type.d: $!");
  } else {
    while($file = readdir(HOOKPARTS)) {
      next if ($file eq "." || $file eq "..");
      switch_to_user($saveduid, $savedgid);
      eval {
        require "/etc/cmu/hooks/$type.d/$file";
      };
      if ($@) {
        log_error("Hook $file exited unexpectedly: $!");
      }
      log_close_except(\%savedLOGS);
      log_copy(\%LOGS, \%savedLOGS);
    }
    closedir(HOOKPARTS);
  }
}


#################################################################
# vouch
#
# Arguments:
#   @vars - list of variable NAMES to vouch for
# Returns: 1 if all variables appear to be sane, 0 otherwise
#
# vouch takes a list of variable names and verifies that they appear
# to be sane.  This means that they:
#    1) Are valid variables for use as defined by the API
#    2) Appear to have a (vaguely) sane value
# This lets you not worry 
sub vouch {
  my (@vars) = @_;
  
}


#################################################################
#################################################################
#
# File/directory creation, modification
#
#################################################################

#################################################################
# Mode bit settings for files and directories
#

$mode_shr = 0755; # Shared (Everyone can read, owner can write)
$mode_pvt = 0700; # Private directory (Only owner can read/write)
$mode_wrt = 0666; # World-writable file (Everyone can read/write)


#################################################################
# make_dir
#
# Arguments:
#   $uid - numeric uid of owner
#   $gid - numeric gid of owner
#   $mode - permissions for directory
#   $dir - full pathname of directory to create
# Returns: Nothing (may abort)
#
# Ensure that a directory exists and try to set the ownership and mode bits
# This routine tests to see if the directory already exists, 
# so you don't need to use the "-d" test in the main script.
#
# If the directory can't be created, aborts the script
# If the ownership or mode bits can't be set, report the error but continue
#
sub make_dir {
  my($uid, $gid, $mode, $dir) = @_;

  if (! -e $dir) {
    mkdir($dir) || log_abort "make_dir failure: mkdir '$dir' failed: $!";
  } elsif (! -d $dir) {
    # Something has that name, but it's not a directory. Abort.
    log_abort "make_dir failure: a file of the name '$dir' already exists";
  }

  chown($uid, $gid, $dir) ||
      log_warning "make_dir warning: chown $uid $gid $dir failed: $!";
  chmod($mode, $dir) ||
      log_warning "make_dir warning: chmod $mode $dir failed: $!";
}


#################################################################
# make_afsdir
#
# Arguments:
#   $dir - directory to be created
#   $acl - acl(s) to be set on the direction, in the same format
#          used by 'fs sa'.
# Returns: Nothing (may abort)
#
# Ensure that a directory exists and set the ACL if we created it
# Only set ACL if directory doesn't exist so that we don't override
# any ACL customizations performed by the user.
#
# If the directory can't be created, aborts the script
# If the ACL can't be set, report the error but continue
#
sub make_afsdir {
  my($dir, $acl) = @_;
  my($output);

  if (! -e $dir) {
    mkdir($dir) || log_abort "make_afsdir failure: mkdir '$dir' failed: $!";
  } elsif (!-d $dir) {
    # Something has that name, but it's not a directory. Abort.
    log_abort "make_afsdir failure: a file of the name '$dir' already exists";
  }
  $output = `fs setacl -dir '$dir' -acl $acl 2>&1`;
  log_warning "make_afsdir warning: fs setacl failed: $! $output"
      if ($? >> 8 != 0);
}


#################################################################
# make_link
#
# Create a symlink, if necessary
# If the link already exists, it doesn't verify it points to the right thing
# On error, aborts the script
#
sub make_link {
    my($orig, $link) = @_;

    if (-e $link && ! -l $link) {
        # Don't use run_command to avoid logging EISDIR errors
        system "rm -f '$link'";
        system "rm -rf $link'";
    }
    if (! -e $link) {
        symlink ($orig, $link)
            or log_abort "make_link failure: symlink $orig $link failed: $!";
    }
}


#################################################################
# find_afshomedir
#
# Find the official AFS home directory for the user
# All users have an entry in the "usr" directory, but that's just a symlink
# to one of the "usr0" through "usr25" directories:
# /afs/andrew.cmu.edu/usr/jackson -> ../usr25/jackson
#
sub find_afshomedir {
    my($user) = @_;

    my($result) = "/afs/andrew.cmu.edu/usr/$user";
    if ( !defined($_ = readlink $result) ) {
        log_abort "Can't read AFS home directory symlink for user $user: $!";
    }
    if ( ! s;../usr;/afs/andrew.cmu.edu/usr; ) {
        log_abort "Can't set AFS home directory for user $user";
    } else {
        $result = $_;
    }
    return $result;
}


#################################################################
# overquota
#
# If the given directory is over quota or we can't check the quota, 
# return true. If under quota, return false.
# Any errors are logged but the script continues to run.
#
sub overquota {
    my($afsdir) = @_;

    # Return this value if an error prevents us from looking at the quota info
    my($isover) = 1;

    # Run the command, saving both stdout and stderr in $quota
    my($quota) = `fs quota $afsdir 2>&1`;

    if (($? >> 8) != 0) {
        # If exec couldn't run the command, the error is in $!
        # If the command ran but exited with an error status, stderr is in $quota
        log_warning "Failed to run 'fs quota $afsdir': $! $quota";
    } else {
        # Chop off everything after the percent symbol
        # Sample output: "95% of quota used."
        $quota =~ s/%.*//;
        if ($quota !~ /[0-9]+/) {
            log_warning "Failed to parse output of 'fs quota': $quota";
        } else {
            $isover = ($quota > 99);
        }
    }
    return $isover;
}


#################################################################
# copy_file
#
# Copy a file if the original exists. Overwrite an existing destination only if 
# specified. If the copy is attempted and fails, return false (otherwise true).
#
sub copy_file {
    my($orig, $dest, $overwrite) = @_;

    return &copy($orig, $dest, $overwrite, 0);
}


#################################################################
# copy_tree
#
# Copy a directory tree if the original exists. Overwrite an existing
# destination only if specified. If the copy is attempted and fails,
# return false (otherwise true).
#
sub copy_tree {
    my($orig, $dest, $overwrite) = @_;

    return &copy($orig, $dest, $overwrite, 1);
}


#################################################################
# copy
#
# Implement the copy operation for all the copy_* functions
# Only copy if the original exists. Use the overwrite argument to determine
# whether to copy if the destination already exists.
# If the copy is attempted and fails, return false otherwise return true
#
sub copy {
    my($orig, $dest, $overwrite, $treemode) = @_;

    return 1
        if (! -e $orig or (-e $dest and ! $overwrite));

    my($command) = $treemode ? "cp -R" : "cp";
    return &run_command("$command '$orig' '$dest'");
}


#################################################################
#################################################################
#
# Methods of running commands
#
#################################################################

#################################################################
# run_command
#
# Similar to the "system" function but reports any errors encountered
#
sub run_command {
  my (@command) = @_;
  my ($output);
  
  my $commandStr = join(' ', @command);
 
  if ( exists ( $OPTS{'print'} ) ) {
    log_verbose("run_command: `" . $commandStr . "`");
  }
  if ( exists( $OPTS{'noOp'} ) ) {
    return 1;
  }

  # run the command but redirect stderr so we also collect it in $output
  $output = `$commandStr 2>&1`;
  chomp($output);

  # If exec couldn't run the command, the error is in $!
  # If the command ran but exited with an error status, stderr is in $output
  if ($? >> 8 != 0) {
    log_warning "Failed to run '$commandStr': $! $output";
    return 0;
  }

  return 1;
}


#################################################################
# run_command_bg
#
# 
sub run_command_bg {
  my ($command) = @_;
  my ($handler, $output);

  # Make sure we don't create zombie children
  $handler = $SIG{CHLD};
  $SIG{CHLD} = "IGNORE";

  if (fork == 0) {
    # run the command but redirect stderr so we also collect it in $output
    $output = `$command 2>&1`;

    # If exec couldn't run the command, the error is in $!
    # If the command ran but exited with an error status, stderr is in $output
    if ($? >> 8 != 0) {
      log_warning "Failed to run in background '$command': $! $output";
    }
    exit 0;
  } 

  # Restore our handler
  $SIG{CHLD} = $handler;
  return 1;
}


#################################################################
#
# hookwrap
# Run a few things without any chance of root access
#
# Since Perl doesn't realize that you can't drop the real user ID
# out of root without having the effective ID in root, and doesn't
# give you any way to do that, we need a C wrapper.
# Note that the wrapper ignores exec errors, so this works even if
# there's no personal loginhook file.
#
# afsquotd wasn't starting properly from run_command(),
# so we forego error checking and use system() directly.
#

sub hookwrap {
  system("/etc/cmu/hooks/bin/hookwrap $@");
}


#################################################################
#################################################################
#
# Dock Modification
#
#################################################################

sub dock_add {
    my ($spec, $id) = @_;
    if (system("grep -sx ".$id." $homedir/Library/Preferences/edu.cmu.andrew.dockupdate.txt")) {
        &run_command ("/etc/cmu/hooks/bin/mungedock -a " .
                    "$homedir/Library/Preferences/com.apple.dock.plist " . $spec
) || return 0;
        if (open (DOCKLOG, '>>', "$homedir/Library/Preferences/edu.cmu.andrew.dockupdate.txt")) {
            print DOCKLOG "$id\n";
            close(DOCKLOG);
            return 1;
        } else {
            log_warning "Failed to open edu.cmu.andrew.dockupdate.txt for update $id: $!";
            return 0;
        }
    } else {
        return 1;
    }
}

sub dock_fix_once {
    my ($spec, $id) = @_;
    if (system("grep -sx ".$id." $homedir/Library/Preferences/edu.cmu.andrew.dockupdate.txt")) {
        &run_command ("/etc/cmu/hooks/bin/mungedock -m " .
                    "$homedir/Library/Preferences/com.apple.dock.plist " . $spec) || return 0;
        if (open (DOCKLOG, '>>', "$homedir/Library/Preferences/edu.cmu.andrew.dockupdate.txt")) {
            print DOCKLOG "$id\n";
            close(DOCKLOG);
            return 1;
        } else {
            log_warning "Failed to open edu.cmu.andrew.dockupdate.txt for update $id: $!";
            return 0;
        }
    } else {
        return 1;
    }
}

sub dock_fix_always {
    my ($spec) = @_;
    return &run_command ("/etc/cmu/hooks/bin/mungedock -m " .
     "$homedir/Library/Preferences/com.apple.dock.plist " . $spec);
}


#################################################################
#################################################################
#
# Preferences Munging
#
#################################################################

sub ic_fix_once {
    my ($spec, $id) = @_;
    if (system("grep -sx ".$id." $homedir/Library/Preferences/edu.cmu.andrew.pre
fupdate.txt")) {
        &run_command ("/etc/cmu/hooks/bin/icmunge " .
                    "$homedir/Library/Preferences/com.apple.internetconfig.plist
 " . $spec) || return 0;
        if (open (DOCKLOG, '>>', "$homedir/Library/Preferences/edu.cmu.andrew.prefupdate.txt")) {
            print DOCKLOG "$id\n";
            close(DOCKLOG);
            return 1;
        } else {
            log_warning "Failed to open edu.cmu.andrew.prefupdate.txt for update $id: $!";
            return 0;
        }
    } else {
        return 1;
    }
}

sub ic_fix_always {
    my ($spec) = @_;
    return &run_command ("/etc/cmu/hooks/bin/icmunge " .
        "$homedir/Library/Preferences/com.apple.internetconfig.plist " . $spec);
}


#################################################################
#################################################################
#
# User Switching
#
#################################################################

sub switch_to_root {
  $) = 0;
  my ($newgid) = split(/ /, $));
  if ($newgid != 0) {
    log_error "switch_to_root: could not switch to group wheel: $!";
    # fall through...
  }
  $> = 0;
  if ($> != 0)
  {
    log_error "switch_to_root: could not switch to user root: $!";
    return 0;
  }

  return 1;
}

sub switch_to_user {
  my ($user, $group) = @_;
  my ($uid, $gid);
  if ($user =~ /^[0-9]+$/) {
    $uid = $user;
  } else {
    $uid = getpwnam($user);
    if (! defined $uid) {
      log_warning("switch_to_user: invalid user $user");
      return 0;
    }
  }
  ($group) = split(/ /, $group);
  if ($group =~ /^[0-9]+$/) {
    $gid = $group;
  } else {
    $gid = getgrnam($group);
    if (! defined $gid) {
      log_warning("switch_to_user: invalid group $group");
      return 0;
    }
  }
  
  $) = $gid;
  ($newgid) = split(/ /, $gid);
  if ($newgid != $gid)
  {
    log_error("switch_to_user: could not switch to group $group: $!");
    # fall through...
  }
  $> = $uid;
  if ($> != $uid) {
    log_error("switch_to_user: could not switch to user $user: $!");
    return 0;
  }

  return 1;
}

1;