First cut at convering mirror to Perl.

diff --git a/mirror b/mirror
new file mode 100644 (file)
index 0000000..c971635
--- /dev/null
+++ b/mirror
@@ -0,0 +1,224 @@
+#!/usr/bin/perl -w
+############################################################################
+#
+# mirror.pl Version 0.1 By Andrew Ruthven <andrew@etc.gen.nz>
+#
+# Based on the shell script by Stu Sheldon <stu@actusa.net> who based his
+# script on the concept from from Mike Rubel @ Caltech.
+#
+# ============================== Disclaimer ===============================
+#
+# Don't even begin to think there is any kind of warranty on this script!
+# If it destroys your box, it's not my problem. If your dog is standing next
+# to your PC when it self destructs and get's his tail blown to the next
+# room, don't come to me!
+#
+# =========================================================================
+#
+# This script is more or less a quickie that I popped out to allow me to
+# take snapshots of certain data on development equipment and store it to
+# a central system. It works for me... If you can use it then have at it!
+#
+# What it does:
+#
+# mirror does an rsync in the directories listed in the 'allsrcs' variable
+# and then creates hard links to those files in a directory hierarchy to keep
+# snapshots of the rsync's at given intervals. In simple terms, it allows you
+# to store snapshots of the directories you want to backup. Since it uses hard
+# links for previous data, it is very easy on disk space.
+#
+# What is "EXPERIMENTAL" in this script:
+#
+# If you read down through the settings, you will see a couple of settings that
+# are listed as experimental:
+# autosrcdir=
+# advexcludes=
+# Please read the instructions regarding these, and report any problems you
+# might have with them. They seem to work properly for me, but they have very
+# limited testing under their belt.
+#
+# Instructions:
+# 
+# The first thing you need to do is go down to the end of this header section
+# and set all the user defined variables in the user settings section.
+# They have a brief description of what they do and how they should be set.
+#
+# There are two areas at the bottom of configuration section that allow you to
+# do pre and post executions of commands. The only reason I can see to use
+# these areas would be if you are trying to rsync a windows box and need to
+# mount smb shares on the system you are running the script on. If that's your
+# goal, then add your commands for mounting and unmounting those filesystems
+# there.
+#
+# Once that is done, you can run the program.
+#
+# mirror supports one command line switches ( -s ).
+#      -s = run sync mode only
+#
+# Sync mode should be ran the first time you setup mirror. Otherwise, use 
+# no switch.
+# Once you have run mirror for the first time, you will find that it has setup
+# a directory hierarchy in your backup root directory:
+#
+#      /<backuproot>/<hostid>         ( host root )
+#      /<backuproot>/<hostid>/working ( working directory )
+#      /<backuproot>/<hostid>/hourly  ( hourly saves )
+#      /<backuproot>/<hostid>/daily   ( daily saves )
+#      /<backuproot>/<hostid>/weekly  ( weekly saves )
+#
+# The directories are named 'image-<year>-<month>-<day>-<hour>'
+#
+# Each time mirror runs, it date stamps a file in the <hostid> directory called
+# 'lastrun.time'. This file's date when listing it using ls -laF shows the last
+# date and time mirror ran on that host.
+#
+# The last thing you need to do is add mirror in your crontab with the proper
+# times and switches.
+#
+# If you are going for hourly sync's, add the following to your crontab:
+# 0 * * * *    /usr/local/sbin/mirror
+#
+# Every four hours would be:
+# 0 0,4,8,12,16,20  * * *    /usr/local/sbin/mirror
+#
+# Every six hours:
+# 0 0,6,12,18 * * *    /usr/local/sbin/mirror
+#
+# You get the picture.
+#
+# And that's it! Enjoy...
+#
+############################################################################
+
+use YAML::Syck;
+use POSIX qw/strftime/;
+
+use GetOptions::Long;
+
+my $config_file = "mirror.yaml";
+my $sync = undef;
+
+GetOptions("config|c=s"  => $config_file,
+                                        "sync|s"      => $sync);
+
+my @errors   = ();
+my @warnings = ();
+
+my $c = load_config();
+
+
+
+
+sub load_config {
+       my $c = LoadFile($config_file);
+
+       for my $required ('backuproot', 'hostid') {
+               die_gracefully("No $required set")
+                       unless defined $c->{$required} || $c->{required} ne '';
+       }
+
+  $c->{'cp'}       ||= "cp -alf";
+       $c->{'weekdir'}  = "$c->{'backuproot'}/$c->{'hostid'}/weekly";
+  $c->{'daydir'}   = "$c->{'backuproot'}/$c->{'hostid'}/daily";
+       $c->{'hourdir'}  = "$c->{'backuproot'}/$c->{'hostid'}/hourly";
+       $c->{'working'}  = "$c->{'backuproot'}/$c->{'hostid'}/working";
+       $c->{'lockfile'} = "$c->{'backuproot'}/$c->{'hostid'}/syncing-now";
+
+       $c->{'datedir'}  = strftime("image-%Y-%m-%d-%H");
+       $c->{'dow'}      = strftime("%w");
+       $c->{'chour'}    = strftime("%H");
+       $c->{'lday'}     = strftime("image-%Y-%m-%d-%H", localtime() - 3600 * 24);
+       $c->{'1week'}    = strftime("image-%Y-%m-%d-%H", localtime() - 3600 * 24 * 7);
+
+       return \%c;
+};
+
+sub dodir {
+       for my dir (qw'weekdir daydir hourdir working') {
+               if (test("! -d $c->{$dir}")) {
+                       run_and_check("mkdir -p $c->{$dir}");
+               }
+       }
+}
+
+sub doweek {   
+       return
+               if $c->{'saveweeks'} == 0;
+
+       if (test("-d $c->{'daydir'}/$c->{'lweek'}")) {
+               run_and_check("mv $c->{'daydir'}/$c->{'lweek'} $c->{'weekdir'}")
+       } else {
+               push @warnings, "I can't find a daily snapshot that is a week old...";
+       }
+}
+
+sub doday {
+       return 
+               if $c->{'savedays'} == 0;
+
+       if (test("-d $c->{'hourdir'}/$c->{'lday'}")) {
+               run_and_check("mv $c->{'hourdir'}/$c->{'lday'} $c->{'daydir'}");
+       } else {
+               push @warnings, "I can't find an hourly snapshot that is 24hrs old..."
+       }
+}
+
+sub dohour {
+       run_and_check("$c->{'cp'} $c->{'working'} $c->{'hourdir'}/$c->{'datedir'}");
+       run_and_check("touch $c->{'hourdir'}/$c->{'datedir'}");
+}
+
+sub dosync {
+       if (defined $c->{'autosrcdir'}) {
+               allsrcdir=`ssh ${backedhost} "ls -d /*"`
+       }
+
+       for srcdir in ${allsrcdir}; do
+  if [ "${backedhost}" != "" ]; then
+    if [ ${advexcludes} -gt 0 ]; then
+      run_and_check "${rsync} ${EXCLUDES} ${backedhost}:${srcdir} ${working}"
+    else
+      run_and_check "${rsync} ${backedhost}:${srcdir} ${working}"
+    fi
+  else
+    if [ ${advexcludes} -gt 0 ]; then
+      run_and_check "${rsync} ${EXCLUDES} ${srcdir} ${working}"
+    else
+      run_and_check "${rsync} ${srcdir} ${working}"
+    fi
+  fi
+done
+}
+
+
+# Perform a test, either via ssh or using a local perl check
+sub test {
+       my ($test) = shift;
+
+       if (defined $c->{rmtssh}) {
+               system("$c->{rmtssh} [ $test ]");
+               
+               return ($? >> 8);
+       } else {
+               return $test;
+       }
+}
+               
+
+# Run a command and check its return code.
+sub run_and_check {
+  my ($cmd, $die) = shift;
+
+       $cmd = "$c->{$rmtssh} $cmd"
+               if defined $c->{rmtssh};
+
+  system($cmd);
+  if ($? >> 8 != 0) {
+    push @errors "Command \"$cmd\" failed with return code " . ($? >> 8) . "\n";
+
+               die_gracefully()
+                       if defined $die;
+
+               return 0;
+  }
+}