#!/usr/bin/perl -w
# Copyright © 2001, 2003, 2004 Jamie Zawinski <jwz@dnalounge.com>
#
# Permission to use, copy, modify, distribute, and sell this software and its
# documentation for any purpose is hereby granted without fee, provided that
# the above copyright notice appear in all copies and that both that
# copyright notice and this permission notice appear in supporting
# documentation.  No representations are made about the suitability of this
# software for any purpose.  It is provided "as is" without express or 
# implied warranty.
#
# Created: 26-May-2001.
#
# This balances directories: it ensures that a set of target directories
# contain the same files as a template directory, by comparing write dates.
# It deletes and/or copies files as necessary to make them match.  It only
# deletes files if they have not been accessed within a specified time
# period.
#
# The idea is to run this on the kiosk's file server, to make sure that
# junk files don't build up in the various kiosks' home directories while
# they are being used.
#
# For root's crontab:
#
#    0,10,20,30,40,50 * * * * \
#       cd /home/guest/ ; ./kiosk-home-reset -v 600 share tmp,home/guest ??
#
# to compare /home/guest/share/ against /home/guest/01/, /home/guest/02/, etc.
# and only check the ./tmp/ and ./home/guest/ directories in each.
#

require 5;
use diagnostics;
use strict;
use bytes;

use Fcntl ':mode';

my $progname = $0; $progname =~ s@.*/@@g;
my $version = q{ $Revision: 1.16 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;

my $debug = 0;
my $verbose = 0;

# >0: files changed
# >1: files differences
# >2: files unchanged
# >3: all system calls
# >4: scan problems
# >5: all scans


my $kiosk_nick_reset = "/usr/local/sbin/kiosk-nick-reset";


# If these files exist in the target directory and not the source directory,
# we never delete them.
#
my $exempt_files = "(" . join('|',
  '^tmp/\.X11-unix/X0$',
  '^tmp/\.X0-lock$',
  '^tmp/\.xsession-errors$',
  '^tmp/orbit-guest/cookie$',
  '^tmp/orbit-guest/orb-\d+$',
  '^tmp/orbit-guest/linc-',
  '^tmp/orbit-guest/bonobo-',
  '^home/guest/\.mozilla/guest/[^/]+\.slt/Cache/',
  '^home/guest/\.mozilla/guest/[^/]+\.slt/history\.dat$',
  '^home/guest/\.mozilla/firefox/[^/]+\.default/Cache/',
  '^home/guest/\.mozilla/firefox/[^/]+\.default/history\.dat$',
  '^home/guest/\.fonts\.cache-1$',
  '^home/guest/\.gconf/[^/]+\.lock/',
  '^home/guest/\.gconfd/lock/',
  '^home/guest/\.xchat2/xchat\.conf$',   # kiosk-nick-reset handles this
  ) . ")";


# Returns a hash listing all the files in the directory and their stat info.
#
sub scan_directory {
  my ($base, $dir, $template_p, @files) = @_;

  my %hash;
  my $hashP = \%hash;

  if ($#files == -1) {
    scan_file (0, $template_p, $base, "", $dir, $hashP);
  } else {
    foreach my $dir2 (@files) {
      scan_file (0, $template_p, $base, $dir2, $dir, $hashP);
    }
  }

  return $hashP;
}


# The recursive guts of scan_directory
#
sub scan_file {
  my ($depth, $template_p, $base, $dir, $file, $hashP) = @_;

  my $path      = ($dir  eq '' ? $file : "$dir/$file");
  my $full_path = ($base eq '' ? $path : "$base/$path");
  $path      =~ s@//+@/@g; $path      =~ s@/+$@@g;
  $full_path =~ s@//+@/@g; $full_path =~ s@/+$@@g;

  my @st = ($depth == 0
            ?  stat($full_path)
            : lstat($full_path));
  my $mode = $st[2];

  if (!$st[1]) {
    print STDERR "$progname: unreadable file: $full_path\n"
      if ($verbose > 4);
    return;
  }

  error ("scan_file internal error") unless defined ($mode);

  my @subfiles = ();

  if (S_ISDIR($mode)) {

    my $read_p = 1;

    # Kludge!  Always pretend the template /tmp/ dir has no files in it.
    #
    if ($template_p && $path eq 'tmp') {
      print STDERR "$progname: assuming $full_path/ is empty\n"
        if ($verbose > 5);
      $read_p = 0;
    }

    if ($read_p) {
      local *DIR;
      if (! opendir(DIR, $full_path)) {
        print STDERR "$progname:  unreadable dir: $full_path\n"
          if ($verbose > 4);
        return;
      }
      @subfiles = sort readdir (DIR);
      closedir(DIR);
    }

  } elsif (S_ISLNK($mode)) {
    my $link = readlink($full_path);
    if (!defined($link) || $link eq '') {
      print STDERR "$progname: unreadable link: $full_path\n"
        if ($verbose > 4);
      return;
    }
    push @st, $link;
  }

  print STDERR "$progname:         scanned: $full_path\n"
    if ($verbose > 5);
  $hashP->{$path} = \@st;

  foreach my $subfile (@subfiles) {
    next if ($subfile eq '.' || $subfile eq '..');
    scan_file ($depth+1, $template_p, $base, $path, $subfile, $hashP);
  }
}


# Returns a sorted list of the keys in the table, but with
# all the directories moved to the front or the back (depending
# on the $front_p arg) depending on whether we need to process
# directories first or last.
#
sub sorted_dirs {
  my ($front_p, $table) = (@_);
  my @files = ();
  my @dirs = ();
  error ("no table to sort?") unless ($table);
  foreach my $name (keys %$table) {
    my $stP = $table->{$name};
    if (S_ISDIR($stP->[2])) {
      push @dirs, $name;
    } else {
      push @files, $name;
    }
  }

  @files = sort(@files);

  if ($front_p) {
    return (sort(@dirs), @files);
  } else {
    return (@files, sort({ $b cmp $a } @dirs));
  }
}


# converts a stat file type (S_IFMT) to english.
#
sub file_type_string {
  my ($mode) = @_;
  return "file"         if S_ISREG($mode);
  return "directory"    if S_ISDIR($mode);
  return "symlink"      if S_ISLNK($mode);
  return "block device" if S_ISBLK($mode);
  return "char device"  if S_ISCHR($mode);
  return "named pipe"   if S_ISFIFO($mode);
  return "socket"       if S_ISSOCK($mode);
  return "UNKNOWN";
}


# length of time as a string
#
sub duration_string {
  my ($secs) = @_;

  my $str;
  my $neg = ($secs < 0);
  $secs = -$secs if ($neg);

  if ($secs < 60) {
    $str = sprintf ("%d seconds", $secs);
  } elsif ($secs < (60 * 60 * 24 * 2)) {
    $str = sprintf ("%d:%02d:%02d",
                    ($secs / (60 * 60)) % 60,
                    ($secs / 60) % 60,
                    $secs % 60);
  } elsif ($secs < (60 * 60 * 24 * 365 * 1.1)) {
    $str = sprintf ("%d days", int ($secs / (60 * 60 * 24)));
  } else {
    $str = sprintf ("%.1f years", $secs / (60 * 60 * 24 * 365));
  }

  $str = "-$str" if ($neg);
  return $str;
}


# Whether the files differ in any significant (stattable) way.
# Returns 1 if owner/permissions differ;
# Returns 2 if contents differ.
#
sub files_differ_p {
  my ($path, $data1, $data2) = @_;

  my ($dev1, $ino1, $mode1, $nlink1, $uid1, $gid1, $rdev1, $size1,
      $atime1, $mtime1, $ctime1, $blksize1, $blocks1, $link1) = @$data1;
  my ($dev2, $ino2, $mode2, $nlink2, $uid2, $gid2, $rdev2, $size2,
      $atime2, $mtime2, $ctime2, $blksize2, $blocks2, $link2) = @$data2;

  my $perm1 = S_IMODE($mode1);
  my $perm2 = S_IMODE($mode2);
  my $type1 = S_IFMT($mode1);
  my $type2 = S_IFMT($mode2);

  my $diff = 0;

  if ($type1 != $type2) {
    print STDERR "$progname:    types differ: $path (" .
                 file_type_string ($type1) . ", "  .
                 file_type_string ($type2) . ")\n"
      if ($verbose > 1);
    return 2;  # say no more...
  }

  my $filep = S_ISREG($mode1);
  my $linkp = S_ISLNK($mode1);
  my $dirp  = S_ISDIR($mode1);

  error ("files_differ_p internal error") unless defined ($mode1);

  if ($dirp)     { $path .= "/"; }
  elsif ($linkp) { $path .= "@"; }

  if ($perm1 != $perm2) {
    print STDERR "$progname:    perms differ: $path " .
                 sprintf ("%04o, %04o)\n", $perm1, $perm2)
      if ($verbose > 1);
    $diff = 1;
  }

  if ($uid1 != $uid2) {
    print STDERR "$progname:     uids differ: $path ($uid1, $uid2)\n"
      if ($verbose > 1);
    $diff = 1;
  }

  if ($gid1 != $gid2) {
    print STDERR "$progname:     gids differ: $path ($gid1, $gid2)\n"
      if ($verbose > 1);
    $diff = 1;
  }

#  if ($filep && $mtime1 != $mtime2) {
#    print STDERR "$progname:   mtimes differ: $path (by " .
#          duration_string ($mtime2 - $mtime1) . ")\n"
#      if ($verbose > 1);
#    $diff = 1;
#  }

  if ($filep && $size1 != $size2) {
    print STDERR "$progname:    sizes differ: $path ($size1, $size2)\n"
      if ($verbose > 1);
    $diff = 2;
  }

  if ($linkp && $link1 ne $link2) {
    print STDERR "$progname:    links differ: $path ($link1, $link2)\n"
      if ($verbose > 1);
    $diff = 2;
  }

  return $diff;
}


# Whether the file has been accessed or modified recently
#
sub file_recently_used_p {
  my ($path, $data, $now, $age) = @_;

  my $cutoff_date = $now - $age;

  my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size,
      $atime, $mtime, $ctime, $blksize, $blocks, $link) = @$data;

  error ("file_recently_used_p internal error") unless defined ($mode);

  my $vpath = $path;
  if (S_ISDIR($mode))    { $vpath .= "/"; }
  elsif (S_ISLNK($mode)) { $vpath .= "@"; }

  if (S_ISDIR($mode)) {
    # claim that directories are always "not recently used", since the
    # act of listing a directory ticks its atime.
    return 0;

  } elsif ($atime >= $cutoff_date) {
    print STDERR "$progname:        accessed: $vpath (" .
          duration_string ($now - $atime) . ")\n"
      if ($verbose > 1);
    return 1;
  }

  if ($mtime >= $cutoff_date) {
    print STDERR "$progname:        modified: $vpath (" .
          duration_string ($now - $mtime) . ")\n"
      if ($verbose > 1);
    return 1;
  }

  return 0;
}


# Whether this file is on the list of "files we don't touch."
#
sub exempt_file_p {
  my ($path) = @_;
  return (($path =~ m@$exempt_files@so) ? 1 : 0);
}


# Copy the source file, directory, or symlink to the target, 
# preserving all attributes.
#
sub copy_file {
  my ($from, $from_data, $to, $to_data) = @_;
  return if ($debug);

  my $mode = $from_data->[2];

  error ("copy_file internal error") unless defined ($mode);

  if ($to_data->[1]) {
    return unless delete_file ($to, $to_data);
  }

  my $dirp = S_ISDIR($mode);

  if ($dirp) {
    if (! mkdir ($to, $mode)) {
      print STDERR "$progname:     mkdir ERROR: $to: $!\n" if ($verbose > 0);
      return;
    }
  } else {
    my @cmd = ("cp", "-a", $from, $to);
      print STDERR "$progname:            exec: " . join(" ", @cmd) . "\n"
        if ($verbose > 3);
    system @cmd;

    my $exit_value  = $? >> 8;
    my $signal_num  = $? & 127;
    my $dumped_core = $? & 128;
    if ($verbose > 0) {
      if ($dumped_core) {
        print STDERR "$progname:        cp ERROR: $to: core dumped\n";
      } elsif ($signal_num) {
        print STDERR "$progname:        cp ERROR: $to: signal $signal_num\n";
      } elsif ($exit_value) {
        print STDERR "$progname:        cp ERROR: $to: exit $exit_value\n";
      }
    }
  }
}


# Updates the user, group, permissions, access time, and mod time of
# the file to match the "from_data".
#
sub chmod_file {
  my ($path, $from_data, $to_data) = @_;
  return if ($debug);

  my ($dev1, $ino1, $mode1, $nlink1, $uid1, $gid1, $rdev1, $size1,
      $atime1, $mtime1, $ctime1, $blksize1, $blocks1, $link1) = @$from_data;
  my ($dev2, $ino2, $mode2, $nlink2, $uid2, $gid2, $rdev2, $size2,
      $atime2, $mtime2, $ctime2, $blksize2, $blocks2, $link2) = @$to_data;

  my $perm1 = S_IMODE($mode1);
  my $perm2 = S_IMODE($mode2);

  if ($perm1 != $perm2) {

    print STDERR "$progname:           chmod: $perm1, $path\n"
      if ($verbose > 3);
    if (! chmod ($perm1, $path)) {
      print STDERR "$progname:     chmod ERROR: $path: $!\n";
    }
  }

  if ($uid1 != $uid2 || $gid1 != $gid2) {
    print STDERR "$progname:           chown: $uid1, $gid1, $path\n"
      if ($verbose > 3);
    if (! chown ($uid1, $gid1, $path)) {
      print STDERR "$progname:     chown ERROR: $path: $!\n";
    }
  }

  if ($atime1 != $atime2 || $mtime1 != $mtime2) {
    print STDERR "$progname:           utime: $atime1, $mtime1, $path\n"
      if ($verbose > 3);
    if (! utime ($atime1, $mtime1, $path)) {
      print STDERR "$progname:     utime ERROR: $path: $!\n";
    }
  }
}


# Deletes the file or directory.  Does not delete non-empty directories.
#
sub delete_file {
  my ($path, $data) = @_;
  return if ($debug);

  my $mode = $data->[2];

  error ("delete_file internal error") unless defined ($mode);

  my $dirp = S_ISDIR($mode);

  my $ok;
  if ($dirp) {
    print STDERR "$progname:           rmdir: $path\n" if ($verbose > 3);
    $ok = rmdir ($path);
    if (! $ok) {
      # quieter about "directory not empty" errors
      print STDERR "$progname:     rmdir ERROR: $path: $!\n" if ($verbose > 1);
    }
  } else {
    print STDERR "$progname:          unlink: $path\n" if ($verbose > 3);
    $ok = unlink ($path);
    if (! $ok) {
      print STDERR "$progname:    unlink ERROR: $path: $!\n" if ($verbose > 0);
    }
  }
  return $ok;
}


# Given two directory hashes, makes the second look like the first:
# - copies files from `from' into `to' that differ or are absent;
# - deletes files in `to' that are not in `from'.
#
sub reset_dir {
  my ($age,
      $from_dir, $from_data,
      $to_dir, $to_data)
    = @_;

  my $now = time;

  # iterate over `from' and compare to `to'
  #
  foreach my $from_file (sorted_dirs (1, $from_data)) {
    my $from_stP = $from_data->{$from_file};
    my $to_stP   = $to_data  ->{$from_file};
    my @from_st = ($from_stP ? @$from_stP : ());
    my @to_st   = ($to_stP   ? @$to_stP   : ());

    my $path = "$to_dir/$from_file";
    my $vpath = $path;

    error ("reset_dir internal error") unless defined ($from_st[2]);

    if (S_ISDIR($from_st[2]))    { $vpath .= "/"; }
    elsif (S_ISLNK($from_st[2])) { $vpath .= "@"; }

    if (! $to_st[1]) {
      print STDERR "$progname:          create: $vpath\n" if ($verbose > 0);
      copy_file ("$from_dir/$from_file", $from_stP,
                 $path, $to_stP);

    } else {

      if (exempt_file_p ($from_file)) {
        print STDERR "$progname:          exempt: $vpath\n" if ($verbose > 2);
        next;
      }

      my $diff = files_differ_p ($path, $from_stP, $to_stP);

      if ($diff == 0) {
        print STDERR "$progname:              ok: $vpath\n" if ($verbose > 2);
      } elsif (file_recently_used_p ($path, $to_stP, $now, $age)) {
        print STDERR "$progname:          in use: $vpath\n" if ($verbose > 1);
      } elsif ($diff == 1) {
        print STDERR "$progname:          update: $vpath\n" if ($verbose > 0);
        chmod_file ($path, $from_stP, $to_stP);
      } else {
        print STDERR "$progname:         replace: $vpath\n" if ($verbose > 0);
        copy_file ("$from_dir/$from_file", $from_stP,
                   $path, $to_stP);
      }
    }
  }

  # iterate over `to' and compare to `from'
  #
  foreach my $to_file (sorted_dirs (0, $to_data)) {
    my $from_stP = $from_data->{$to_file};
    my $to_stP   = $to_data  ->{$to_file};
    my @from_st = ($from_stP ? @$from_stP : ());
    my @to_st   = ($to_stP   ? @$to_stP   : ());

    my $path = "$to_dir/$to_file";
    my $vpath = $path;

    error ("reset_dir internal error (2)") unless defined ($to_st[2]);

    if (S_ISDIR($to_st[2]))    { $vpath .= "/"; }
    elsif (S_ISLNK($to_st[2])) { $vpath .= "@"; }

    if (exempt_file_p ($to_file)) {
      print STDERR "$progname:          exempt: $vpath\n" if ($verbose > 2);
      next;
    }

    if (! $from_st[1]) {
      my $dirp = S_ISDIR($to_st[2]);

      print STDERR "$progname:          delete: $vpath\n"
        # quieter about deleting directories (since we often try to delete
        # directories that are not yet empty.)
        if ($dirp ? ($verbose > 1) : ($verbose > 0));
      delete_file ($path, $to_stP);
    }
  }
}


sub reset_dirs {
  my ($age, $template_root, $dirs, @target_roots) = @_;

  my $now = time;

  $dirs =~ s/\s*(,\s*)+/,/g;
  my @dirs = split(',', $dirs);
  if ($#dirs < 0) { usage(); }
  $dirs = undef;

  $template_root =~ s@/+$@@;

  my $template_data = scan_directory ($template_root, "", 1, @dirs);

  foreach my $target_root (@target_roots) {
    print STDERR "\n" if ($verbose > 2);
    my $target_data = scan_directory ($target_root, "", 0, @dirs);
    print STDERR "\n" if ($verbose > 5);
    reset_dir ($age,
               $template_root, $template_data,
               $target_root,   $target_data);
  }
}


sub reset_nicks {
  my (@dirs) = @_;
  foreach my $dir (@dirs) {
    my $cmd = "cd $dir; $kiosk_nick_reset kiosk$dir";
    my @cmd = ("/bin/sh", "-c", $cmd);
    print STDERR "$progname:            exec: $cmd\n" if ($verbose > 2);

    return if ($debug);

    print STDERR "$progname:            exec: " . join(" ", @cmd) . "\n"
      if ($verbose > 3);
    system @cmd;

    my $exit_value  = $? >> 8;
    my $signal_num  = $? & 127;
    my $dumped_core = $? & 128;
    if ($verbose > 0) {
      if ($dumped_core) {
        print STDERR "$progname: $kiosk_nick_reset: core dumped\n";
      } elsif ($signal_num) {
        print STDERR "$progname: $kiosk_nick_reset: signal $signal_num\n";
      } elsif ($exit_value) {
        print STDERR "$progname: $kiosk_nick_reset: exit $exit_value\n";
      }
    }
  }
}


sub error {
  ($_) = @_;
  print STDERR "$progname: $_\n";
  exit 1;
}

sub usage {
  print STDERR "usage: $progname [--verbose] [--debug] " .
                                "age template-root dirs [ target-root ... ]\n";
  exit 1;
}

sub main {
  my $age;
  my $template_root;
  my @target_roots = ();
  my $dirs;

  while ($_ = $ARGV[0]) {
    shift @ARGV;
    if ($_ eq "--verbose") { $verbose++; }
    if ($_ eq "--debug") { $debug++; }
    elsif (m/^-v+$/) { $verbose += length($_)-1; }
    elsif (m/^-d+$/) { $debug += length($_)-1; }
    elsif (m/^-./) { usage; }
    elsif (!$age) { $age = $_; }
    elsif (!$template_root) { $template_root = $_; }
    elsif (!$dirs) { $dirs = $_; }
    else { push @target_roots, $_; }
  }

  if (!$age || !$template_root || !$dirs || $#target_roots < 0) { usage; }

  my @dirs = split(',', $dirs);
  if ($#dirs < 0) { usage; }

  reset_dirs ($age, $template_root, $dirs, @target_roots);
  reset_nicks (@target_roots);
}

main;
exit 0;