#!/usr/local/bin/perl 
#
#
# mirror
#
# Program for maintaining a mirror backup of specified directories
#
# Copyright (c) 2001 by Ardan Patwardhan. All rights reserved.
#
# DISCLAIMER
# This software is provided on an ``as is'' and any express or implied
# warranties, including, but not limited to, the implied warranties of
# merchantability and fitness for a particular purpose are disclaimed. 
# In no event shall the copyright owner be liable for any direct, 
# indirect, incidental, special, exemplary, or consequential damages 
# (including, but not limited to, procurement of substitute goods or 
# services; loss of use, data, or profits; or business interruption) 
# however caused and on any theory of liability, whether in contract, 
# strict liability, or tort (including negligence or otherwise) arising 
# in any way out of the use of this software, even if advised of the 
# possibility of such damage. 
#
# $Header: /usr/users/ardan/cvsroot/perl/mirror,v 1.20 2002/01/03 13:31:15 ardan Exp $
#


# Program version
my $VERSION = '$Revision: 1.20 $';


########################################################################
#                                                                      #
# COMMAND LINE PROCESSING                                              #
#                                                                      #
########################################################################

use Getopt::Std;
getopt('c',\%opts);    # Configuration file
die "No config file specified, stopped" unless ($configMod = $opts{c});
die "Unable to read config file, stopped" unless (do $configMod);



# The following lines up to the main block should be cut and paste into
# a separate resource file. The file is specified for inclusion using the
# -c option. The lines with "##" need to be uncommented and modified.

########################################################################
#                                                                      #
# CONFIGURATION                                                        #
#                                                                      #
########################################################################

# Used to identify this config in the log 
##$reportId = "Ardan's home directory";

# Directories to mirror
##@dirList = ("/usr/users/ardan");

# List of patterns specifying files and directories that should be
# excluded. Use Perl regular expression syntax
##@excludeList = ('~$',                 # Emacs old files
##                '.saves-',            # Emacs .saves files
##                '#\w+(\.\w+)*#$',     # Emacs backup files
##                '/core$',             # Core dumps
##                'junk',               # Junk files and directories
##                 );

# Where to create mirror 
##$mirror = "/f15/ardan/tmp1";

# Size limit of mirror in bytes. 
##$mirrorSizeLimit = 100000000;          

# Mirror log file
##$mirrorLog = "/usr/users/ardan/mirror.log";

# If space allows, the mirror of a modified file is not simply deleted,
# but instead copied to a file with a name extended by a suffix
# consisting of the prefix given below and the time when the file in
# in the mirror was modified.
##$mirrorSuffixPrefix = ".mirr";  

# The fraction of the extra space available within the the mirrorSizeLimit
# that can be used to backup the mirror of a modified file. Should be 
# between 0 and 1.0. The justification behind introducing this parameter 
# is to prevent situations in which single large files basically gulp up 
# all the available extra space resulting in the deletion of many smaller 
# secondary backup files. If this is not a problem, set it to 1.  
##$mirrorBackupFrac = 1.0;

# Grace period for obsolete files in days. Note that there is no 
# guarantee that obsolete files that have been modified more recently
# will not be deleted - only that they will be deleted as a last 
# resort to make room.
##$obsoleteGracePeriod = 30;

# Space needed to create an empty directory in bytes
##$dirSpaceAlloc = 512;


########################################################################
#                                                                      #
# MAIN BODY                                                            #
#                                                                      #
########################################################################

# USE statements
use File::Copy;
use File::Find;
use File::Path;
use File::Spec::Functions;



# Variables and Data structures
%hashOfSource  = ();         # Hash of files, direcories and symbolic links in source
%hashOfMirror = ();          # Hash of everything in the mirror
%hashOfDeleted = ();         # Hash of deleted files and directories
%hashOfLinks = ();           # Hash of symbolic links in the source
@obsoleteFiles = ();         # List of obsolete files and symbolic links
@obsoleteDir = ();           # List of obsolete directories
@failDir     = ();           # Directories that could not be accessed
@copiedFiles = ();           # List of files copied from source to mirror  
@dirCreated  = ();           # Directories created on mirror  
@linksCreated = ();          # Links created on mirror 
$sourceSize = 0;             # Total size of files and directories in source
$currMirrorSize = 0;         # Used to keep track of the current size of the mirror


# Create a hash table of all the files, etc, in the directories that are to
# be mirrored
foreach my $dir (@dirList) {
   if(! -d $dir) {
      push @failDir, ($dir);
      next;
   }       
   find {wanted => sub {
      my @fileInfo = getFileInfo($File::Find::name);
      $sourceSize += $fileInfo[3];
      $hashOfSource{$File::Find::name} = [ @fileInfo ];
   }, follow => 0}, "$dir";
}



# Exclude files and directories that match exclude patterns
foreach my $pat (@excludeList) {
   foreach my $file (keys %hashOfSource) {
      if($file =~ m/$pat/) {
         $sourceSize -= @{$hashOfSource{$file}}[3];
         delete $hashOfSource{$file};
      }
   }
}



# Create lists of directories and files in source directory
@sourceDirList = map { (-d $_ && !(-l $_))?$_:() } sort keys %hashOfSource; # Sorted (by name) list of source directories
@keyList = sort { @{$hashOfSource{$a}}[3] <=> @{$hashOfSource{$b}}[3] } keys %hashOfSource; # Sort by file size
@sourceFileList = map { (-f $_ && !(-l $_))?$_:() } @keyList;



# Create a hash table of symbolic links that link to something in the
# source hash table. If it links to something else - just delete it
# from the source hash table.
foreach my $file (@keyList) {
   next unless(-l $file);
   my $target = readlink($file);
   if(!File::Spec->file_name_is_absolute($target)) {
      my ($vol, $dir, $file1) = File::Spec->splitpath($file);
      my $base = File::Spec->catpath($vol,$dir,"");
      # The next line will not always work
      # rel2abs doesnt handle target names that have ".."
      $target = File::Spec->canonpath(File::Spec->rel2abs($target,$base));
   }
   if(exists $hashOfSource{$target}) {
      $hashOfLinks{$file} = $target;
   } else {
      # Delete link for source hash
      $sourceSize -= @{$hashOfSource{$file}}[3];
      delete $hashOfSource{$file};
   } 
}



# Create a hash table of all the files in the mirror
find sub {
   my @fileInfo = getFileInfo($File::Find::name);
   $currMirrorSize += $fileInfo[3];   # Has to include size of mirror directory
   if($File::Find::name ne $mirror) {
      $hashOfMirror{$File::Find::name} = [ @fileInfo ];
   }
}, $mirror;



# When a file has been modified compared with its mirror, this program, 
# assuming that there is space available, moves the mirror version to 
# a file which has a special suffix before copying the file from the 
# source to the mirror. If not enough space is available, the suffixed
# files are deleted in date ordered manner, until enough space 
# is available.The following list keeps track of the date
# ordered suffixed files.
@keyList = map { ($_ =~ m/$mirrorSuffixPrefix[0-9]+$/)?$_:() } %hashOfMirror;
@mirrorBackupList = sort { ($a =~ m/([0-9]+)$/)[0] <=> ($b =~ m/([0-9]+)$/)[0] } @keyList;



# Create lists of files and directories in mirror that have been deleted 
# in the source. 
foreach my $file (keys %hashOfMirror) {
   unless($file =~ m/$mirrorSuffixPrefix[0-9]+$/) {
      my $sourceFile = ($file =~ m/$mirror(.+)$/)[0];
      if($sourceFile) {
	 if( (-f $file) && !(-e $sourceFile)){
            push @obsoleteFiles, ($file);
	 } elsif ( (-d $file) && !(-e $sourceFile)) {
            push @obsoleteDir, ($file);
	 }
      }
   }
}
# Sort files by modification times
@obsoleteFiles = sort { @{$hashOfMirror{$a}}[4] <=> @{$hashOfMirror{$b}}[4] } @obsoleteFiles;
# Sort list by reverse string length so subdirectories are first
@obsoleteDir   = sort { length($b) <=> length($a) } @obsoleteDir;



# Copy directories
foreach my $dir (@sourceDirList) {
   my @dirFragments = File::Spec->splitdir($dir);
   my $destDir = $mirror;
   foreach my $dirFrag (@dirFragments) {
      $destDir = File::Spec->catdir($destDir,$dirFrag);
      # At present, if $destDir is a symbolic link to a directory, the 
      # following block is not executed
      unless(-d $destDir && !(-l $destDir)) {
         if(-e $destDir) {
            # Remove file so that it can be replaced with a directory
            rmtreeWithStat($destDir);
         }      
	 die "Not enough space in mirror for $destDir, stopped" unless(checkSpace($dirSpaceAlloc));
         mkdirWithStat($destDir);
      }
   }     
}



# Copy files
foreach my $file (@sourceFileList) {
   my $destFile = File::Spec->canonpath(File::Spec->catfile($mirror,$file));
   my $destDir = parentDir($destFile);
   my @sourceStatus = stat($file);
   my $sourceFileSize = $sourceStatus[7];
   # Check if destination file exists, and if so, whether the
   # source file has been modified more recently. 
   if(-f $destFile && !(-l $destFile)) {
      my $mtimeSource = $sourceStatus[9];
      my @destStatus = stat($destFile);
      my $mtimeDest = $destStatus[9];
      if($mtimeSource > $mtimeDest) {
         my $destFileSize = $destStatus[7];
         if($destFileSize < $mirrorBackupFrac * ($mirrorSizeLimit - $sourceSize)) {
            my $destBackupFile = join("",$destFile,$mirrorSuffixPrefix,$mtimeDest);
            move($destFile,$destBackupFile);
	    push @mirrorBackupList, ($destBackupFile);
	    die "Not enough space in mirror for $destFile, stopped" unless(checkSpace($sourceFileSize));
            fileCopyWithStat($file,$destFile);
	 } else {
            unlinkWithStat($destFile);
	    die "Not enough space in mirror for $destFile, stopped" unless(checkSpace($sourceFileSize));
	    fileCopyWithStat($file,$destFile);
	 }
      }
   } else {
      # Maybe destFile is something else? If so remove it!
      if(-e $destFile) {
         rmtreeWithStat($destFile);
      }
      die "Not enough space in mirror for $destFile, stopped" unless(checkSpace($sourceFileSize));
      fileCopyWithStat($file,$destFile);
   }
}



# Create links
foreach my $file (keys %hashOfLinks) {
   my $destLink = File::Spec->canonpath(File::Spec->catfile($mirror,$file));
   my $target = File::Spec->canonpath(File::Spec->catfile($mirror,$hashOfLinks{$file}));
   if ((-l $destLink && $target ne (readlink $destLink)) || (!(-l $destLink) && -e $destLink)) {
      rmtreeWithStat($destLink);
   }
   linkWithStat($target,$destLink) unless (-l $destLink);
}



# Update info on directories created
if(@dirCreated) {
   foreach my $dir (@dirCreated) {
      $hashOfMirror{$dir} = [ getFileInfo($dir) ];
   }
}



# Append activity to mirror log file
exit unless (@copiedFiles||@dirCreated||%hashOfDeleted||@failDir||@linksCreated);
open(MIRLOG, ">> $mirrorLog") || die "can't open $mirrorLog: $!";
printf(MIRLOG "\n");
printf(MIRLOG "MIRROR REPORT BEGIN\n");
@timeList = niceTime(time);
printf(MIRLOG "Prepared for %s on %d\/%d\/%d at %d:%02d:%02d \n\n", $reportId,$timeList[5],$timeList[4],$timeList[3],$timeList[2],$timeList[1],$timeList[0]);
printf(MIRLOG "Mirror size limit(bytes)  : %d\n", $mirrorSizeLimit);
printf(MIRLOG "Current mirror size(bytes): %d\n", $currMirrorSize);
printf(MIRLOG "Source size(bytes)        : %d\n", $sourceSize);
printf(MIRLOG "\n\n\n");

# Output list of copied files
$txt = "Files copied from source to mirror";
printFileList(\@copiedFiles,\%hashOfSource,\*MIRLOG,\$txt);

# Output list of directories created on mirror
$txt = "Directories created on mirror";
printFileList(\@dirCreated,\%hashOfMirror,\*MIRLOG,\$txt);

# Output list of symbolic links
$txt = "Symbolic links created on mirror";
printFileList(\@linksCreated,\%hashOfMirror,\*MIRLOG,\$txt);

# Output list of stuff deleted from mirror
$txt = "Deleted from mirror";
printFileList([sort keys %hashOfDeleted],\%hashOfDeleted,\*MIRLOG,\$txt);

# Output list of directories not accessed
if(@failDir) {
   printf(MIRLOG "Unable to access following directories: \n\n");
   foreach my $dir (sort @failDir) {
      printf(MIRLOG "%s\n",$dir);
   }
   printf(MIRLOG "\n\n\n");
}

printf(MIRLOG "MIRROR REPORT END\n\n\n");

close MIRLOG;





########################################################################
#                                                                      #
# SUBROUTINES                                                          #
#                                                                      #
########################################################################

# Get current time into nice format
sub niceTime {
   my ($time) = @_;
   my @timeList = localtime($time);
   $timeList[4] += 1;      # Month 1->12
   $timeList[5] += 1900;   # Year
   return @timeList;
}



# Get mode into nice format
sub niceMode {
use Fcntl ':mode';
   my ($mode) = @_;
   my @modeList = ();
   $modeList[0] = ($mode & S_IXUSR)?'x':'-';
   $modeList[1] = ($mode & S_IWUSR)?'w':'-';
   $modeList[2] = ($mode & S_IRUSR)?'r':'-';
   $modeList[3] = ($mode & S_IXGRP)?'x':'-';
   $modeList[4] = ($mode & S_IWGRP)?'w':'-';
   $modeList[5] = ($mode & S_IRGRP)?'r':'-';
   $modeList[6] = ($mode & S_IXOTH)?'x':'-';
   $modeList[7] = ($mode & S_IWOTH)?'w':'-';
   $modeList[8] = ($mode & S_IROTH)?'r':'-';
   if (S_ISDIR($mode)) {
      $modeList[9] = 'd';
   } elsif (S_ISLNK($mode)) {
      $modeList[9] = 'l';
   } elsif (S_ISBLK($mode)) {
      $modeList[9] = 'b';
   } elsif (S_ISCHR($mode)) {
      $modeList[9] = 'c';
   } elsif (S_ISFIFO($mode)) {
      $modeList[9] = 'p';
   } elsif (S_ISSOCK($mode)) {
      $modeList[9] = 's';
   } elsif (S_ISREG($mode)) { 
      $modeList[9] = '-';
   } else {
      $modeList[9] = '?';
   }
   my $modeText = sprintf("%s%s%s%s%s%s%s%s%s%s",$modeList[9],$modeList[2],$modeList[1],$modeList[0],$modeList[5],$modeList[4],$modeList[3],$modeList[8],$modeList[7],$modeList[6]);
   return $modeText;
}



# Output list of files
sub printFileList {
   my ($fileList, $hashOfFiles,$FD, $txt) = @_;
   if(@$fileList) {
      printf($FD "%s:\n\n", $$txt);
      printf($FD "      Mode     Date     Time                Size      Owner      Group File-name\n");
      printf($FD "==========================================================================================\n");
#                      drwxr-xr-x 20011210 16:17:05                 512      ardan     system /f14/ardan
      foreach $file (sort @$fileList) {
         @fileInfo = @{$$hashOfFiles{$file}};
         ($mode, $user, $group, $size, $mtime) = @fileInfo;
         @timeList = niceTime($mtime);
         $modeText = niceMode($mode);
         printf($FD "%s %d%02d%02d %02d:%02d:%02d %19d %10s %10s %s\n",$modeText,$timeList[5],$timeList[4],$timeList[3],$timeList[2],$timeList[1],$timeList[0],$size,$user,$group,$file);
      }
      printf($FD "\n\n\n");
   }
}



# Get file info in format stored in hash tables in this program
sub getFileInfo {
   my ($dest) = @_;

   my @fileStatus = ();
   if(-l $dest) {
      @fileStatus = lstat($dest);
   } else {
      @fileStatus = stat($dest);
   }
   my $mode  = $fileStatus[2];
   my $user  = getpwuid($fileStatus[4]);
   my $group = getgrgid($fileStatus[5]);
   my $size  = $fileStatus[7];
   my $mtime = $fileStatus[9];
   return ($mode, $user, $group, $size, $mtime);
}



# Copy file and keep track of space in mirror
sub fileCopyWithStat {
  use File::Copy;
   my ($source, $dest) = @_;

   my ($vol, $dir, $file1)  = File::Spec->splitpath($dest);
   my $destDir = File::Spec->catpath($vol,$dir,"");
   my $destDirSizeOld = (stat($destDir))[7];
   copy($source,$dest) or die "copy failed: $!";
   push @copiedFiles, ($source);
   $hashOfMirror{$dest} = [ getFileInfo($dest) ];
   my $destFileSize = (stat($dest))[7];
   my $destDirSizeNew = (stat($destDir))[7];
   $currMirrorSize += $destFileSize + ($destDirSizeNew - $destDirSizeOld);
   return;
}



# Create symbolic link and keep track of space in mirror
sub linkWithStat {
   my ($target, $link) = @_;

   my ($vol, $dir, $file1)  = File::Spec->splitpath($link);
   my $linkDir = File::Spec->catpath($vol,$dir,"");
   my $linkDirSizeOld = (stat($linkDir))[7];
   symlink($target,$link) or die "symlink failed: $!";
   push @linksCreated, ($link);
   $hashOfMirror{$link} = [ getFileInfo($link) ];
   my $linkFileSize = (lstat($link))[7];
   my $linkDirSizeNew = (stat($linkDir))[7];
   $currMirrorSize += $linkFileSize + ($linkDirSizeNew - $linkDirSizeOld);
   return;
}



# Make directory and keep track of space in mirror
sub mkdirWithStat {
   my ($destDir) = @_;
   
   my $pDir = parentDir($destDir);
   my $destParentDirSizeOld = (stat($pDir))[7];
   mkdir $destDir;   # Use default permissions
   push @dirCreated, ($destDir);
   $hashOfMirror{$destDir} = [ getFileInfo($destDir) ];
   my $size = (stat($destDir))[7];
   my $destParentDirSizeNew = (stat($pDir))[7];
   $currMirrorSize += $size + ($destParentDirSizeNew - $destParentDirSizeOld);
   return;
}



# Remove file and keep track of space in mirror
# Return the amount of space made
sub unlinkWithStat {
   my ($file) = @_;

   my $size = 0;
   if(-l $file) {
      $size  = (lstat($file))[7];
   } else {
      $size = (stat($file))[7];
   }
   my $dir = parentDir($file);
   my $dirSizeOld = (stat($dir))[7];
   unlink $file or die "unlinkWithStat failed: $!";
   $hashOfDeleted{$file} = $hashOfMirror{$file};
   delete $hashOfMirror{$file};
   my $dirSizeNew = (stat($dir))[7];
   my $space = $size + ($dirSizeOld - $dirSizeNew);
   $currMirrorSize -= $space;
   return $space;
}



# Remove tree and keep track of space in mirror
# Return the amount of space made or -1 if unable to delete tree
sub rmtreeWithStat {
  use File::Path;
   my ($dir) = @_;

   my $size  = diskUsage($dir);
   my $pDir = parentDir($dir);
   my $dirSizeOld = (stat($pDir))[7];
   rmtree($dir,0,1) or return -1;
   $hashOfDeleted{$dir} = $hashOfMirror{$dir};
   delete $hashOfMirror{$dir};
   my $dirSizeNew = (stat($pDir))[7];
   my $space = $size + ($dirSizeOld - $dirSizeNew);
   $currMirrorSize -= $space;
   return $space;
}



# Get parent directory
sub parentDir {
   my ($file) = @_;
         
   my ($vol, $dir, $file1)  = File::Spec->splitpath(File::Spec->canonpath($file),0);
   return(File::Spec->canonpath(File::Spec->catpath($vol,$dir,"")));
}



# Disk usage
sub diskUsage {
  use File::Find;
   my ($dir) = @_;

   my $size = 0;
   if (-l $dir) {
      $size = (lstat($dir))[7];
      return $size;
   }
   find { wanted => sub {
      my @fileStatus = ();
      if(-l $File::Find::name) {
         @fileStatus = lstat($File::Find::name);
      } else {
         @fileStatus = stat($File::Find::name);
      }
      $size += $fileStatus[7];
   }, follow => 0}, $dir;
   return $size;
}



# Check if space is available for files - if not, make it.
# Return 1 if OK 0 if not
sub checkSpace {
   my ($size) = @_;

   my $spaceNeeded = $size - ($mirrorSizeLimit - $currMirrorSize);
   if($spaceNeeded > 0) {
      my $space = makeSpace($spaceNeeded);
      if(($space < $spaceNeeded) || (($spaceNeeded + $currMirrorSize) > $mirrorSizeLimit)) {
         return 0;
      } else {
         return 1;
      }
   }
   return 1;
}



# Make space in mirror:
# 1. Remove obsolete files older than grace period
# 2. Remove empty obsolete directories
# 3. Remove mirror backup files
# 4. Remove remaining obsolete files
# 5. Remove remaining empty obsolete directories
#
# Return amount of space made
sub makeSpace {
   my ($spaceNeeded) = @_;
   my $space = 0;
   my $grace = $obsoleteGracePeriod * 24 * 60 * 60;         # Grace period in seconds
   my $timeLimit = time - $grace;
  
   # The list of obsolete files is assumed sorted in mtime order
   while(@obsoleteFiles) {
      my $file = $obsoleteFiles[0];
      my $mtime = 0;
      if(-l $file) {
         $mtime = (lstat($file))[9];
      } else {
         $mtime = (stat($file))[9];
      }
      if($mtime >= $timeLimit) {
         last;
      } else {
         $space += unlinkWithStat($file);
         shift @obsoleteFiles;
         if($space >= $spaceNeeded) {
            return $space;
         }
      }
   }

   # Remove obsolete directories
   # Assumed sorted in name-length order (longest first)
   my $len = @obsoleteDir;   # Number of elements
   for($i=0;$i<$len;$i++) {
      my $dir = shift @obsoleteDir;
      my $size  = 0;
      if(($size=rmtreeWithStat($dir)) >= 0) {
         $space += $size;
         if($space >= $spaceNeeded) {
            return $space;
	 }
      } else {
         push @obsoleteDir, ($dir);
      }
   }

   # Remove mirror backup files
   while(@mirrorBackupList) {
      my $file = shift @mirrorBackupList;
      $space += unlinkWithStat($file);
      if($space >= $spaceNeeded) {
         return $space;
      }
   }

   # Remove obsolete files indicriminately
   while(@obsoleteFiles) {
      my $file = shift @obsoleteFiles;
      $space += unlinkWithStat($file);
      if($space >= $spaceNeeded) {
         return $space;
      }
   }

   # Remove remaining empty obsolete directories
   my $len = @obsoleteDir;   # Number of elements
   for($i=0;$i<$len;$i++) {
      my $dir = shift @obsoleteDir;
      my $size  = 0;
      if(($size=rmtreeWithStat($dir)) >= 0) {
         $space += $size;
         if($space >= $spaceNeeded) {
            return $space;
	 }
      } else {
         push @obsoleteDir, ($dir);
      }
   }

   return $space;
}



########################################################################
#                                                                      #
# POD                                                                  #
#                                                                      #
########################################################################

=head1 NAME

mirror

=head1 SYNOPSIS

mirror -c config.rc >& error.log

=head1 DESCRIPTION

=head2 Background

This script was written in order to facilitate the backing up of 300Gb data spread over 15 harddisks on as many machines. Until then (pre 2002), I had been using DVD-RAMs to back up selected portions of the data, but by late 2001, the cost/Gb for harddisks was almost on par with that for DVD-RAMs. Consequently, the idea of automatically mirroring a harddisk (or some of the contents thereof) onto another one became far more appealing than manually backing up data onto DVD-RAMs. Both Windows 2000 and True64 Unix provide support for mirroring harddisks but this requires that virtual drives and volume are enabled which is not the case in my computing environment. Furthermore, these systems usually indisciminately mirror whole volumes whereas, I wanted to be able to pick-and-choose the files that I wanted mirrored (or exclude those I didnt) using reg-exp filters. Finally, I wanted to be able to enforce a size limit for the mirror without requiring it to span a whole volume. 

=head2 Features

=over 4

=item *

Multiple trees can be mirrored to the same mirror

=item *

A size limit, that is specified in the configuration file, will be enforced on the mirror.

=item *

If there is extra space available on the mirror, and a file has been modified more recently that its mirrored copy, a secondary backup of the mirrored copy will be made before copying the new version of the file to the mirror.

=item *

The script will also try and keep files on the mirror that do not exist any longer on the source, i.e. obsolete files, if space permits.

=item *

Symbolic links copied to the mirror will be linked to proper targets in the mirror

=item *

Actions taken by the script are written to a log file.

=back

=head2 Mirroring

First, the script obtains information on all the files and directories in the directory trees specified in @dirList. It then uses the regular expression filters specified in @excludeList to exclude files and directories that match any specified reg-exp. 

Directories that do not already exist on the mirror are created before copying any files. If a file on the mirror has the same name as a directory in the source, but is not a directory, it is simply deleted and replaced with a directory.

Files are sorted in size order (small to large) before copying them to the mirror. If a source file does not have a mirror, garbage collection is performed to free up space, if neccesary, and then the file is copied. The program keeps track of the current size of the mirror to make sure that it does not exceed the specified limit: $mirrorSizeLimit. If the mirror of the source file exists but is something else, e.g directory or symbolic link, the mirror is simply deleted before copying the file. If however the mirror is also a file, the modification time of the source is compared with that of the mirror. If it is older than the mirror, no copy is performed. Otherwise, the program performs garbage collection and tries to make a "secondary backup" of the mirror copy before copying the source file to the mirror. Secondary backups will only be attempted on mirror files that are smaller in size than $mirrorBackupFrac * ($mirrorSizeLimit-$sourceSize), where $mirrorBackupFrac is specified in the configuration file. The justification behind introducing this parameter is to prevent situations in which single large files basically gulp up all the available extra space resulting in the deletion of many smaller secondary backup files. If this is not a problem, set it to 1. Making a secondary backup involves changing the name of the old mirror file by suffixing it with an ending specified in $mirrorSuffixPrefix followed by the modification time of the old mirror file. As long as space permits, several secondary backups of a file can exist.

Only symbolic links that point to a file or directory that is mirrored is copied. If a symbolic link has a mirror that is not a link, the mirror is simply deleted. Symbolic links created are made to point to targets within the mirror.

=head2 Garbage Collection

When space is needed on the mirror, files are deleted from the mirror in the following order until the required space is obtained:

=over 4

=item 1.

Remove obsolete files older than grace period. The grace period is specified in the configuration file using the variable: $obsoleteGracePeriod in days.

=item 2.

Remove empty obsolete directories

=item 3.

Remove secondary backup files

=item 4.

Remove remaining obsolete files

=item 5.

Remove remaining empty obsolete directories

=back

=head2 Configuration

Configuration information is provided in a separate file that must be specified using the -c command-line option, e.g. mirror -c mirror-test.rc

The following is a sample configuration file:

 ########################################################################
 #                                                                      #
 # CONFIGURATION                                                        #
 #                                                                      #
 ########################################################################

 # Used to identify this config in the log 
 $reportId = "Ardan's home directory";

 # Directories to mirror
 @dirList = ("/usr/users/ardan");

 # List of patterns specifying files and directories that should be
 # excluded. Use Perl regular expression syntax
 @excludeList = ('~$',                 # Emacs old files
                 '.saves-',            # Emacs .saves files
                 '#\w+(\.\w+)*#$',     # Emacs backup files
                 '/core$',             # Core dumps
                 'junk',               # Junk files and directories
                  ); 

 # Where to create mirror 
 $mirror = "/f15/ardan/tmp1";

 # Size limit of mirror in bytes. 
 $mirrorSizeLimit = 100000000;          

 # Mirror log file
 $mirrorLog = "/usr/users/ardan/mirror.log";

 # If space allows, the mirror of a modified file is not simply deleted,
 # but instead copied to a file with a name extended by a suffix
 # consisting of the prefix given below and the time when the file in
 # in the mirror was modified.
 $mirrorSuffixPrefix = ".mirr";  

 # The fraction of the extra space available within the the mirrorSizeLimit
 # that can be used to backup the mirror of a modified file. Should be 
 # between 0 and 1.0. The justification behind introducing this parameter 
 # is to prevent situations in which single large files basically gulp up 
 # all the available extra space resulting in the deletion of many smaller 
 # secondary backup files. If this is not a problem, set it to 1.  
 $mirrorBackupFrac = 1.0;

 # Grace period for obsolete files in days. Note that there is no 
 # guarantee that obsolete files that have been modified more recently
 # will not be deleted - only that they will be deleted as a last 
 # resort to make room.
 $obsoleteGracePeriod = 30;

 # Space needed to create an empty directory in bytes
 $dirSpaceAlloc = 512;

=head2 crontab

The best way to run this script is to have it run periodically by adding a crontab entry. The following is an example crontab entry that runs every night at 1:20:
 20 1 * * * /usr/users/ardan/perl/mirror -c/usr/users/ardan/mirror-home.rc >& /usr/users/ardan/error.log

=head1 NOTES

=over 4

=item *

Even when creating a fresh mirror, the size of the mirror may be slightly larger than the source. Part of this is due to the fact that the mirror will contain extra directories due to the fact that everthing is stored in the mirror with the FULL original path appended to the mirror directory. Additionally, symbolic links may not be the same size as in the mirror.

=back

=head1 BUGS

Symbolic links that have targets specified with relative paths containing ".." or "." are presently not handled properly.

=head1 SEE ALSO


=head1 COPYRIGHT

Copyright 2001-2002 by Ardan Patwardhan. All Rights Reserved.

=head1 DISCLAIMER

This software is provided on an 'as is' basis and any express or implied warranties, including, but not limited to, the implied warranties of merchantability and fitness for a particular purpose are disclaimed. In no event shall the copyright owner be liable for any direct, indirect, incidental, special, exemplary, or consequential damages (including, but not limited to, procurement of substitute goods or services; loss of use, data, or profits; or business interruption) however caused and on any theory of liability, whether in contract, strict liability, or tort (including negligence or otherwise) arising in any way out of the use of this software, even if advised of the possibility of such damage. 

=head1 README

Script for maintaining an easily configurable mirrored backup of directories.

=head1 PREREQUISITES

 File::Copy
 File::Find
 File::Path
 File::Spec::Functions

=head1 OSNAMES

 dec_osf (tested)
 Any Unix or Linux OS (not tested)

=head1 SCRIPT CATEGORIES

 Unix/System_administration

=cut