Fran's blog

#!/usr/bin/perl
 
# (c) 2009 Francisco M. Marzoa Alonso
# http://marzoa.com/
# xrestore v0.1
# This software is under GNU/GPLv3.0 license terms
# USE AT YOUR OWN RISK
 
use Cwd;
 
use Data::Dumper;
use strict;
 
local $|=1; # Avoid buffering
 
my $BACKUP_DIR = "/var/backup";
 
my $RDIFF_BACKUP = "/usr/bin/rdiff-backup";
my $AUTH_FAIL_MESG = "ARG!\n";
my $AUTH_SUCCESS_MESG = "Welcome!\n";
my $CLOSE_CONNECTION_MESG = "Bye!\n";
my $SYNTAX_ERROR_MESG = "Syntax error!\n";
my $FILE_NOT_FOUND_MESG = "File not found!\n";
my $CANNOT_READ_FROM_MESG = "Cannot read source. :-(\n";
my $CANNOT_WRITE_TO_MESG = "Cannot write target. :-(\n";
my $CANNOT_ACCEPT_DATE_MESG = "Cannot accept that DANGEROUS date. :-P\n";
my $LOST_CONNECTION_ERROR_MESG = "Unexpected end of transmission. Connection lost? O_o\n";
my $EXEC_ACCESS = 1;
my $WRITE_ACCESS = 2;
my $READ_ACCESS = 4;
 
 
sub trim {
    my @out = @_;
    for (@out) {
        s/^\s+//;
        s/\s+$//;
    }
    return wantarray ? @out : $out[0];
}
 
 
sub check_file_access {
	my ($uid, $file) = @_;
	my ($rtn, $uname);
 
	my @stats = stat $file;
	my ( $fperms, $fuid, $fgid ) = ( $stats[2] & 07777, $stats[4], $stats[5] );
 
	if ( $fuid == $uid ) { # File owner is the same than backup requester
		$rtn = $fperms >> 6;
		return $rtn;
	} else {
		# Check if user $uid is on group $fgid
		my $ulogin = getpwuid ( $uid ); # We need user's login to compare agaisnt group user's list
		my @gdata = getgrgid ( $fgid );
 		my @unames = split / /, $gdata[3];
		foreach $uname ( @unames ) {
			if ( $uname eq $ulogin ) {
				return ( $fperms & 0070 ) >> 3;
				last;
			}
		}
		# If we reach this, then the file is not owned by user
		# itself and by groups of the user, so return permission
		# mask for everyone
		return $fperms & 0007;
	}
 
	return 0;
}
 
 
sub secure_paths {
	my ( $from, $to, $uid ) = @_;
 
	my $real_from = Cwd::abs_path ( $from );
	if ( ! -e $real_from ) {
		print "$from: ".$FILE_NOT_FOUND_MESG;
		exit -1;
	}
	# Check if we can read that
	my $fa = check_file_access ($uid, $real_from);
	if ( ! ($fa & $READ_ACCESS) ) {
		print $CANNOT_READ_FROM_MESG;
		exit -1;
	}
 
 	my $real_to = Cwd::abs_path ( $to );
 	if ( ! -e $real_to ) {
 		print "$to: ". $FILE_NOT_FOUND_MESG;
 		exit -1;
 	}
 	# Check if we can write that
 	my $fa = check_file_access ($uid, $real_to);
 	if ( ! ($fa & $WRITE_ACCESS) ) {
 		print $CANNOT_WRITE_TO_MESG;
 		exit -1;
 	}
 
	return ( $real_from, $real_to );
}
 
 
sub secure_time {
	my $source = shift ( @_ );
	my ( $i, $valid_chars, $char);
	$source = trim ( $source );
	if ( $source == 'now' ) {
		return $source;
	} else {
		$valid_chars = '0123456789Tt-+/BDWMYsmh';
		for ( $i=0; $i<length ($source); $i++ ) {
			$char = substr $source, $i, 1;
			if ( index ($valid_chars, $char ) == -1 ) {
				# "Alien" chars on date... too bad.
				print $CANNOT_ACCEPT_DATE_MESG;
				exit -1;
			}
		}
		if ( $source =~ m/^-.*$/g ) {
			# A '-' at the beginning may be used to pass additional parameters to RDIFF,
			# which is very very very unsafe.
			print $CANNOT_ACCEPT_DATE_MESG;
			exit -1;
		}
	}
 
	return $source;
}
 
 
sub rdiff_backup {
	my ( $sd, $td, $at, $uid ) = @_;
	my ( $pid, @output );
 
	my ( $source_dir, $target_dir ) = secure_paths ( $sd, $td, $uid );
	my $time = secure_time ( $at );
	die "cannot fork: $!" unless defined ($pid = open(SAFE_KID, "|-"));
	if ($pid == 0) {
		# $RDIFF_BACKUP -r $at $source_dir $target_dir
		exec($RDIFF_BACKUP, ("--preserve-numerical-ids", "-r $at"), ($source_dir, $target_dir) ) or die "can't exec $RDIFF_BACKUP: $!";
	} else {
		@output = <SAFE_KID>;
		close SAFE_KID;                 # $? contains status
	}
}
 
 
sub process_request_auth {
	my ( $req_user, $req_passwd );
	print "User: ";
	$req_user = <stdin>;
	$req_user =~ s/\r\n//g;
	print "Password: ";
	$req_passwd = </stdin><stdin>;
	$req_passwd =~ s/\r\n//g;
	my @udata = getpwnam ( $req_user );
 
	if ( @udata ) {
		my $passwd = $udata[1];
		if ( crypt ( $req_passwd, $passwd ) eq $passwd ) {
			print $AUTH_SUCCESS_MESG;
			my $uid = $udata[2];
			return $uid;
		} else {
			print $AUTH_FAIL_MESG;
			return -1;
		}
	} else {
		print $AUTH_FAIL_MESG;
		return -1;
	}
}
 
sub process_request_commands {
	my $uid = shift @_;
	my ($from, $to, $at, $aux, $command) = ('', '', 'now', '', '');
	my $getout = 0;
 
	while ($command = </stdin><stdin>)  {
		$command = trim $command;
		$command = lc ( $command );
		if ( $command ne '' ) {
			if ( (($aux) = ( $command =~ m/^ *from: *(.*?) *$/i))) {
				print "Ok, we'll try to restore data from $aux\n";
				$from = $aux;
			} elsif ( (($aux) = ( $command =~ m/^ *to: *(.*?) *$/i))) {
				print "Ok, we'll try to restore data to $aux\n";
				$to = $aux;
			} elsif ( (($aux) = ( $command =~ m/^ *at: *(.*?) *$/i))) {
				print "Ok, we'll try to restore data as it was on $aux\n";
				$at = $aux;
			} elsif (( $command eq 'quit' ) || ( $command eq 'exit' )) {
				print $CLOSE_CONNECTION_MESG;
				exit ();
			} elsif ( $command eq 'run' ) {
				last;
			} else {
				print "$command: $SYNTAX_ERROR_MESG";
			}
		}
	}
 
	if ( $command eq 'run' ) {
		rdiff_backup ( $from, $to, $at, $uid );
	} else {
		print $LOST_CONNECTION_ERROR_MESG;
	}
}
 
print "Recover v0.1. Waiting for auth.\n";
my ($uid) = process_request_auth ();
if ( $uid ne -1 ) {
 	process_request_commands ( $uid );
}