#! /usr/bin/perl
# 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…)
# See
# https://ssl.schlittermann.de/pipermail/lug-dd/2011-August/082847.html

# Copyright (C) 2011, 2012 Heiko Schlittermann
#
# 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/>.


# 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, no nice documentation, nothing else.


use 5.010;
use strict;
use warnings;
use POSIX;
use autodie qw(:all);
use Fuse;
use Getopt::Long;
use Pod::Usage;

our $VERSION = "0.1";
my $opt_debug = 0;

GetOptions(
    "debug!" => \$opt_debug,
    "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
    "m|man"  => sub {
        pod2usage(
            -verbose   => 2,
            -exit      => 0,
            -noperldoc => system("perldoc -V 1>/dev/null 2>&1")
        );
    },
  )
  and @ARGV == 1
  or pod2usage();

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

if (not $opt_debug) {
    fork() and exit 0;
    open(STDIN, "</dev/null");
    setpgid($$ => $$);
}

Fuse::main(
    mountpoint => $ARGV[0],
    debug      => $opt_debug,
    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 $@ ? $! : 0;
    }

    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 $_;
    }
}

__END__

=head1 NAME

    blockfuse - mount /dev and map block devices into files

=head1 SYNOPSIS

    blockfuse [-d|--debug] {mountpoint}

    blockfuse [-h|--help] [-m|--man]

=head1 DESCRIPTION

B<blockfuse> is a Fuse helper to mount the "/dev" structure to some
mointpoint and map all block devices into ordinary files. This makes
B<rsync> happy.

=head1 OPTIONS

=over

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

Switch on Fuse debugging. It will prevent B<blockfuse> to fork to background
too. (default: no debugging)

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

The standard help options.

=back

=head1 AUTHOR, COPYRGIHT and SOURCE

Heiko Schlittermann <hs@schlittermann.de>

The program is licensed under the conditions of the GPL, please the
the source file for details.

Source: L<https://ssl.schlittermann.de/hg/blockfuse>

=head1 SEE ALSO

L<https://ssl.schlittermann.de/pipermail/lug-dd/2011-August/082847.html>

=cut
