#! /usr/bin/perl
# © Heiko Schlittermann <hs@schlittermann.de>
# source: https://ssl.schlittermann.de/hg/blockfuse (hg repo)
#
# RSYNC can't sync block devices to files (something like
# rsync /dev/sda2 /images/sda2 does not work. There are
# patches for rsync around, but I didn't like to patch
# rsync…)
#
# blockfuse maps the block devices found in /dev/ to regular
# files in your mountpoint. Currently it fakes the mtime to force
# rsync comparing the source and destination!

#   blockfuse /mnt
#   rsync --inplace -Pa /mnt/sda1 /images/sda1

# Just a short hack, not documentation, nothing else.
# If your're insterested in extending this tool, please tell me, I'm
# willing to put it under some Open Source License. (Currently it's
# not!)

use 5.010;
use strict;
use warnings;
use POSIX;
use autodie qw(:all);
use Fuse;

our $VERSION = "0.1";

my $mountpoint = shift // die "$0: need mountpoint!\n";

warn "Your're probably not running a 64bit system, the devices sizes "
  . "will be incorrect!\n"
  if not `uname -m` =~ /64/;

fork() and exit 0;

open(STDIN, "</dev/null");
setpgid($$ => $$);

Fuse::main(
    mountpoint => $mountpoint,
    getattr    => \&my_getattr,
    getdir     => \&my_getdir,
    open       => \&my_open,
    release    => \&my_release,
    read       => \&my_read,
);
exit 0;

sub my_getattr {
    my $path = "/dev" . shift;
    my @attr = stat $path;
    if (-b $path) {
        $attr[9] = time;    # fake mtime
        $attr[6] = 0;       # clear major/minor
        $attr[2] |= 0b1000_0000_0000_0000;    # set regular file
        $attr[2] &= 0b1001_1111_1111_1111;    # clear block device

        eval {
            open(my $fh => $path);            # size
            seek($fh, 0, SEEK_END);
            $attr[7] = tell($fh);
        };

    }
    return @attr;
}

sub my_getdir {
    my $path = "/dev" . shift;
    opendir(my $dh => $path);
    (grep { -e "$path/$_" and not -c _ } readdir($dh)), 0;
}

{
    my %FD;

    sub my_open {
        my $path = "/dev" . shift;
        eval { open($FD{$path} => $path) };
        return $!;
    }

    sub my_release {
        my $path = "/dev" . shift;
        close delete $FD{$path};
    }

    sub my_read {
        my $path = "/dev" . shift;
        my ($size, $offset) = @_;
        seek($FD{$path}, $offset, SEEK_SET);
        my $_;
        sysread($FD{$path}, $_, $size);
        return $_;
    }
}
