#!/usr/bin/perl -w

########################################################################
#                                                                      #
# rsnapshot                                                            #
#                                                                      #
# by Nathan Rosenquist                                                 #
# based on code originally by Mike Rubel                               #
#                                                                      #
# http://rsnapshot.sourceforge.net/                                    #
#                                                                      #
# rsnapshot comes with ABSOLUTELY NO WARRANTY.  This is free software, #
# and you are welcome to redistribute it under certain conditions.     #
# See the GNU General Public Licence for details.                      #
#                                                                      #
########################################################################

# attention vi users: set ts=4 sw=4

########################
### STANDARD MODULES ###
########################

require 5.004;
use strict;
use DirHandle;
use Getopt::Std;
use File::Path;
use File::stat;

#########################
### DECLARE VARIABLES ###
#########################

my $VERSION = '1.0.2';

# default configuration file
my $config_file	= '/etc/rsnapshot.conf';

# assume the config file syntax is OK unless we encounter problems
my $file_syntax_ok = 1;

# count the lines in the config file, so we can pinpoint errors more precisely
my $file_line_num = 0;

# hash to hold variables from the configuration file
my %config_vars;

# array of hash_refs containing the source -> destination backup points
my @snapshot_points;

# "intervals" are user defined time periods (i.e. hourly, daily)
# this array holds hash_refs containing the name of the interval,
# and the number of snapshots to keep of it
my @intervals;

# which of the intervals are we operating on?
# if we defined hourly, daily, weekly ... hourly = 0, daily = 1, weekly = 2
my $interval_num;

# the highest possible number for the current interval context
# if we are working on hourly, and hourly is set to 6, this would be
# equal to 5 (since we start at 0)
my $interval_max;

# this is the name of the previous interval, in relation to the one we're
# working on. i.e. if we're operating on weekly, this should be "daily"
my $prev_interval;

# same as $interval_max, except for the previous interval.
# this is used to determine which of the previous snapshots to pull from
# i.e. cp -al hourly.$prev_interval_max/ daily.0/
my $prev_interval_max;

# this determines whether we will use GNU cp, or the native perl implementation
# by default, we use native perl
my $use_gnu_cp = 0;

# command line flags
my %opts;

# command or interval to execute
my $cmd;

# parse config file and exit
my $do_configtest = 0;

# show the shell commands being executed
my $verbose = 0;

# show verbose messages from rsync
my $extra_verbose = 0;

# turn verbose on, but don't execute the commands
my $test = 0;

# don't display warnings about FIFOs and special files if enabled
my $quiet = 0;

##############################
### CORE PROGRAM STRUCTURE ###
##############################

# GET COMMAND LINE OPTIONS
getopt('c', \%opts);
getopts('vVtq', \%opts);
$cmd = $ARGV[0];

# ALTERNATE CONFIG FILE
if (defined($opts{'c'}) && ( -f $opts{'c'} ))	{
	$config_file = $opts{'c'};
}

# VERBOSE (OR EXTRA VERBOSE)?
if (defined($opts{'v'}))	{
	$verbose = 1;
}
if (defined($opts{'V'}))	{
	$verbose = 1;
	$extra_verbose = 1;
}

# TEST?
if (defined($opts{'t'}))	{
	$test = 1;
	$verbose = 1;
}

# QUIET?
if (defined($opts{'q'}))	{
	$quiet = 1;
}

# COMMAND LINE ARGS
if ( ! $cmd )	{
	show_usage();
	exit(0);
}
if ($cmd eq 'help')	{
	show_help();
}
if ($cmd eq 'configtest')	{
	$do_configtest = 1;
}
if ($cmd eq 'version')	{
	print "rsnapshot $VERSION\n";
	exit(0);
}
if ($cmd eq 'version_only')	{
	print $VERSION;
	exit(0);
}

# PARSE CONFIG FILE
if ( -f $config_file )	{
	open(CONFIG, $config_file) or bail("Could not open config file \"$config_file\"");
	while (my $line = <CONFIG>)	{
		chomp($line);
		
		# count line numbers
		$file_line_num++;
		
		# assume the line is formatted incorrectly
		my $line_syntax_ok = 0;
		
		# ignore comments
		if ($line =~ /^#/)	{ next; }
		
		# ignore blank lines
		if ($line =~ /^$/)	{ next; }
		
		# ignore lines that are pure white space
		if ($line =~ /^\s*$/)	{ next; }
		
		# parse line
		my ($var, $value, $value2) = split(/\t+/, $line, 3);
		
		# warn about entries we don't understand, and prevent the program from running
		if (!defined($var) or !defined($value))	{
			print STDERR "Error in $config_file on line $file_line_num: $line\n";
			$file_syntax_ok = 0;
			next;
		}
		
		# SNAPSHOT_ROOT
		if ($var eq 'snapshot_root')	{
			# make sure this is a full path
			if ($value !~ /^\//)	{
				print STDERR "Error in $config_file on line $file_line_num: $line - snapshot_root must be a full path\n";
				$file_syntax_ok = 0;
				next;
			}
			# if it exists already, make sure it's a directory
			my $buf = $value;
			$buf =~ s/\/$//;
			if ((-e "$buf") && (! -d "$buf"))	{
				bail("Error in $config_file on line $file_line_num: $line - snapshot_root must be a directory");
			}
			
			# remove the trailing slash, if present
			if ($value =~ /\/$/)	{ chop( $value ); }
			
			$config_vars{'snapshot_root'} = $value;
			
			$line_syntax_ok = 1;
			next;
		}
		
		# CHECK FOR RSYNC (required)
		if ($var eq 'cmd_rsync')	{
			if ( -x $value )	{
				$config_vars{'cmd_rsync'} = $value;
				$line_syntax_ok = 1;
			} else	{
				bail("Could not find $value, please fix cmd_rsync in $config_file");
			}
		}
		
		# CHECK FOR SSH (optional)
		if ($var eq 'cmd_ssh')	{
			if ( -x $value )	{
				$config_vars{'cmd_ssh'} = $value;
				$line_syntax_ok = 1;
			} else	{
				bail("Could not find $value, please fix cmd_ssh in $config_file");
			}
		}
		
		# CHECK FOR GNU cp (optional)
		if ($var eq 'cmd_cp')	{
			if ( -x $value )	{
				$config_vars{'cmd_cp'} = $value;
				$line_syntax_ok = 1;
				$use_gnu_cp = 1;
			} else	{
				bail("Could not find $value, please fix cmd_cp in $config_file");
			}
		}
		
		# INTERVALS
		if ($var eq 'interval')	{
			if (!defined($value))		{ bail("Interval can not be blank"); }
			if ($value !~ m/^[\w\d]+$/)	{ bail("\"$value\" is not a valid entry, must be alphanumeric characters only"); }
			
			if (!defined($value2))		{ bail("\$value\" number can not be blank"); }
			if ($value2 !~ m/^\d+$/)	{ bail("$value2 is not an integer"); }
			if (0 == $value2)			{ bail("\"$value\" can not be 0"); }
			
			my %hash;
			$hash{'interval'}	= $value;
			$hash{'number'}		= $value2;
			push(@intervals, \%hash);
			$line_syntax_ok = 1;
		}
		
		# BACKUP points
		if ($var eq 'backup')	{
			my $src = $value;
			my $dest = $value2;
			
			if ( !defined($config_vars{'snapshot_root'}) )	{	bail("snapshot_root needs to be defined before backup points"); }
			
			# make sure we have a local path for the destination
			if ($dest =~ /^\//)	{ bail("Backup destination $dest must be a local path"); }
			
			# make sure we aren't traversing directories (exactly 2 dots can't be next to each other)
			if ($src  =~ /[^\.]\.{2}[^\.]/)	{ bail("Directory traversal attempted in $src"); }
			if ($dest =~ /[^\.]\.{2}[^\.]/)	{ bail("Directory traversal attempted in $dest"); }
			
			# see if we have a valid local absolute file path
			if (($src =~ /^\//) && (-e "$src"))	{
				$line_syntax_ok = 1;
				
			# ok, let's see if it's a syntactically valid remote ssh pattern
			} else	{
				# remote ssh path needs to be absolute
				if ($src !~ /^.*?\@.*?:\/.*$/)	{
					bail("Backup source $src must be a full path");
				}
				
				# if it's an ssh path, make sure we have ssh
				if ( $src =~ /^.*?\@.*?:\/.*$/ )	{
					if (!defined($config_vars{'cmd_ssh'}))	{
						bail("Cannot handle $src, cmd_ssh not defined in $config_file");
					}
					$line_syntax_ok = 1;
					
				# if it's anonymous rsync, we're ok
				} elsif ( $src =~ /^rsync:\/\/.*$/ )	{
					$line_syntax_ok = 1;
					
				# we don't know what this is, it must be bad
				} else	{
					bail("Source directory \"$src\" doesn't exist");
				}
				
			}
			if ($dest =~ /^\//)	{ bail("Full paths not allowed for backup destinations"); }
			
			# remember src/dest
			# also, first check to see that we're not backing up the snapshot directory
			if ((-e "$src") && ($config_vars{'snapshot_root'} =~ $src))	{
				opendir(SRC, $src) or bail("Could not open $src");
				readdir(SRC);	# .
				readdir(SRC);	# ..
				
				while (my $node = readdir(SRC))	{
					if ("$src/$node" ne "$config_vars{'snapshot_root'}")	{
						my %hash;
						$hash{'src'}	= "$src/$node";
						$hash{'dest'}	= "$dest/$node";
						push(@snapshot_points, \%hash);
					}
				}
				closedir(SRC);
			} else	{
				my %hash;
				$hash{'src'}	= $src;
				$hash{'dest'}	= $dest;
				push(@snapshot_points, \%hash);
			}
		}
		
		# make sure we understood this line
		# if not, warn the user, and prevent the program from executing
		if (0 == $line_syntax_ok)	{
			print STDERR "Error in $config_file on line $file_line_num: $line\n";
			$file_syntax_ok = 0;
		}
	}
	close(CONFIG);
	
	# CONFIG TEST?
	if ($do_configtest && $file_syntax_ok)	{
		print "Syntax OK\n";
		exit(0);
	}
} else	{
	print STDERR "Config file \"$config_file\" does not exist or is not readable.\n";
	exit(-1);
}

# BAIL OUT HERE IF THERE WERE ERRORS IN THE CONFIG FILE
if (0 == $file_syntax_ok)	{
	print STDERR "-----------------------------------\n";
	print STDERR "Errors were found in $config_file, rsnapshot can not continue.\n";
	print STDERR "If you think an entry looks right, make sure you don't have\n";
	print STDERR "spaces where only tabs should be.\n";
	exit(-1);
}

# CREATE THE SNAPSHOT ROOT IF IT DOESN'T EXIST, WITH THE FILE PERMISSIONS 0700
if ( ! -d "$config_vars{'snapshot_root'}" )	{
	if ($verbose)	{ print "mkdir -m 0700 -p $config_vars{'snapshot_root'}\n"; }
	if (0 == $test)	{
		eval	{
			mkpath( "$config_vars{'snapshot_root'}", 0, 0700 );
		};
		if ($@)	{
			bail("Unable to create $config_vars{'snapshot_root'},\nPlease make sure you have the right permissions.");
		}
	}
}

# FIGURE OUT WHICH INTERVAL WE'RE RUNNING, AND HOW IT RELATES TO THE OTHERS
# THEN RUN THE ACTION FOR THE CHOSEN INTERVAL
# remember, in each hashref in this loop:
#   interval is something like "daily", "weekly", etc.
#   number is the number of these intervals to keep
#
my $i = 0;
foreach my $i_ref (@intervals)	{
	if ($$i_ref{'interval'} eq $cmd)	{
		$interval_num = $i;
		
		if ($$i_ref{'number'} > 0)	{
			$interval_max = $$i_ref{'number'} - 1;
		} else	{
			bail("$$i_ref{'interval'} can not be set to 0");
		}
		
		last;
	}
	
	# this WILL be previous next time through
	$prev_interval = $$i_ref{'interval'};
	
	if ($$i_ref{'number'} > 0)	{
		$prev_interval_max = $$i_ref{'number'} - 1;
	} else	{
		bail("$$i_ref{'interval'} can not be set to 0");
	}
	
	$i++;
}
undef($i);

if (!defined($interval_num))	{
	bail("Interval \"$cmd\" unknown, check $config_file");
}

# WITHOUT ANY FURTHER ADO, RUN THE BACKUP
if (0 == $interval_num)	{
	# if this is the most frequent interval, actually do the backups here
	backup_interval($cmd);
	
} else	{
	# this is not the most frequent unit, just rotate
	rotate_interval($cmd, $prev_interval);
}

# if we got this far, assume success
exit(0);

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

sub backup_interval	{
	my $interval = shift(@_);
	
	# this should never happen
	if (!defined($interval))	{ bail('backup_interval() expects an argument'); }
	
	my $rsync_args = '-al';
	
	# if -V was passed as a flag, show verbose messages for rsync
	if ($extra_verbose)	{ $rsync_args .= 'v'; }
	
	# ROTATE DIRECTORIES
	#
	# remove oldest directory
	if ( -d "$config_vars{'snapshot_root'}/$interval.$interval_max" )	{
		if ($verbose)	{ print "rm -rf $config_vars{'snapshot_root'}/$interval.$interval_max/\n"; }
		if (0 == $test)	{
			my $result = rmtree( "$config_vars{'snapshot_root'}/$interval.$interval_max/", 0, 0 );
			if (0 == $result)	{
				bail("Error! rmtree(\"$config_vars{'snapshot_root'}/$interval.$interval_max/\",0,0)\n");
			}
		}
	}
	
	# rotate the middle ones
	for (my $i=($interval_max-1); $i>0; $i--)	{
		if ( -d "$config_vars{'snapshot_root'}/$interval.$i" )	{
			if ($verbose)	{
				print "mv $config_vars{'snapshot_root'}/$interval.$i/ $config_vars{'snapshot_root'}/$interval." . ($i+1) . "/\n";
			}
			if (0 == $test)	{
				my $result = rename( "$config_vars{'snapshot_root'}/$interval.$i/", ("$config_vars{'snapshot_root'}/$interval." . ($i+1) . '/') );
				if (0 == $result)	{
					bail("Error! rename(\"$config_vars{'snapshot_root'}/$interval.$i/\", \"" . ("$config_vars{'snapshot_root'}/$interval." . ($i+1) . '/') . "\")");
				}
			}
		}
	}
	
	# hard link (except for directories) .0 over to .1
	if ( -d "$config_vars{'snapshot_root'}/$interval.0" )	{
		my $result;
		
		if ($verbose)	{
			if ($use_gnu_cp)	{
				print "$config_vars{'cmd_cp'} -al $config_vars{'snapshot_root'}/$interval.0/ $config_vars{'snapshot_root'}/$interval.1/\n";
			} else	{
				print "# native_cp_al(\"$config_vars{'snapshot_root'}/$interval.0/\", \"$config_vars{'snapshot_root'}/$interval.1/\");\n";
			}
		}
		if (0 == $test)	{
			$result = cp_al( "$config_vars{'snapshot_root'}/$interval.0/", "$config_vars{'snapshot_root'}/$interval.1/" );
			if (! $result)	{
				bail("Error! cp_al(\"$config_vars{'snapshot_root'}/$interval.0/\", \"$config_vars{'snapshot_root'}/$interval.1/\")");
			}
		}
	}
	
	# SYNC LIVE DATA TO $interval.0
	foreach my $sp_ref (@snapshot_points)	{
		my $src;
		
		# append a trailing slash if it's a directory
		if ((-d "$$sp_ref{'src'}") && ($$sp_ref{'src'} !~ /\/$/))	{
			$src = $$sp_ref{'src'} . '/';
		} else	{
			$src = $$sp_ref{'src'};
		}
		
		# create missing parent directories inside the $interval.x directory
		my @dirs = split(/\//, $$sp_ref{'dest'});
		pop(@dirs);
		
		# don't mkdir unless we have to
		my $destpath = "$config_vars{'snapshot_root'}/$interval.0/" . join('/', @dirs);
		if ( ! -e "$destpath" )	{
			if ($verbose)	{ print "mkdir -m 0755 -p $destpath/\n"; }
			if (0 == $test)	{
				eval	{
					mkpath( "$destpath/", 0, 0755 );
				};
				if ($@)	{
					bail("Could not mkpath(\"$destpath/\", 0, 0755);");
				}
			}
		}
		
		# if this is a user@host:/path, use ssh
		if ($src =~ /^.*?\@.*?:\/.*$/)	{
			if ($verbose)	{ print "$config_vars{'cmd_rsync'} $rsync_args --delete --numeric-ids --devices --rsh=$config_vars{'cmd_ssh'} $src $config_vars{'snapshot_root'}/$interval.0/$$sp_ref{'dest'}\n"; }
			if (0 == $test)	{
				system( $config_vars{'cmd_rsync'}, $rsync_args, '--delete', '--numeric-ids', '--devices', "--rsh=$config_vars{'cmd_ssh'}", $src, "$config_vars{'snapshot_root'}/$interval.0/$$sp_ref{'dest'}" );
			}
			
		# anonymous rsync
		} elsif ($src =~ /^rsync:\/\/.*$/)	{
			$rsync_args .= 'q';
			
			if ($verbose)	{ print "$config_vars{'cmd_rsync'} $rsync_args --delete --numeric-ids --devices $src $config_vars{'snapshot_root'}/$interval.0/$$sp_ref{'dest'}\n"; }
			if (0 == $test)	{
				system( $config_vars{'cmd_rsync'}, $rsync_args, '--delete', '--numeric-ids', '--devices', $src, "$config_vars{'snapshot_root'}/$interval.0/$$sp_ref{'dest'}" );
			}
			
		# local filesystem
		} else	{
			if ($verbose)	{ print "$config_vars{'cmd_rsync'} $rsync_args --delete --numeric-ids --devices $src $config_vars{'snapshot_root'}/$interval.0/$$sp_ref{'dest'}\n"; }
			if (0 == $test)	{
				system( $config_vars{'cmd_rsync'}, $rsync_args, '--delete', '--numeric-ids', '--devices', $src, "$config_vars{'snapshot_root'}/$interval.0/$$sp_ref{'dest'}" );
			}
		}
	}
	
	# update mtime of $interval.0 to reflect snapshot time
	if ($verbose)	{ print "touch $config_vars{'snapshot_root'}/$interval.0/\n"; }
	if (0 == $test)	{
		my $result = utime(time(), time(), "$config_vars{'snapshot_root'}/$interval.0/");
		if (0 == $result)	{
			bail("Could not utime(time(), time(), \"$config_vars{'snapshot_root'}/$interval.0/\");");
		}
	}
}

sub rotate_interval	{
	my $interval		= shift(@_);
	my $prev_interval	= shift(@_);
	
	# this should never happen
	if (!defined($interval) or !defined($prev_interval))	{
		bail('rotate_interval() expects 2 arguments');
	}
	
	# ROTATE DIRECTORIES
	#
	# delete the oldest one
	if ( -d "$config_vars{'snapshot_root'}/$interval.$interval_max" )	{
		if ($verbose)	{ print "rm -rf $config_vars{'snapshot_root'}/$interval.$interval_max/\n"; }
		if (0 == $test)	{
			my $result = rmtree( "$config_vars{'snapshot_root'}/$interval.$interval_max/", 0, 0 );
			if (0 == $result)	{
				bail("Could not rmtree(\"$config_vars{'snapshot_root'}/$interval.$interval_max/\",0,0);");
			}
		}
	}
	
	# rotate the middle ones
	for (my $i=($interval_max-1); $i>=0; $i--)	{
		if ( -d "$config_vars{'snapshot_root'}/$interval.$i" )	{
			if ($verbose)	{ print "mv $config_vars{'snapshot_root'}/$interval.$i/ $config_vars{'snapshot_root'}/$interval." . ($i+1) . "/\n"; }
			if (0 == $test)	{
				my $result = rename( "$config_vars{'snapshot_root'}/$interval.$i/", ("$config_vars{'snapshot_root'}/$interval." . ($i+1) . '/') );
				if (0 == $result)	{
					bail("error during move(\"$config_vars{'snapshot_root'}/$interval.$i/)\", \"" . ("$config_vars{'snapshot_root'}/$interval." . ($i+1) . '/') . "\");");
				}
			}
		}
	}
	
	# hard link (except for directories) previous interval over to .0
	if ( -d "$config_vars{'snapshot_root'}/$prev_interval.$prev_interval_max" )	{
		if ($verbose)	{
			if ($use_gnu_cp)	{
				print "$config_vars{'cmd_cp'} -al $config_vars{'snapshot_root'}/$prev_interval.$prev_interval_max/ ";
				print "$config_vars{'snapshot_root'}/$interval.0/\n";
			} else	{
				print "# native_cp_al(\"$config_vars{'snapshot_root'}/$prev_interval.$prev_interval_max/\", ";
				print "\"$config_vars{'snapshot_root'}/$interval.0/\");\n";
			}
		}
		if (0 == $test)	{
			my $result = cp_al( "$config_vars{'snapshot_root'}/$prev_interval.$prev_interval_max/", "$config_vars{'snapshot_root'}/$interval.0/" );
			if (! $result)	{
				bail("Error! cp_al(\"$config_vars{'snapshot_root'}/$prev_interval.$prev_interval_max/\", \"$config_vars{'snapshot_root'}/$interval.0/\") failed");
			}
		}
	}
}

sub bail	{
	my $str = shift(@_);
	print STDERR $str . "\n";
	exit(-1);
}

sub show_help	{
	show_usage();
	
	print<<HERE;

rsnapshot is a filesystem snapshot utility. It can take incremental
snapshots of local and remote filesystems for any number of machines.

rsnapshot comes with ABSOLUTELY NO WARRANTY.  This is free software,
and you are welcome to redistribute it under certain conditions.
See the GNU General Public Licence for details.

Options:
    -v verbose       - show equivalent shell commands being executed
    -V extra verbose - same as -v, but show rsync output as well
    -t test          - show equivalent shell commands that would be executed
    -t quiet         - supress non-fatal warnings
    -c [file]        - specify alternate config file (-c /path/to/file)
HERE
	
	exit(0);
}

sub show_usage	{
	print "rsnapshot $VERSION\n";
	print "Usage: rsnapshot [-vVtq] [-c /alt/config/file] <interval>|configtest|help|version\n";
	print "Type \"man rsnapshot\" for full details.\n";
}

sub cp_al	{
	my $src  = shift(@_);
	my $dest = shift(@_);
	my $result = 0;
	
	if (1 == $use_gnu_cp)	{
		$result = gnu_cp_al("$src", "$dest");
	} else	{
		$result = native_cp_al("$src", "$dest");
	}
	
	return ($result);
}

# this is a wrapper to call the GNU version of "cp"
# it might fail in mysterious ways if you have a different version of "cp"
#
sub gnu_cp_al	{
	my $src    = shift(@_);
	my $dest   = shift(@_);
	my $result = 0;
	
	# make sure we were passed two arguments
	if (!defined($src))  { return(0); }
	if (!defined($dest)) { return(0); }
	
	if ( ! -d "$src" )	{
		print STDERR "gnu_cp_al() needs a valid directory as an argument\n";
		return (0);
	}
	
	$result = system( $config_vars{'cmd_cp'}, '-al', "$src", "$dest" );
	if ($result != 0)	{
		if (0 == $quiet)	{
			print STDERR "Warning! $config_vars{'cmd_cp'} failed. Perhaps this is not GNU cp?\n";
		}
		return (0);
	}
	
	return (1);
}

# this is the purpose built, native perl replacement for "cp -al".
# it does not copy "special" files: block, char, fifo, or sockets.
# never the less, it does do regular files, directories, and symlinks
# which should be enough for 95% of the normal cases.
# if you absolutely have to have snapshots of FIFOs, etc, just
# get GNU cp on your system, and specify it in the config file
#
# in the great perl tradition, this returns 1 on success, 0 on failure
#
sub native_cp_al	{
	my $src    = shift(@_);
	my $dest   = shift(@_);
	my $dh     = undef;
	my $result = 0;
	
	# make sure we were passed two arguments
	if (!defined($src))  { return(0); }
	if (!defined($dest)) { return(0); }
	
	# make sure we have a source directory
	if ( ! -d "$src" )	{
		print STDERR "native_cp_al() needs a valid directory as an argument\n";
		return (0);
	}
	
	# strip trailing slashes off the directories,
	# since we'll add them back on later
	$src  =~ s/\/$//;
	$dest =~ s/\/$//;
	
	# LSTAT SRC
	my $st = lstat("$src");
	if (!defined($st))	{
		print STDERR "Could not lstat(\"$src\")\n";
		return(0);
	}
	
	# MKDIR DEST (AND SET MODE)
	if ( ! -d "$dest" )	{
		$result = mkdir("$dest", $st->mode);
		if ( ! $result )	{
			print STDERR "Warning! Could not mkdir(\"$dest\", $st->mode);\n";
			return(0);
		}
	}
	# CHOWN DEST
	$result = chown($st->uid, $st->gid, "$dest");
	if (! $result)	{
		print STDERR "Warning! Could not chown(" . $st->uid . ", " . $st->gid . ", \"$dest\");\n";
		return(0);
	}
	
	# READ DIR CONTENTS
	$dh = new DirHandle( "$src" );
	
	if (defined($dh))	{
		my @nodes = $dh->read();
		
		shift(@nodes);	# .
		shift(@nodes);	# ..
		
		# loop through all nodes in this dir
		foreach my $node (@nodes)	{
			
			my $st = lstat("$src/$node");
			if (!defined($st))	{
				print STDERR "Could not lstat(\"$src/$node\")\n";
				return(0);
			}
			
			# SYMLINK
			if ( -l "$src/$node" )	{
				# SYMLINK
				$result = symlink(readlink("$src/$node"), "$dest/$node");
				if (! $result)	{
					print STDERR "Warning! Could not symlink(readlink(\"$src/$node\"), \"$dest/$node\")\n";
					return (0);
				}
				# CHOWN
				if ( -e "$dest/$node" )	{
					$result = chown($st->uid, $st->gid, "$dest/$node");
					if (! $result)	{
						print STDERR "Warning! Could not chown(" . $st->uid . ", " . $st->gid . ", \"$dest/$node\")\n";
						return (0);
					}
				}
				
			# FIFO
			} elsif ( -p "$src/$node" )	{
				if (0 == $quiet)	{
					print STDERR "Warning! Ignoring FIFO $src/$node\n";
				}
				
			# SOCKET
			} elsif ( -S "$src/$node" )	{
				if (0 == $quiet)	{
					print STDERR "Warning! Ignoring socket: $src/$node\n";
				}
				
			# BLOCK DEVICE
			} elsif ( -b "$src/$node" )	{
				if (0 == $quiet)	{
					print STDERR "Warning! Ignoring special block file: $src/$node\n";
				}
				
			# CHAR DEVICE
			} elsif ( -c "$src/$node" )	{
				if (0 == $quiet)	{
					print STDERR "Warning! Ignoring special character file: $src/$node\n";
				}
				
			# FILE
			} elsif ( -f "$src/$node" )	{
				
				# make a hard link
				$result = link("$src/$node", "$dest/$node");
				if (! $result)	{
					print STDERR "Warning! Could not link(\"$src/$node\", \"$dest/$node\")\n";
					return (0);
				}
				
			# DIRECTORY
			} elsif ( -d "$src/$node" )	{
				
				# call this subroutine recursively, to create the directory
				$result = native_cp_al("$src/$node", "$dest/$node");
				if (! $result)	{
					print STDERR "Warning! Recursion error in native_cp_al(\"$src/$node\", \"$dest/$node\")\n";
					return (0);
				}
			}
		}
		
	} else	{
		print STDERR "Could not open $src. Do you have adequate permissions?\n";
		return(0);
	}
	
	# close open dir handle
	if (defined($dh))	{ $dh->close(); }
	undef( $dh );
	
	# UTIME DEST
	$result = utime($st->atime, $st->mtime, "$dest");
	if (! $result)	{
		print STDERR "Warning! Could not utime(" . $st->atime . ", " . $st->mtime . ", \"$dest\");\n";
		return(0);
	}
	
	return (1);
}

#####################
### PERLDOC / POD ###
#####################

=pod

=head1 NAME

rsnapshot - remote filesystem snapshot utility

=head1 SYNOPSIS

B<rsnapshot> [B<-vVtq>] [B<-c> /alt/config/file] [command]

=head1 DESCRIPTION

B<rsnapshot> is a filesystem snapshot utility. It can take incremental
snapshots of local and remote filesystems for any number of machines.

Local filesystem snapshots are handled with B<rsync(1)>. Secure remote
connections are handled with rsync over B<ssh(1)>, while anonymous
rsync connections simply use an rsync server. Both remote and local
transfers depend on rsync.

B<rsnapshot> saves much more disk space than you might imagine. The amount
of space required is roughly the size of one full backup, plus a copy
of each additional file that is changed. B<rsnapshot> makes extensive
use of hard links, so if the file doesn't change, the next snapshot is
simply a hard link to the exact same file.

B<rsnapshot> will typically be invoked as root by a cron job, or series
of cron jobs. It is possible, however, to run as any arbitrary user
with an alternate configuration file.

All important options are specified in a configuration file, which is
located by default at B</etc/rsnapshot.conf>. An alternate one can be
specified on the command line. There are also additional options which
can be passed on the command line.

The command line options are as follows:

=over 4

B<-v> verbose, show shell commands being executed

B<-V> same as -v, but show rsync output as well

B<-t> test, show shell commands that would be executed

B<-q> quiet, supress non-fatal warnings

B<-c> path to alternate config file

=back

=head1 CONFIGURATION

B</etc/rsnapshot.conf> is the default configuration file. All parameters
in this file must be seperated by tabs. B</etc/rsnapshot.conf.default>
can be used as a syntactically valid reference.

It is recommended that you copy B</etc/rsnapshot.conf.default> to
B</etc/rsnapshot.conf>, and then modify B</etc/rsnapshot.conf> to suit
your needs. What follows here is a list of allowed parameters:

=over 4

B<snapshot_root> local filesystem path to save all snapshots

B<cmd_rsync>     full path to rsync

B<cmd_ssh>       full path to ssh (optional, only required for remote backups)

B<cmd_cp>        full path to cp  (optional, but must be GNU version)

=over 4

cmd_cp is a special case. It should be uncommented if the GNU version of cp
is available. If you are on a platform with a different version of cp (BSD,
Solaris, IRIX, Mac OS X, etc.), it should be commented out. If you do not
specify a path to GNU cp, rsnapshot will use a native implementation instead.
However, because of cross-platform issues, the native Perl version is not
able to take snapshots of the following special filetypes:

=over 4

FIFO

Socket

Block / Character devices

=back

Furthermore, hard links to symlinks are not portable, so new symlinks
will be created when they need to be copied.

=back

B<interval>      [name] [number]

=over 4

"name" refers to the name of this interval (i.e. hourly, daily). "number"
is the number of snapshots for this type of interval that will be stored.
The value of "name" will be the command passed to B<rsnapshot> to perform
this type of backup.

Example: B<interval hourly 6>

[root@localhost]# B<rsnapshot hourly>

For this example, every time this is run, the following will happen:

<snapshot_root>/hourly.5/ will be deleted, if it exists.

<snapshot_root>/hourly.{1,2,3,4} will all be rotated +1, if they exist.

<snapshot_root>/hourly.0/ will be copied to <snapshot_root>/hourly.1/
using hard links.

Each backup point in <snapshot_root>/hourly.0/ will be rsynced with the
backup points specified in this config file later.

Intervals must be specified in the config file in order, from most
frequent to least frequent. The first entry is the one which will be
synced with the backup points. The subsequent intervals (i.e. daily,
weekly, etc) simply rotate, with each higher interval pulling from the
one below it for its .0 directory.

Example:

=over 4

B<interval  hourly 6>

B<interval  daily  7>

B<interval  weekly 4>

=back

daily.0/ will be copied from hourly.5/, and weekly.0/ will be copied from daily.6/

hourly.0/ will be rsynced directly from the filesystem.

=back

B<backup>  /local/path/                localhost/path/

B<backup>  root@example.com:/path/     example.com/path/

B<backup>  rsync://example.com/path2/ example.com/path2/

=over 4

Examples:

B<backup /etc/     etc/>

=over 4

Backs up /etc/ to <snapshot_root>/<interval>.0/etc/ using rsync on the local filesystem

=back

B<backup root@example.com:/home/ example.com/home/>

=over 4

Backs up root@example.com:/home/ to <snapshot_root>/<interval>.0/example.com/home/
using rsync over ssh

=back

B<backup rsync://example.com/pub/  example.com/pub/>

=over 4

Backs up rsync://example.com/pub/ to <snapshot_root>/<interval>.0/example.com/pub/
using an anonymous rsync server

=back

=back

=back

Remember that tabs must seperate all elements, and that
there must be a trailing slash on the end of every directory.

A hash mark (#) on the beginning of a line is treated
as a comment.

Putting it all together (an example file):

=over 4

# THIS IS A COMMENT, TO REMIND YOU THAT TABS MUST SEPERATE ALL ELEMENTS

B<snapshot_root>   /.snapshots/

B<cmd_rsync>       /usr/bin/rsync

B<cmd_ssh>         /usr/bin/ssh

B<#cmd_cp>         /bin/cp

B<interval>        hourly  6

B<interval>        daily   7

B<interval>        weekly  7

B<interval>        monthly 3

B<backup>  /etc/                        localhost/etc/

B<backup>  /home/                       localhost/home/

B<backup>  root@foo.com:/etc/           example.com/etc/

B<backup>  root@foo.com:/home/          example.com/home/

B<backup>  root@mail.foo.com.com:/home/ mail.foo.com/home/

B<backup>  rsync://example.com/pub/     example.com/pub/

=back

=head1 USAGE

B<rsnapshot> can be used by any user, but for system-wide backups
you will probably want to run it as root. Since backups tend to
get neglected if human intervention is required, the preferred
way is to run it from cron.

Here is an example crontab entry, assuming that intervals B<hourly>,
B<daily>, B<weekly> and B<monthly> have been defined in B</etc/rsnapshot.conf>

=over 4

B<0 */4 * * *         /usr/local/bin/rsnapshot hourly>

B<50 23 * * *         /usr/local/bin/rsnapshot daily>

B<40 23 1,8,15,22 * * /usr/local/bin/rsnapshot weekly>

B<30 23 1 * *         /usr/local/bin/rsnapshot monthly>

=back

This example will do the following:

=over 4

6 hourly backups a day (once every 4 hours, at 0,4,8,12,16,20)

1 daily backup every day, at 11:50PM

4 weekly backups a month, at 11:40PM, on the 1st, 8th, 15th, and 22nd

1 monthly backup every month, at 11:30PM on the 1st day of the month

=back

Remember that these are just the times that the program runs.
To set the number of backups stored, set the interval numbers in B</etc/rsnapshot.conf>

=head1 AUTHOR

Based on code originally by Mike Rubel B<http://www.mikerubel.org/computers/rsync_snapshots/>

Rewritten and expanded in Perl by Nathan Rosenquist B<http://rsnapshot.sourceforge.net/>

Copyright (C) 2003 Nathan Rosenquist, Mike Rubel

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=head1 FILES

/etc/rsnapshot.conf

=head1 SEE ALSO

rsync(1), ssh(1), sshd(1), ssh-keygen(1), perl(1), cp(1)

=head1 DIAGNOSTICS

Use the B<-t> flag to see what commands would have been executed. The
B<-v> flag will print the shell commands as they are being executed.
Much weird behavior can probably be attributed to plain old file system
permissions and ssh authentication issues.

=head1 BUGS

Swat them, or report them to rsnapshot@scubaninja.com

=head1 NOTES

Make sure your /etc/rsnapshot.conf file has all elements seperated by tabs.
See /etc/rsnapshot.conf.default for a working example file.

Make sure you put a trailing slash on the end of all directory references.
If you don't, you may have extra directories created in your snapshots.
For more information on how the trailing slash is handled, see the
B<rsync(1)> manpage.

Make sure your snapshot directory is only readable by root. If you would
like regular users to be able to restore their own backups, there are a
number of ways this can be accomplished. One such scenario would be:

Set B<snapshot_root> to B</.private/.snapshots> in B</etc/rsnapshot.conf>

Set the file permissions on these directories as follows:

=over 4

drwx------    /.private

drwxr-xr-x    /.private/.snapshots

=back

Export the /.private/.snapshots directory over read-only NFS, a read-only
Samba share, etc.

If you do not plan on making the backups readable by regular users, be
sure to make the snapshot directory chmod 700 root. If the snapshot
directory is readable by other users, they will be able to modify the
snapshots containing their files, thus destroying the integrity of the
snapshots.

For ssh to work unattended through cron, you will probably want to use
public key logins. Create an ssh key with no passphrase for root, and
install the public key on each machine you want to backup. If you are
backing up system files from remote machines, this probably means
unattended root logins.

BE CAREFUL! If the private key is obtained by an attacker, they will
have free run of all your systems. If you are unclear on how to do this,
see B<ssh(1)>, B<sshd(1)>, and B<ssh-keygen(1)>.

rsync transfers are done using the --numeric-ids option. This means that
user names and group names are ignored during transfers, but the UID/GID
information is kept intact. The assumption is that the backups will be
restored in the same environment they came from. Without this option,
multi-server backups would be unmanageable.

If you remove backup points in the config file, the previously archived
files under those points will permanently stay in the snapshots directory
unless you remove the files yourself. If you want to conserve disk space,
you will need to go into the <snapshot_root> directory and manually
remove the files from the smallest interval's ".0" directory.

For example, if you were previously backing up /home/ in home/, and
hourly is your smallest interval, you would need to do the following to
reclaim that disk space:

=over 4

rm -rf <snapshot_root>/hourly.0/home/

=back

Please note that the other snapshots previously made of /home/ will still
be using that disk space, but since the files are flushed out of hourly.0/,
they will no longer be copied to the subsequent directories, and will thus
be removed in due time as the rotations happen.

=cut

