Backups Blow - BackupsBlow/Transport/Ssh.pm
#!/usr/bin/perl -w
# Backups Blow by Brandon Low 
#
# Copyright 2007 Brandon Low 
# Released under the terms of the GPL v2
#
# http://lostlogicx.com/backupsblow/

package BackupsBlow::Transport::Ssh;

use strict;
use Exporter;
our (@EXPORT_OK, %EXPORT_TAGS, @ISA);
@ISA = qw(Exporter);
@EXPORT_OK = qw(&performBackup &removeBackups &listBackups &fixBackupPath);
%EXPORT_TAGS = ("all" => [@EXPORT_OK]);

use BackupsBlow::Config qw(:read);
use BackupsBlow::Programs qw(:all);
use BackupsBlow::Util qw(:transport);

use Log::Log4perl;
my $logger=Log::Log4perl->get_logger();

sub fixBackupPath ($) {
    my ($backupPath)=@_;
    $backupPath=~s/\/*$/\//;
    return $backupPath;
}

sub buildSshDest () {
    my @sshBase;
    push @sshBase, needConfig("USERNAME");
    push @sshBase, needConfig("HOSTNAME");
    return join("@",@sshBase);
}

sub buildSshCommand ($) {
    # Create a general ssh command
    my @sshCommand;
    push @sshCommand,needProgram("ssh");
    push @sshCommand,buildSshDest();
    push @sshCommand,'"'.$_[0].'"';
    return join(" ",@sshCommand);
}

sub runSshCommand ($) {
    system(buildSshCommand($_[0]));
    die("Unable to ssh and run: $_[0]: $?") unless ($? == 0);
}

sub performBackup ($$$$) {
    my ($backupDir,$backupFile,$incFile,$errFile)=@_;

    my @remoteCommand;
    push @remoteCommand,"cat";
    push @remoteCommand,"$backupDir$backupFile";
    my @command;
    push @command,buildTarCommand($incFile, $errFile);
    push @command,buildSshCommand(join(">",@remoteCommand));
    my $command=join("|",@command);
    system($command);
    if ($? == 0) {
        runSshCommand("chmod 0600 $backupDir$backupFile");
    } else {
        runSshCommand("rm $backupDir$backupFile");
    }
}

sub removeBackups ($$) {
    my ($backupDir,$fileNames)=@_;
    unshift @$fileNames,"rm";
    runSshCommand(join(" $backupDir",@$fileNames));
}

# Takes a directory to list
# returns an array of files in that directory
sub listBackups ($) {
    # Create a command to list the backups already on the server
    my @lsCommand;
    push @lsCommand,"ls";
    push @lsCommand,"-1";
    push @lsCommand,$_[0];
    my $lsCommand=join(" ",@lsCommand);
    my $command=buildSshCommand($lsCommand);
    chomp(my @retval=`$command 2> /dev/null`);
    die("Unable to list backups with: $command: $?") unless ($? == 0);
    return @retval;
}

1;
"People should not be afraid of their governments. Governments should be afraid of their people." --V
Google
 
© 2002-2008 Brandon Low 6 hits since September 11, 2008