#! /usr/bin/perl

use 5.010;
use strict;
use warnings;
use autodie qw(:all);
use Getopt::Long;
use Fuse;
use POSIX qw(setpgid :errno_h);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Pod::Usage;
use Hash::Util qw(lock_keys);
use File::Temp;
use DB_File;
use File::Basename;

my %o = (
    debug  => undef,
    detach => 1,
    tmp    => undef,
);
lock_keys %o;

use constant ME => basename $0;
use constant BS => 4 * 1024;

my ($DATA, $IDX);

sub tie_vars;
sub min { (sort {$a <=> $b} @_)[0] }
sub max { (sort {$a <=> $b} @_)[-1] }
my $debug = sub { print STDERR @_ };
   $debug = sub { };


#$SIG{INT} = sub { warn "Got ^C or INT signal\n"; exit 1; };

MAIN: {

    GetOptions(
        "d|debug!" => \$o{debug},
        "detach!"  => \$o{detach},
        "tmp:s" => sub { $o{tmp} = length $_[1] ? $_[1] : $ENV{TMP} // "/tmp" },
        "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
        "m|man"  => sub {
            pod2usage(
                -verbose   => 2,
                -exit      => 0,
                -noperlpod => system("perldoc -V 1>/dev/null 2>&1")
            );
        },
      )
      and @ARGV == 2
      or pod2usage;

    my ($src, $mp) = @ARGV;

    $DATA = "$src/data";
    $IDX  = "$src/idx";

    die ME . ": $DATA: $!" if not -d $DATA;
    die ME . ": $IDX: $!"  if not -d $IDX;

    if (!$o{debug} and $o{detach}) {
        fork() and exit;
        $0 = "FUSE $src $mp";
        open(STDOUT => ">/dev/null");
        open(STDIN  => "/dev/null");
        setpgid($$ => $$);
    }

    tie_vars $o{tmp};

    Fuse::main(
        mountpoint => $mp,
        debug      => $o{debug} // 0,
        getattr    => \&getattr,
        getdir     => \&getdir,
        open       => \&openfile,
        read       => \&readbuffer,
        write      => \&writebuffer,
	release	   => \&release,
    );

    exit;

}

# not the fuse functions

{
    my (%IMAGE, %DIRTY);

    sub tie_vars {
        return if not defined $_[0];
        my $file =
          -d $_[0]
          ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")
          ->filename
          : shift;
        tie %DIRTY, "DB_File" => $file
          or die "Can't tie to $file: $!\n";
    }

    sub getattr {
        my $path = $IDX . shift;
        return stat $path if -d $path;
        my @attr = stat $path or return -(ENOENT);
        my %meta = _get_meta($path);
        $attr[7] = $meta{devsize};
        $attr[9] = $meta{timestamp};
        $attr[2] &= ~0222;    # r/o
        return @attr;
    }

    sub getdir {
        my $path = $IDX . shift;
        opendir(my $dh, $path) or return 0;
        return (readdir($dh), 0);
    }

    sub openfile {
        my $path = $IDX . shift;
        return 0 if exists $IMAGE{$path};
        $IMAGE{$path}{meta}      = { _get_meta($path) };
        $IMAGE{$path}{blocklist} = {};

        # skip the file header
        open(my $fh => $path);
        { local $/ = ""; scalar <$fh> }

        # should check for the format
        # $IMAGE{$path}{meta}{format}

        # now read the block list
        while (<$fh>) {
            /^#/ and last;
            my ($block, $cs, $file) = split;
            $IMAGE{$path}{blocklist}{$block} = $file;
        }
        close $fh;
        return 0;
    }

    sub release {
	my $path = $IDX . shift;
	return 0 if not exists $IMAGE{$path};
	$debug->("Currently we have " . keys(%DIRTY) . " dirty blocks\n");
	return 0;
    }

    sub readbuffer {
        my $path = $IDX . shift;
        my ($size, $offset) = @_;
        my $finfo = $IMAGE{$path} or die "File $path is not opened!";
        return "" if $offset >= $finfo->{meta}{devsize};

        my $buffer = "";
        for (my $need = $size ; $need > 0 ; $need = $size - length($buffer)) {
            $buffer .= _readblock($finfo, $need, $offset + length($buffer));
        }

        return $buffer;
    }

    sub _readblock {
        my ($finfo, $size, $offset) = @_;
	my ($block, $blockoffset, $length);

	$debug->("<<< block offset:$offset size:$size\n");
	$debug->( "    block @{[int($offset/BS)]} + @{[$offset % BS]}\n");

	# first check if it's an dirty block
        $block       = int($offset / BS);
        if (exists $DIRTY{ $finfo . $block }) {
	    $blockoffset = $offset % BS;
	    $length = min(BS - $blockoffset, $size);

	    $debug->("+++ dirty offset:$block*@{[BS]} + $blockoffset size:$length\n");
            return substr $DIRTY{ $finfo . $block }, $blockoffset, $length;
        }


	# if not dirty, we've to find it on disk

	$block = int($offset / $finfo->{meta}{blocksize});
	$blockoffset = $offset % $finfo->{meta}{blocksize};
	$length = min($finfo->{meta}{blocksize} - $blockoffset, $size);

	# find the max length we can satisfy w/o colliding 
	# with dirty blocks
	for (my $l = BS; $l < $length; $l += BS) {
	    my $b = int(($offset + $l)/BS);
	    if ($DIRTY{$finfo . $b}) {
		$length = $l;
		last;
	    }
	}

	$debug->("=== $length\n");
	$debug->("+++ disk offset:$block*$finfo->{meta}{blocksize} + $blockoffset size:$length\n");

        my $fn = "$DATA/" . $finfo->{blocklist}{$block};

	state %cache;
	if (not defined $cache{fn} 
	    or ($cache{fn} ne $fn)) {

	    if (-e $fn) {
		open(my $fh => $fn);
		binmode($fh);
		local $/ = undef;
		$cache{data} = <$fh>;
	    }
	    elsif (-e "$fn.gz") {
		open(my $fh => "$fn.gz");
		binmode($fh);
		gunzip($fh => \$cache{data})
		      or die $GunzipError;
	    }
	    $cache{fn} = $fn;
	}

	return substr($cache{data}, $blockoffset, $size);
	die "$fn: $!\n";
        
    }

    sub writebuffer {
        my $path = $IDX . shift;
        my ($buffer, $offset) = @_;
        my $size = length($buffer);
        my $finfo = $IMAGE{$path} or die "File $path is not opened!";

        for (my $written = 0 ; $written < $size ;) {

            # OPTIMIZE: we should not ask for writing more than the
            # blocksize
            my $n =
              _writeblock($finfo, substr($buffer, $written), $offset + $written)
              or return $written;
            $written += $n;
        }
        return $size;
    }

    sub _writeblock {
        my ($finfo, $buffer, $offset) = @_;
	my ($block, $blockoffset, $length);
        my $size = length($buffer);

	$block = int($offset / BS);
	$blockoffset = $offset % BS;
        $length = min(BS - $blockoffset, $size);

	$debug->(">>> offset:$offset size:$length of $size\n");
	$debug->("    block @{[int($offset/BS)]} + @{[$offset % BS]}\n");

        if (not exists $DIRTY{ $finfo . $block }) {
	    $debug->("+++ missing $block+$blockoffset\n");
            $DIRTY{ $finfo . $block } = _readblock(
                $finfo, BS, $block * BS);
        }

        substr($DIRTY{ $finfo . $block }, $blockoffset, $length) =
          substr($buffer, 0, $length);

        return $length;
    }

    sub _get_meta {
        my $path = shift;
        my %meta;
        open(my $fh => $path);
        while (<$fh>) {
            last if /^$/;
            /^(?<k>\S+):\s+(?<v>.*?)\s*$/
              and do { $meta{ $+{k} } = $+{v}; next; };
        }
        return %meta;
    }

}

__END__

=head1 NAME

    fuse-imager - the fuse mount helper for imagers backups

=head1 SYNOPSIS

    fuse-imager [options] {src} {mount point}

=head1 DESCRIPTION

B<fuse-imager> mounts the src directory (containing F<data/> and F<idx/>
directories) the the specified mount point.

=head1 OPTIONS

=over 4

=item B<--tmp> [I<dir/>]

Write dirty blocks into a buffer file in the specified tmp directory.
If no directory is specified, the system default (usually F</tmp>) will
be used. (default: no temp file)

B<Beware>: The temporary file may get B<HUUGE>.

=item B<-d>|B<--debug>

Enables debugging output from B<Fuse>. When using this option,
B<Fuse> does not detach from the terminal. (default: off)

=item B<-->I<[no]>B<detach> 

Detach or don't detach from the terminal. (default: detach)

=item B<-h>|B<--help>

=item B<-m>|B<--man>

The common help and man options.

=back

=cut
