#!/usr/local/bin/perl -w
use strict;

=head1 NAME

dsbsrv - dsb server process

=head1 DESCRIPTION

dsbsrv manages the backup repository. It is normally called from sshd
(or directly from inetd, if you don't need encryption or access
control). It reads 1-line commands on stdin and replies with 1-line
responses. Some commands and responses are followed by binary content,
in which case the length of the content is included in the command resp.
response.

The repository is a collection of files, each identified by a
key. The key should only contain the letters A-Z, a-z and 0-9, and not
exceed 250 characters in length. It has no meaning to the server, except
that it is expected to be unique for each file. A typical implementation
would be an MD5 sum of the filename, modification date and file
permissions, encoded in hex or base64.

The files themselves are also usually encrypted and signed. Thus, a
compromised backup server cannot read or change the files. At worst, it
can delete them.

Commands:

=over

=item QUERY key [0]

Enquires whether the server has a file with the given key. 

Answers

=over

=item HAVE key [0]

=item HAVENOT key [0]

=item FAILED key (human-readable error message) [0]

=back

=item STORE key [length]

Asks the Server to store the file with the given key. The length
specifies the number of bytes to follow. The server must read all of the
data before responding, even if it determines that it cannot fulfill the
request (e.g., due to a full disk). (Note: is this a good idea? Maybe a
two phase protocol would be better, since a disk full condition (or a
policy against long files) can usually be detected at the start of the
command)

Answers

=over

=item STORED key [0]

=item FAILED key (human-readable error message) [0]

=back

=item RETRIEVE key [0]

=over

=item RETRIEVING key [length]

=item FAILED key (human-readable error message) [0]

=back

=back

=cut

require 5.008;

chdir "$ENV{HOME}/tmp/backup" || exit(1);	# debug only
$| = 1;

while (<>) {
    my ($cmnd, $key, @args) = split();
    next unless $cmnd;	# ignore nops.
    if (!@args) {
	print "FAILED . (syntax error) [0]\n";
	next;
    }
    my $length = pop @args;
    if ($length =~ /\[(\d+)\]/) {
	$length = $1;
    } else {
	print "FAILED . (syntax error) [0]\n";
	next;
    }
    if ($cmnd eq 'QUERY') {
	my ($dir, $file) = key2file($key);
	unless ($file) {
	    print "FAILED $key (invalid key) [0]\n";
	    next;
	}
	$file = "$dir/$file";
	if (-f $file) {
	    print "HAVE $key [0]\n";
	} else {
	    print "HAVENOT $key [0]\n";
	}
    }
    elsif ($cmnd eq 'STORE') {
	my ($dir, $file) = key2file($key);
	unless ($file) {
	    print "FAILED $key (invalid key) [0]\n";
	    next;
	}
	$file = "$dir/$file";
	my $err = 0;
	unless (mkdir_p ($dir)) {
	    $err = $!;
	    $file = "/dev/null";
	}
	unless (open(F, ">$file")) {
	    $err = $!;
	    open(F, ">/dev/null");
	}
	my $nread = 0;
	while ($nread < $length) {
	    my $chunk = ($length - $nread > 0x1_0000) 
			    ? 0x1_0000
			    : $length - $nread;
	    my $buf;
	    my $rc = read(STDIN, $buf, $chunk);
	    if ($rc <= 0) {
		# something happened to the client - abort
		$err = $!;
		last;
	    }
	    unless (print F $buf) {
		# error writing to output file. Record the fact
		# but keep going
		$err = $!;
	    }
	    $nread += $rc;
	}
	if ($err) {
	    print "FAILED $key ($err) [0]\n";
	    unlink($file); # attempt to unlink the file, but ignore
	    		   # errors ($file might be /dev/null, and 
			   # we can't (hopefully) remove that).
	} else {
	    print "STORED $key [0]\n";
	}
    }
    elsif ($cmnd eq 'RETRIEVE') {
	my ($dir, $file) = key2file($key);
	unless ($file) {
	    print "FAILED $key (invalid key) [0]\n";
	    next;
	}
	$file = "$dir/$file";
	my $err = 0;
	unless (open(F, "<$file")) {
	    print "FAILED $key ($!) [0]\n";
	    next;
	}
	my @stat = stat(F);
	$length = $stat[7];
	print "RETRIEVING $key [$length]\n";

	my $nread = 0;
	while ($nread < $length) {
	    my $chunk = ($length - $nread > 0x1_0000) 
			    ? 0x1_0000
			    : $length - $nread;
	    my $buf;
	    my $rc = read(F, $buf, $chunk);
	    if ($rc <= 0) {
		# Oops, the file shrunk while we read it 
		# or there was some kind of error.
		#
		# We just pad out the rest with zeros and
		# let the client detect the error.
		while ($nread < $length) {
		    print STDOUT "\0";
		    $nread++;
		}
		last;
	    }
	    print STDOUT $buf;
	    $nread += $rc;
	}
    } else {
	# unknown command. Gobble up data, if any, and fail:
	for (1 .. $length) {
	    my $buf;
	    read(STDIN, $buf, 1);
	}
	print "FAILED (unknown command $cmnd) [0]\n";
    }

}







sub key2file {
    my ($key) = @_;

    return undef unless $key =~ m/^[A-Za-z0-9]+$/;
    if ($key =~ m|^(..)(..)(..)(.+)|) {
	return ("$1/$2/$3", $4);
    } else {
	return undef;
    }
}


sub mkdir_p {
    my ($dir, $perm) = @_;
    $perm = 0777 unless(defined($perm));

    if (mkdir($dir, $perm)) {
	return 1;
    } elsif ($!{ENOENT}) {
	my $parentdir = $dir;
	$parentdir =~ s|(.*)/.*|$1|;
	mkdir_p($parentdir, $perm);
	return mkdir($dir, $perm);
    } else {
	return undef;
    }
}
