OpenSANd Code

1953 lines (1451 with data), 37.1 kB

#! /usr/bin/perl
#    This is opensand, an NBD base SAN system
#    Copyright (C) 2008-2014  Stefan Hoefer <stefan@hoefer.ch>
#
#    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 3 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, see <http://www.gnu.org/licenses/>.

use strict;
use IPC::Open2;
use IO::Socket;

if ($ENV{USER} ne "opensand") {
	my @args = ("sudo", "-u", "opensand", "/usr/sbin/osbackup", @ARGV);
	exec(@args);
}

$::DEBUG = 0;
$| = 1;

if (-e "/etc/opensand_config.pl") {
	if (open my $fd, "/etc/opensand_config.pl") {
		my $buffer;

		while (my $line = <$fd>) {
			$buffer .= $line;
		}

		close $fd;

		eval($buffer);

		if (!defined($::backupserver{host}) || !defined($::backupserver{snapsize})) {
			die "Backup server settings not configured!\n";
		}
	}
	else {
		die "Could not open /etc/opensand_config.pl for reading\n";
	}
}
else {
	die "Could not load /etc/opensand_config.pl\n";
}

my $basepath = "/var/lib/opensand/temp";

my $blocklength = 1024*1024;  # the length of the data blocks
my $stamplength = 8;          # the length of Unix timestamps

my $volumefd;

if (! -d $basepath) {
	mkdir $basepath;
}

my $command = $::ARGV[0];

if ($command eq "backup") {
	if ($::ARGV[1] =~ /^\d+$/) {
		my $diskid = int($::ARGV[1]);
		my $uuid = get_uuid($::ARGV[1]);

		if (length($uuid) == 0) {
			die "No uuid for disk $::ARGV[1] available!\n";
		}
		
		my $outfile = $basepath."/backup_".$diskid.".out";

		if (is_running($diskid)) {
			die "Backup for disk $diskid is already running!\n";
		}
		else {
			if ($::DEBUG) {
				print STDERR "Connecting..\n";
			}

			if (!connect_dataserver($diskid)) {
				die "Could not connect to data server\n";
			}

			if ($::DEBUG) {
				print STDERR "  ...Successful\n";
			}

			my $blocklist = read_blocklist($diskid);

			if ($::DEBUG) {
				print STDERR "Local blocklist successfully read.\n";
			}

			my $remoteblocklist = read_remote_blocklist($diskid);

			if ($::DEBUG) {
				print STDERR "Remote blocklist successfully read.\n";
			}

			#if (length($blocklist) > 0) {			
			if (create_snapshot($diskid)) {
				my $num_chunks = length($blocklist)/$stamplength;

				create_remote_storage($num_chunks, $ARGV[2]);

				my $starttime = time();
				my $lasttime = $starttime;
				my $num_different = 0;
				my $num_transferred = 0;

				for (my $i = 0; $i < $num_chunks; $i++) {
					my $new_chunk = get_chunk($i, \$blocklist);
					my $old_chunk = get_chunk($i, \$remoteblocklist);

					if ($new_chunk ne $old_chunk || $new_chunk eq ("0" x $stamplength)) {
						$num_different++;
					}
				}
				
				my $emptydata = pack 'x8', ' ';

				for (my $i = 0; $i < $num_chunks; $i++) {
					if ($::DEBUG) {
						print STDERR "Processing chunk $i of $num_chunks\n";
					}

					my $currenttime = time();
					if ($currenttime - $lasttime >= 300) {
						print_output($outfile, $num_transferred, $num_different, $starttime, $currenttime);
						$lasttime = $currenttime;
					}

					my $new_chunk = get_chunk($i, \$blocklist);
					my $old_chunk = get_chunk($i, \$remoteblocklist);

					if ($new_chunk ne $old_chunk || $new_chunk eq ("0" x $stamplength)) {
						if ($::DEBUG) {
							print STDERR "Transferring data\n";
						}

						# if the timestamp in the blocklist file is 00000000, then send an empty block

						# STH: I removed this feature, because it is too dangerous. Often, disks are copied
						# directly to the block devices, and timestamps are (by default) set to 0, so no backup
						# is ever made of the original blocks.

						#if ($new_chunk eq $emptydata) {
						#	if ($::DEBUG) {
						#		print STDERR "   ... sending empty block\n";
						#	}
						#	
						#	transfer_empty_block($i, $diskid);
						#	$num_transferred++;
						#}
						#else {
						transfer_block($i, $diskid);
						$num_transferred++;
						#}
					}
					else {
						if ($::DEBUG) {
							print STDERR "Linking data\n";
						}
						link_block($i, $diskid);
					}
				}

				print "Transferred $num_different MB of data for disk $diskid\n";

				remove_snapshot(snapshot_name($diskid));

				save_blocklist(\$blocklist);

				save_metadata($diskid);
			}
			else {
				die "Could not create the snapshot!\n";
			}
			#}
			#else {
			#	die "Could not read blocklist file!\n";
			#}

			disconnect_dataserver();
		}
	}
	else {
		die "Usage: osbackup backup <diskid> [<tag>]\n";
	}
}
elsif ($command eq "list") {
	my $diskid = $::ARGV[1];

	if ($diskid !~ /^\d+$/) {
		die "Usage: osbackup list <diskid>\n";
	}

	$diskid = int($diskid);

	if (connect_dataserver($diskid)) {
		list_backups();

		disconnect_dataserver();
	}
}
elsif ($command eq "retention") {
	my $diskid = $::ARGV[1];
	my $number = $::ARGV[2];

	if ($diskid !~ /^\d+$/ || $number !~ /^\d+$/) {
		die "Usage: osbackup retention <diskid> <number>\n";
	}

	$diskid = int($diskid);
	$number = int($number);

	if (connect_dataserver($diskid)) {
		retention_backup($number);

		disconnect_dataserver();
	}	
}
elsif ($command eq "archivable") {
	my $diskid = $::ARGV[1];
	my $archivable = $::ARGV[2];

	if ($diskid !~ /^\d+$/ || $archivable !~ /^0|1$/) {
		die "Usage: osbackup archivable <diskid> 0|1\n";
	}

	$diskid = int($diskid);

	if (connect_dataserver($diskid)) {
		set_archivable($archivable);

		disconnect_dataserver();
	}	
}
elsif ($command eq "delete") {
	my $diskid = $::ARGV[1];
	my $id = $::ARGV[2];

	if ($diskid !~ /^\d+$/ || length($id) == 0) {
		die "Usage: osbackup delete <diskid> <id|tag>\n";
	}

	$diskid = int($diskid);
	if (connect_dataserver($diskid)) {
		if ($id !~ /^\d+$/) {
			my $tag = $id;
			
			$id = get_id_by_tag($diskid, $tag);

			if ($id < 0) {
				print STDERR "Can't get desired disk backup!\n";
				disconnect_dataserver();

				exit(1);
			}
		}

		$id = int($id);

		delete_backup($id);

		disconnect_dataserver();
	}	
}
elsif ($command eq "archive") {
	my $n = $::ARGV[1];

	if ($n !~ /^\d+$/) {
		die "Usage: osbackup archive <n>\n";
	}

	$n = int($n);

	if (connect_dataserver(0)) {
		archive_disk($n);

		disconnect_dataserver();
	}	
}
elsif ($command eq "dump") {
	my $diskid = $::ARGV[1];
	my $id = $::ARGV[2];

	if ($diskid !~ /^\d+$/ || $id !~ /^\d+$/) {
		die "Usage: osbackup dump <diskid> <id>\n";
	}

	$diskid = int($diskid);
	$id = int($id);

	if (connect_dataserver($diskid)) {
		dump_backup($id);

		disconnect_dataserver();
	}	
}
elsif ($command eq "tag") {
	my $diskid = $::ARGV[1];
	my $id = $::ARGV[2];
	my $tag = $::ARGV[3];

	if ($diskid !~ /^\d+$/ || $id !~ /^\d+$/) {
		die "Usage: osbackup tag <diskid> <id> <tag>\n";
	}

	if ($tag !~ /^[a-zA-Z][a-zA-Z0-9 _]*$/) {
		die "Illegal characters in tag\n";
    }

	$diskid = int($diskid);
	$id = int($id);

	if (!connect_dataserver($diskid)) {
		die "Could not connect to data server\n";
	}

	my $foundid = get_id_by_tag($diskid, $tag);

	if ($foundid >= 0) {
		print STDERR "Tag already exists!\n";
		disconnect_dataserver();

		exit(1);
	}
	
	print $::socket "w $id $tag\n";
	
	<$::socket>;
		
	disconnect_dataserver();
}
elsif ($command eq "restore") {
	my $diskid = $::ARGV[1];
	my $id = $::ARGV[2];

	#if ($diskid !~ /^\d+$/ || $id !~ /^\d+$/) {
	if ($diskid !~ /^\d+$/ || length($id) == 0) {
		die "Usage: osbackup restore <diskid> <id|tag>\n";
	}

	$diskid = int($diskid);

	my $diskname = sprintf("lv_disk%05d", $diskid); 
	if (is_active($diskname)) {
		die "Disk $diskid is active, can't restore!\n";
	}
	else {
		if (!connect_dataserver($diskid)) {
			die "Could not connect to data server\n";
		}

		if ($id !~ /^\d+$/) {
			my $tag = $id;
			
			$id = get_id_by_tag($diskid, $tag);

			if ($id < 0) {
				print STDERR "Can't get desired disk backup!\n";
				disconnect_dataserver();

				exit(1);
			}
		}

		$id = int($id);

		# kill any archiving job
		
		print $::socket "k\n";
		
		<$::socket>;
		
		my $blocklist = read_blocklist($diskid);
		
		my $remoteblocklist = read_remote_blocklist($diskid, $id);
		
		if (length($remoteblocklist) > 0) {
			if (length($remoteblocklist) != length($blocklist)) {
				print STDERR "Can't restore disk, incompatible length\n";
			}
			else {
				my $number_chunks = length($blocklist)/$stamplength;
				
				if (open $volumefd, "+</dev/vg_opensand/".$diskname) {
					for (my $i = 0; $i < $number_chunks; $i++) {
						my $a = get_chunk($i, \$blocklist);
						my $b = get_chunk($i, \$remoteblocklist);

						if ($a ne $b) {
							# Chunk $i differs!

							restore_block($id, $i);
						}
					}

					close $volumefd;

					restore_blocklist($diskid, \$remoteblocklist);
				}
				else {
					print STDERR "Could not open disk for writing!\n";
				}
			}
		}
		else {
			print STDERR "Can't get desired disk backup!\n";
		}
		
		disconnect_dataserver();
	}
}
else {
	print "Please use one of the following commands:\n";
	print "  backup <diskid> [<tag>] - perform a backup and tag it (optionally)\n";
	print "  list <diskid> - lists all available backups\n";
	print "  delete <diskid> <id|tag> - deletes a certain backup\n";
	print "  retention <diskid> <number> - deletes all untagged backups save for the latest <number> ones\n";
	print "  dump <diskid> <id> - dump a certain backup\n";
	print "  restore <diskid> <id|tag> - restore a certain backup into the original disk\n";
	print "  archive <n> - start an archiver job that tries to free n MB of disk space by zipping\n";
	print "  archivable <diskid> <0|1> - specify whether a disk is to be archived or not\n";
	print "  tag <diskid> <id> <tag> - tag a specific backup of a disk\n";

	exit(1);
}

sub get_uuid {
	my $diskid = shift;
	$diskid = int($diskid);

	my $file = sprintf("/var/lib/opensand/uuids/disk%05d", $diskid);

	my $uuid = "";
	
	if (open my $fd, $file) {
		$uuid = <$fd>;
		chomp $uuid;
		
		close $fd;
	}

	return $uuid;
}

sub connect_dataserver {
	my $diskid = shift;

	my $uuid = get_uuid($diskid);
	
	my $sshin;
	my $sshout;

	# open the ssh connection

	my $pid = open2($sshout, $sshin, "ssh -p $::backupserver{port} -o StrictHostKeyChecking=no $::backupserver{user}\@$::backupserver{host} /usr/bin/perl");

	while (my $line = <DATA>) {
		print $sshin $line;
	}

	print $sshin "\n";
	print $sshin "__DATA__\n";
	print $sshin $diskid."\n";
	print $sshin $uuid."\n";
	
	my $dataport = <$sshout>;

	chomp $dataport;

	if ($::DEBUG) {
		print STDERR "Dataport: $dataport\n";
	}

	# open the data connection (and store in $::socket)

	#my $proto = getprotobyname('tcp');
	#socket($::socket, PF_INET, SOCK_STREAM, $proto);
	#my $sin = sockaddr_in($dataport,inet_aton($::backupserver{host}));
	#connect($::socket,$sin);	
	$::socket = IO::Socket::INET->new(PeerAddr => $::backupserver{host},
									  PeerPort => $dataport,
									  Proto => 'tcp');
}

sub disconnect_dataserver {
	print $::socket "q\n";

	#print <$::socket>;

	close $::socket;

	# close the ssh connection

	#wait();
}

sub print_output {
	my $outfile = shift;
	my $num_transferred = shift;
	my $num_different = shift;
	my $starttime = shift;
	my $currenttime = shift;

	my $data;

	if ($num_transferred > 0) {
		$data = sprintf("%s: %d of %d chunks read, ETA %s", scalar(localtime($currenttime)), $num_transferred, $num_different, scalar(localtime(int($starttime+($currenttime-$starttime)*$num_different/$num_transferred))));
	}
	else {
		$data = sprintf("%s: %d of %d chunks read", scalar(localtime($currenttime)), $num_transferred, $num_different);
	}

	# STHTODO

	print $data."\n";
}

sub set_archivable {
	my $archivable = shift;

	print $::socket "A $archivable\n";

	<$::socket>;
}

sub archive_disk {
	my $n = shift;

	# delete any archiving job

	print $::socket "k\n";

	<$::socket>;

	print $::socket "a $n\n";

	<$::socket>;	

	print "Archiving job started\n";
}

sub delete_backup {
	my $id = shift;

	# delete any archiving job

	print $::socket "k\n";

	<$::socket>;

	print $::socket "x $id\n";

	<$::socket>;
}

sub dump_backup {
	my $id = shift;

	# kill any archiving job

	print $::socket "k\n";

	<$::socket>;

	print $::socket "d $id\n";

	my $numbytes = <$::socket>;
	chomp $numbytes;

	if ($::DEBUG) {
		print STDERR "Transferring $numbytes bytes\n";
	}

	if ($numbytes > 0) {
		my $buffer;

		while ($numbytes > 0) {
			my $numread = read $::socket, $buffer, 1024*1024;
			
			print $buffer;

			$numbytes -= $numread;
		}

		<$::socket>;
	}
	else {
		die "Error: no data found!\n";
	}
}

sub retention_backup {
	my $number = shift;

	# first of all, stop any archiving job

	print $::socket "k\n";

	<$::socket>;

	print $::socket "y $number\n";

	<$::socket>;
}

sub list_backups {
	print $::socket "b\n";

    my $numlines = <$::socket>;
	chomp $numlines;

	if ($::DEBUG) {
		print STDERR "Reading $numlines entries...\n";
	}

	for (my $i = 0; $i < $numlines; $i++) {
		my $entry = <$::socket>;
		chomp $entry;

		if ($entry =~ /(\d+) (\d+) (.+)/) {
			print "$1: ".localtime($2)." (".$3.")\n";
		}
		elsif ($entry =~ /(\d+) (\d+)/) {
			print "$1: ".localtime($2)."\n";
		}
	}
}

sub create_remote_storage {
	my $num_chunks = shift;
	my $tag = shift;

	if ($::DEBUG) {
		print STDERR "Creating remote storage ($num_chunks chunks)\n";
	}

	print $::socket "c $num_chunks\n";

	if (defined($tag) && length($tag) > 0) {
		print $::socket "W $tag\n";
		
		<$::socket>;
	}
}

sub save_blocklist {
	my $bl = shift;

	if ($::DEBUG) {
		print STDERR "Saving blocklist of length ".length($$bl)."\n";
	}

	print $::socket "s ".length($$bl)."\n";
	print $::socket $$bl;
	print $::socket "\n";
	
	my $result = <$::socket>;
	chomp $result;
	if ($::DEBUG) {
		if ($result) {
			print STDERR "   ...Successful\n";
		}
		else {
			print STDERR "   ...ERROR!\n";
		}
	}
}

sub get_metadata {
	my $diskid = shift;

	my $hostname = `hostname`;
	chomp $hostname;
	
	my $metadata = "hostname:".$hostname."\n";
		
	$metadata .= "id:".$diskid."\n";
	
	$metadata .= "comment:";
	
	my $file = sprintf("/var/lib/opensand/comments/disk%05d", $diskid);

	if (-e $file) {
		if (open my $fd, $file) {
			my $line = <$fd>;
			
			close $fd;

			chomp $line;

			$metadata .= $line;
		}
	}

	$metadata .= "\nuuid:";

	$file = sprintf("/var/lib/opensand/uuids/disk%05d", $diskid);

	if (-e $file) {
		if (open my $fd, $file) {
			my $line = <$fd>;
			
			close $fd;

			chomp $line;

			$metadata .= $line;
		}
	}

	$metadata .= "\n";

	return $metadata;
}

sub save_metadata {
	my $did = shift;

	my $metadata = get_metadata($did);
	
	if ($::DEBUG) {
		print STDERR "Saving metadata of length ".length($metadata)."\n";
	}

	print $::socket "i ".length($metadata)."\n";
	print $::socket $metadata;
	print $::socket "\n";
	
	my $result = <$::socket>;
	chomp $result;
	if ($::DEBUG) {
		if ($result) {
			print STDERR "   ...Successful\n";
		}
		else {
			print STDERR "   ...ERROR!\n";
		}
	}
}

sub read_remote_blocklist {
	my $diskid = shift;
	my $id = shift;

	if (!defined($id)) {
		print $::socket "r\n";

		my $length = <$::socket>;
		chomp $length;

		if ($::DEBUG) {
			print STDERR "   Blocklist length: ".$length."\n";
		}

		my $buffer = "";

		if ($length > 0) {
			read $::socket, $buffer, $length;
		}

		<$::socket>;

		return $buffer;
	}
	else {
		print $::socket "R $id\n";

		my $length = <$::socket>;
		chomp $length;

		my $buffer = "";

		if ($length > 0) {
			read $::socket, $buffer, $length;
		}

		<$::socket>;

		return $buffer;		
	}
}

sub link_block {
	my $bln = shift;
	my $diskid = shift;
	
	# link an existing block on the data server (because it is the same as in the last backup)

	print $::socket "l $bln\n";

	my $response = <$::socket>;
	chomp $response;
	if ($response != 1) {		
		print "Error while linking block!\n";
		remove_snapshot(snapshot_name($diskid));
		exit(1);
	}
}

sub restore_block {
	my $id = shift;
	my $bln = shift;

	if ($::DEBUG) {
		print STDERR "Restoring block $bln\n";
	}

	seek $volumefd, $bln*$blocklength, 0;

	print $::socket "D $id $bln\n";
	
	my $length = <$::socket>;
	chomp $length;

	my $buffer;
	read($::socket, $buffer, $length);

	<$::socket>;

	print $volumefd $buffer;
}

sub restore_blocklist {
	my $diskid = shift;
	my $bl = shift;

	my $diskname = sprintf("/var/lib/opensand/blocklists/disk%05d.bl", $diskid); 
	
	open my $fd, ">".$diskname;

	print $fd $$bl;

	close $fd;
}

sub transfer_block {
	my $bln = shift;
	my $diskid = shift;

	# transfer the specific block from the device

	my $buffer;

	seek $volumefd, $bln*$blocklength, 0;
	my $bytesread = read $volumefd, $buffer, $blocklength;

	print $::socket "t $bln $bytesread\n";
	print $::socket $buffer;
	print $::socket "\n";

	my $response = <$::socket>;
	chomp $response;
	if ($response != 1) {
		print "Error while transfering block!\n";
		remove_snapshot(snapshot_name($diskid));
		exit(1);
	}
}

sub transfer_empty_block {
	my $bln = shift;
	my $diskid = shift;

	# transfer the specific block from the device

	#my $buffer;

	#seek $volumefd, $bln*$blocklength, 0;
	#my $bytesread = read $volumefd, $buffer, $blocklength;

	print $::socket "T $bln $blocklength\n";
	#print $::socket $buffer;
	print $::socket "\n";

	my $response = <$::socket>;
	chomp $response;
	if ($response != 1) {
		print "Error while transfering block!\n";
		remove_snapshot(snapshot_name($diskid));
		exit(1);
	}
}

sub get_id_by_tag {
	my $diskid = shift;
	my $tag = shift;
	
	print $::socket "b\n";

    my $numlines = <$::socket>;
	chomp $numlines;

	my $id = -1;

	for (my $i = 0; $i < $numlines; $i++) {
		my $entry = <$::socket>;
		chomp $entry;

		if ($entry =~ /(\d+) (\d+) (.+)/) {
			if ($3 eq $tag) {
				$id = $1;
			}
		}
	}

	return $id;
}

sub get_chunk {
	my $i = shift;
	my $bl = shift;

	# get a substring; if the blocklist is too short, fill up with zeroes

	if (length($$bl)/$stamplength <= $i) {
		return '0' x $stamplength;
	}
	else {
		return substr($$bl, $i*$stamplength, $stamplength);
	}
}

sub read_blocklist {
	my $diskid = shift;

	# read the blocklist file

	my $blfile = sprintf("/var/lib/opensand/blocklists/disk%05d.bl", $diskid);

	if (-e $blfile) {
		my $buffer = "";

		if (open my $fd, $blfile) {
			while (my $line = <$fd>) {
				$buffer .= $line;
			}

			close $fd;

			return $buffer;
		}
	}
	else {
		die "Can't read blocklist file\n";
	}

	return "";
}

sub create_snapshot {
	my $diskid = shift;

	my $snapshot = snapshot_name($diskid);

	# if the snapshot already exists, remove it

	if (-e "/dev/vg_opensand/".snapshot_name($diskid)) {
		remove_snapshot(snapshot_name($diskid));
	}

	# create the LVM snapshot of this disk.

	my $command = sprintf("sudo lvcreate -s -L ".$::backupserver{snapsize}." -n ".$snapshot." vg_opensand/lv_disk%05d", $diskid);
	system($command);

	# open the snapshot file

	open $volumefd, "/dev/vg_opensand/".$snapshot or die "Could not open snapshot volume for reading...";
}

sub snapshot_name {
	my $diskid = shift;

	my $snapshot = sprintf("lv_backup%05d", $diskid);

	return $snapshot;
}

sub is_running {
	my $diskid = shift;

	my $snapshot = snapshot_name($diskid);

	if (-e "/dev/vg_opensand/".$snapshot) {
		if (is_active($snapshot)) {
			return 1;
		}
		else {
			remove_snapshot($snapshot);

			return 0;
		}
	}
	else {
		return 0;
	}
}

sub is_active {
	my $snapshot = shift;

	# find out whether the snapshot is open

	if (open my $fd, "sudo lvs vg_opensand/${snapshot} | sed 1d |") {
		my $line = <$fd>;

		close $fd;

		chomp $line;

		if ($line =~ /wi-ao/) {
			return 1;
		}
	}

	return 0;
}

sub remove_snapshot {
	my $snapshot = shift;

	# remove the LVM snapshot

	if (defined($volumefd)) {
		close $volumefd;
	}

	#system("sudo lvchange -a n vg_opensand/".$snapshot);
	
	my $retrycount = 5;
	
	while (system("sudo lvremove -f vg_opensand/".$snapshot) && $retrycount) {
           sleep 5;
	   $retrycount--;
	}
}

__DATA__
	
use IO::Socket;
use POSIX;
use IO::Compress::Gzip qw(gzip $GzipError) ;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
use strict;

my $diskid = <DATA>;
my $uuid = <DATA>;
my $stampsize = 8;

chomp $diskid;
chomp $uuid;

my $backuppath = "/var/lib/opensand/backupdata";

my $server = IO::Socket::INET->new(LocalPort => 0,
								   Type      => SOCK_STREAM,
								   Reuse     => 1,
								   Listen    => 10 )   # or SOMAXCONN
    or die "Couldn't be a tcp server : $@\n";

$| = 1;

print $server->sockport()."\n";

my $client = $server->accept();

my $lastbackup = get_last_backup($uuid);
my $newbackup = get_new_backup($uuid);

if (! -d $backuppath) {
	mkdir $backuppath;
}

while (my $line = <$client>) {
	chomp $line;

	if ($line eq "q") { # quit
		#print $client "Bye.\n";
		last;
	}
	elsif ($line eq "r") { # get the remote blocklist (from the last backup)
		if (length($lastbackup) > 0) {
			my $data = "";
			my $length = 0;

			if (open my $fd, $backuppath."/".$lastbackup."/blocklist") {
				my $bytesread = -1;

				while ($bytesread) {
					my $buffer = "";

					$bytesread = read($fd, $buffer, 1024*1024);

					$data .= $buffer;
				}

				close $fd;
			}

			print $client length($data)."\n";
			print $client $data."\n";
		}
		else {
			print $client "0\n\n";
		}
	}
    elsif ($line =~ /A (0|1)/) { # make this disk archivable or not
       my $canarchive = $1;

       if (-d $backuppath."/".$uuid) {
          if (!$canarchive) {
             if (open my $fd, ">".$backuppath."/".$uuid."/.skiparchive") {
                close $fd;
             }
          }
          else {
             if (-e $backuppath."/".$uuid."/.skiparchive") {
                unlink $backuppath."/".$uuid."/.skiparchive";
             }
          }
       }

       print $client "ok\n";
    }
	elsif ($line =~ /a (\d+)/) { # start an archiving job. 
		# attention: it is assumed that no other archiving job ist running, so
		#   the application will best make sure of this by first issuing a "k" command
		#   (effectively killing any running archive job for this disk)

		my $n = $1;

		if (!fork()) {
			setsid();
			close($client);

			$::SIG{TERM} = sub {
				$n = 0;
			};

			my $pidfile = $backuppath."/.archiver.pid";
			if (-e $pidfile) {
				# this shouldn't happen!

				exit(1);
			}

			if (open my $fd, ">".$pidfile) {
				print $fd $$;
				close $fd;
			}
			else {
				# can't write the pid file... strange

				exit(2);
			}

			# wait for things to settle down

			sleep(5);

			$n = $n*1024*1024;

			my @disks;

			if (opendir my $dirfd, $backuppath) {
				@disks = readdir $dirfd;

				closedir $dirfd;
			}

			foreach my $disknumber (@disks) {
				if ($disknumber =~ /^\d+$/) {
					my @topentries;

                    if (! -e $backuppath."/".$disknumber."/.skiparchive") {
					    if (opendir my $dirfd, $backuppath."/".$disknumber) {
						   @topentries = readdir $dirfd;

						   closedir $dirfd;

						   while (@topentries > 0) {
						  	  my $entry = pop(@topentries);

							  if ($entry =~ /^\d+$/ && $n > 0) {
								 archive_subfolder($backuppath."/".$disknumber."/".$entry, \$n);
							  }
						   }
					    }
                    }
				}
			}
			unlink($pidfile);

			exit(0);
		}

		print $client "1\n";
	}
	elsif ($line =~ /R (\d+)/) { # get the remote blocklist (from the last backup)
		my $id = $1;

		my $path = $backuppath."/".$uuid."/".$id;

		if (-d $path) {
			my $data = "";
			my $length = 0;

			if (open my $fd, $path."/blocklist") {
				my $bytesread = -1;

				while ($bytesread) {
					my $buffer = "";

					$bytesread = read($fd, $buffer, 1024*1024);

					$data .= $buffer;
				}

				close $fd;
			}

			print $client length($data)."\n";
			print $client $data."\n";
		}
		else {
			print $client "0\n\n";
		}
	}
	elsif ($line =~ /s (\d+)/) { # save the blocklist
		my $length = $1;

		if ($length > 0) {
			my $buffer;

			read $client, $buffer, $length;

			if (open my $fd, ">".$backuppath."/".$newbackup."/blocklist") {
				print $fd $buffer;
				close($fd);
			}
		}

		<$client>;
		print $client "1\n";
	}
	elsif ($line =~ /i (\d+)/) { # save the metadata
		my $length = $1;

		if ($length > 0) {
			my $buffer;

			read $client, $buffer, $length;

			if (open my $fd, ">".$backuppath."/".$newbackup."/metadata") {
				print $fd $buffer;
				close($fd);
			}
		}

		<$client>;
		print $client "1\n";
	}
	elsif ($line =~ /d (\d+)/) { # dump a backup
		my $id = $1;

		if (-e $backuppath."/".$uuid."/".$id) {
			my $size = get_size($backuppath."/".$uuid."/".$id, 1);
			print $client $size."\n";
			transfer_data($client, $backuppath."/".$uuid."/".$id);
			print $client "\n";
		}
		else {
			print $client "0\n\n";
		}
	}
    elsif ($line =~ /W (.*)/) { # tag the current backup
        my $tag = $1;

		my $path = $backuppath."/".$newbackup."/.tag";

        if (length($tag) == 0) {
           if (-e $path) {
              unlink $path;
           }
        }
        else {
           if (open my $tfd, ">".$path) {
              print $tfd $tag;

              close $tfd;
           }
        }

        print $client "\n";
    }
    elsif ($line =~ /w (\d+) (.*)/) { # tag a certain backup
        my $id = $1;
        my $tag = $2;

		my $path = $backuppath."/".$uuid."/".$id."/.tag";

        if (length($tag) == 0) {
           if (-e $path) {
              unlink $path;
           }
        }
        else {
           if (open my $tfd, ">".$path) {
              print $tfd $tag;

              close $tfd;
           }
        }

        print $client "\n";
    }
	elsif ($line =~ /D (\d+) (\d+)/) { # dump a certain block
		my $id =$1;
		my $bln = $2;

		my $path = $backuppath."/".$uuid."/".$id."/".get_subpath($bln);

		if (-e $path) {
			transfer_single_block($client, $path);
		}
		else {
			print $client "0\n\n";
		}
	}
	elsif ($line =~ /^k/) { # stop a running archiver process (if any) for this disk
		my $pidfile = $backuppath."/.archiver.pid";

		# does the PID file exist?

		if (-e $pidfile) {
			# if so, read the PID and kill the process.
			
			if (open my $fd, $pidfile) {
				my $line = <$fd>;

				close $fd;

				chomp $line;

				if ($line =~ /^\d+$/) {
					kill 'TERM', $line;

					my $counter = 0;

					while ($counter < 100) {
						if (kill(0, $line)) {
							sleep(1);
							$counter++;
						}
						else {
							$counter = 1000;
						}
					}

					if (-e $pidfile) { # it must have been a stale pid file
						unlink $pidfile;
					}
				}
			}
		}

		print $client "1\n";
	}
	elsif ($line =~ /x (\d+)/) { # delete a backup
		my $id = $1;

		if (-e $backuppath."/".$uuid."/".$id) {
			system("rm -rf ".$backuppath."/".$uuid."/".$id);
		}

		print $client "1\n";
	}
	elsif ($line =~ /y (\d+)/) { # delete a couple of backups
		my $number = $1;

		my $path = $backuppath."/".$uuid;

		my $numentries = 0;
		my @entries;

		if (opendir my $fd, $path) {
			my @files = readdir $fd;			

			closedir $fd;

			foreach my $file (@files) {
				if (($file =~ /^\d+$/) && !(-e $path."/".$file."/.tag")) {
					#my @stats = stat $path."/".$file;
					my $timestamp = get_timestamp($path."/".$file);

                    #push @entries, ({number => $file, timestamp => $stats[9]});
					push @entries, ({number => $file, timestamp => $timestamp});
					$numentries++;
				}
			}
		}

		@entries = sort {
			if ($a->{timestamp} > $b->{timestamp}) {
				return -1;
			}
			elsif ($a->{timestamp} == $b->{timestamp}) {
				return 0;				
			}
			else {
				return 1;
			}
		} @entries;

		for (my $i = 0; $i < $numentries; $i++) {
			if ($i >= $number) {
				system("rm -rf ".$path."/".$entries[$i]->{number});
			}
		}

		print $client "1\n";
	}
	elsif ($line =~ /l (\d+)/) { # link this block
		my $blocknumber = $1;

		my $subpath = get_subpath($blocknumber);

		my $fromfile = $backuppath."/".$lastbackup."/".$subpath;
		my $tofile = $backuppath."/".$newbackup."/".$subpath;

		if (link $fromfile, $tofile) {
			print $client "1\n";
		}
		else {
			print $client "0\n";
		}
	}
    elsif ($line =~ /T (\d+) (\d+)/) { # transfer an empty block
        my $blocknumber = $1;
        my $size = $2;

		<$client>;

        my $subpath = get_subpath($blocknumber);

        if (open my $fd, ">".$backuppath."/".$newbackup."/".$subpath) {
			print $fd '0';             # data is not compressed by default!

            truncate $fd, $size+1; 

            close $fd;
			print $client "1\n";
		}
		else {
			print $client "0\n";
		}
    }
	elsif ($line =~ /t (\d+) (\d+)/) { # transfer the data
		my $blocknumber = $1;
		my $size = $2;

		my $buffer;
		read($client, $buffer, $size);
		<$client>;

		my $subpath = get_subpath($blocknumber);

		if (open my $fd, ">".$backuppath."/".$newbackup."/".$subpath) {
			print $fd '0';             # data is not compressed by default!
			print $fd $buffer;
			close $fd;

			print $client "1\n";
		}
		else {
			print $client "0\n";
		}
	}
	elsif ($line =~ /c (\d+)/) { # create the storage structure 
		my $number_chunks = $1;

		if (! -d $backuppath."/".$uuid) {
			mkdir $backuppath."/".$uuid;
		}

		remove_old_directories($uuid);

		mkdir $backuppath."/".$newbackup;
        if (open my $fd, ">".$backuppath."/".$newbackup."/.timestamp") {
	       my $timestamp = time();
           print $fd $timestamp;

           close $fd;
        }

		for (my $i = 0; $i < 256; $i++) {			
			mkdir $backuppath."/".$newbackup."/".$i;

			for (my $j = 0; $j < 256; $j++) {
				if ($i*256*256+$j*256 <= $number_chunks) {
					mkdir $backuppath."/".$newbackup."/".$i."/".$j;
				}
				else {
					last;
				}
			}
			if (($i+1)*256*256 > $number_chunks) {			
				last;
			}
		}
	}
	elsif ($line =~ /b/) { # make a listing
		my $path = $backuppath."/".$uuid;

		my $numentries = 0;
		my @entries;

		if (opendir my $fd, $path) {
			my @files = readdir $fd;			

			closedir $fd;

			foreach my $file (@files) {
				if ($file =~ /^\d+$/) {
					#my @stats = stat $path."/".$file;
					
                    my $tag = "";

                    if (-e $path."/".$file."/.tag") {
                       if (open my $tfd, $path."/".$file."/.tag") {
                          $tag = <$tfd>;
                          chomp $tag;

                          close $tfd;
                       }
                    }

					my $timestamp = get_timestamp($path."/".$file);
					#push @entries, ({number => $file, timestamp => $stats[9], tag => $tag});
					push @entries, ({number => $file, timestamp => $timestamp, tag => $tag});
					$numentries++;
				}
			}
		}

		@entries = sort {
			if ($a->{timestamp} > $b->{timestamp}) {
				return -1;
			}
			elsif ($a->{timestamp} == $b->{timestamp}) {
				return 0;				
			}
			else {
				return 1;
			}
		} @entries;

		print $client $numentries."\n";
		for (my $i = 0; $i < $numentries; $i++) {
			print $client $entries[$i]->{number}." ".$entries[$i]->{timestamp};

            if (length($entries[$i]->{tag}) > 0) {
               print $client " ".$entries[$i]->{tag};
            }
            print $client "\n";
		}
	} 
}

close($server);

sub get_last_backup {
	my $diskid = shift;

	# return the path for the last (successful) backup

	if (! -d $backuppath."/".$diskid) {
		return "";
	}
	else {
		opendir DIR, $backuppath."/".$diskid;
		
		my @entries = readdir *DIR;

		closedir DIR;

		my $found = -1;

		foreach my $entry (@entries) {
			if ($entry =~ /^\d+$/) {
				if ($entry > $found) {
					$found = $entry;
				}
			}
		}

		if ($found >= 0) {	 
			return $diskid."/".$found;
		}
		else {
			return "";
		}
	}
}

sub get_new_backup {
	my $diskid = shift;

	# return a new, unique path for this backup

	if (! -d $backuppath."/".$diskid) {
		mkdir $backuppath."/".$diskid;

		return $diskid."/0";
	}
	else {
		opendir DIR, $backuppath."/".$diskid;
		
		my @entries = readdir *DIR;

		closedir DIR;

		my $found = -1;

		foreach my $entry (@entries) {
			if ($entry =~ /^\d+$/) {
				if ($entry > $found) {
					$found = $entry;
				}
			}
		}

		return $diskid."/".($found+1);
	}
}

sub remove_old_directories {
	my $diskid = shift;

	# remove old backup directories (unfinished backups)
	# for now, just search for backups that have no blocklist saved (as it gets saved just at the end)
	
	my $path = $backuppath."/".$diskid;

	my @entries;

	if (opendir my $fd, $path) {
		@entries = readdir $fd;

		closedir $fd;
	}

	foreach my $entry (@entries) {
		if (($entry =~ /^\d+$/) && -d $backuppath."/".$diskid."/".$entry) {
			if (! -e $backuppath."/".$diskid."/".$entry."/blocklist") {
				system("rm -rf ".$backuppath."/".$diskid."/".$entry);
			}
		}
	}
}

sub get_subpath {
	my $chunknumber = shift;

	my $i = int($chunknumber/256/256);
	my $j = int(($chunknumber-$i*256*256)/256);
	my $k = $chunknumber-$i*256*256-$j*256;

	return $i."/".$j."/".$k;
}

sub get_size {
	my $path = shift;
	my $islast = shift;

	my $size = 0;

	if (opendir my $fd, $path) {
		my @entries = readdir $fd;
		closedir $fd;

		my $maxitem = -1;

		if ($islast) {
			foreach my $entry (@entries) {
				if ($entry =~ /^\d+$/) {
					if ($entry > $maxitem) {
						$maxitem = $entry;
					}
				}
			}
		}

		foreach my $entry (@entries) {
			if ($entry =~ /^\d+$/) {
				if (-d $path."/".$entry) {
					$size += get_size($path."/".$entry, ($entry == $maxitem));
				}
				else {
					#my @stats = stat(_);
					#$size += $stats[7];

					if ($entry == $maxitem) {
						if (open my $fd, $path."/".$entry) {
							my $compressed;

							read $fd, $compressed, 1;

							my $buffer;

							read $fd, $buffer, 1024*1024;
							
							close $fd;

							if ($compressed) {
								$buffer = uncompress($buffer);							   
							}
							
							$size += length($buffer);
						}
					}
					else {
						$size += 1024*1024;
					}
				}
			}
		}
	}

	return $size;
}

sub transfer_single_block {
	my $socket = shift;
	my $path = shift;

	if (open my $fd, $path) {
		my $bytesread = -1;
		my $size = 0;
		my $data = "";
		
		my $compressed;
		read($fd, $compressed, 1);

		while ($bytesread != 0) {
			my $buffer;
			
			$bytesread = read $fd, $buffer, 1024*1024;
			$size += $bytesread;
			$data .= $buffer;
		}

		close $fd;

		if ($compressed) {
			# uncompress the data!

			$data = uncompress($data);
			$size = length($data);
		}

		print $socket $size."\n".$data."\n";
	}
}

sub transfer_data {
	my $socket = shift;
	my $path = shift;

	if (opendir my $fd, $path) {
		my @entries = readdir $fd;
		closedir $fd;

		@entries = sort { 
			if ($a < $b) {
				return -1;
			}
			elsif ($a > $b) {
				return 1;
			}
			else {
				return 0;
			}
		} @entries;

		foreach my $entry (@entries) {
			if ($entry =~ /^\d+$/) {
				if (-d $path."/".$entry) {
					transfer_data($socket, $path."/".$entry);
				}
				else {
					if (open my $fd, $path."/".$entry) {
						my $bytesread = -1;

						my $compressed;
						read ($fd, $compressed, 1);

						my $data = '';

						while ($bytesread != 0) {
							my $buffer;

							$bytesread = read $fd, $buffer, 1024*1024;

							$data .= $buffer;
						}

						if ($compressed) {
							# uncompress the data
							
							$data = uncompress($data);
						}
						
						print $socket $data;

						close $fd;
					}
				}
			}
		}
	}
}

sub uncompress {
	my $data = shift;

	my $result;

	gunzip \$data => \$result;

	return $result;
}

sub compress {
	my $data = shift;

	my $result;

	gzip \$data => \$result, '-Level' => 9;

	return $result;
}

sub get_timestamp {
	my $path = shift;

    $path .= "/.timestamp";

	my $timestamp = 0;

	if (-e $path) {
		if (open my $fd, $path) {
			$timestamp = <$fd>;
			chomp $timestamp;

			close $fd;
		}
	}

	return $timestamp;
}

sub archive_subfolder {
	my $path = shift;
	my $pn = shift;

	if (-e $path."/.archived") {
		return;
	}

	if (opendir my $fd, $path) {
		my @entries = readdir $fd;
		closedir $fd;

		@entries = sort { 
			if ($a < $b) {
				return -1;
			}
			elsif ($a > $b) {
				return 1;
			}
			else {
				return 0;
			}
		} @entries;

		foreach my $entry (@entries) {
			if ($entry =~ /^\d+$/) {
				if (-d $path."/".$entry) {
					archive_subfolder($path."/".$entry, $pn);
				}
				else {
					my @props = stat($path."/".$entry);

					if ($props[7] == 1024*1024+1) {   # if it's not, then it's probably been zipped already
						if (open my $fd, $path."/".$entry) {
							my $bytesread = -1;
							
							my $compressed;
							read ($fd, $compressed, 1);
							my $data = '';

							while ($bytesread != 0) {
								my $buffer;
								
								$bytesread = read $fd, $buffer, 1024*1024;

								$data .= $buffer;
							}

							close $fd;

							if (!$compressed) {
								# compress the data
								
								my $newdata = compress($data);
								
								if (length($newdata) < length($data)) {
									if (open $fd, ">".$path."/".$entry) {
										print $fd "1".$newdata;

										$$pn -= (length($data)-length($newdata));

										close $fd;
									}
								}
							}
						}
					}
				}
			}

			if ($$pn <= 0) {
				return;
			}
		}
	}

	if (open my $fd, ">".$path."/.archived") {
		close $fd;
	}
}