# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1312704067 -7200 # Node ID 19a7554ddd6c6549f1a49442e99b915fb5783840 # Parent ec7a3333127a1112b142bb3c54658b00d550e257 Added Build.PL and INSTALL text. diff -r ec7a3333127a -r 19a7554ddd6c .hgignore --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.hgignore Sun Aug 07 10:01:07 2011 +0200 @@ -0,0 +1,3 @@ +blib +_build +Build diff -r ec7a3333127a -r 19a7554ddd6c Build.PL --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Build.PL Sun Aug 07 10:01:07 2011 +0200 @@ -0,0 +1,14 @@ +use strict; +use warnings; +use Module::Build; + +Module::Build->new( + dist_name => "blockfuse", + dist_author => "Heiko Schlittermann", + dist_version_from => "bin/blockfuse", + requires => { + perl => "5.10.0", + autodie => "0", + Fuse => "0", + }, +)->create_build_script(); diff -r ec7a3333127a -r 19a7554ddd6c INSTALL --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/INSTALL Sun Aug 07 10:01:07 2011 +0200 @@ -0,0 +1,19 @@ +Just follow theses steps, [...] is optional. + + [$ man Module::Build] + + $perl Build.PL [install_base=$SOME_DIR] + + [$ ./Build help] + + [$ ./Build prereq_report] + + $ ./Build + [$ ./Build test [verbose=1]] + + [$ ./Build fakeinstall] + + $ ./Build install + +Heiko Schlittermann +Sources from https://ssl.schlittermann.de/hg/blockfuse (hg repo). diff -r ec7a3333127a -r 19a7554ddd6c bin/blockfuse --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/blockfuse Sun Aug 07 10:01:07 2011 +0200 @@ -0,0 +1,99 @@ +#! /usr/bin/perl +# © Heiko Schlittermann +# 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, " $$); + +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 $_; + } +} diff -r ec7a3333127a -r 19a7554ddd6c blockfuse --- a/blockfuse Wed Aug 03 23:49:55 2011 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,96 +0,0 @@ -#! /usr/bin/perl -# © Heiko Schlittermann -# -# 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; - -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, " $$); - -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 $_; - } -} diff -r ec7a3333127a -r 19a7554ddd6c t/000-syntax.t --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/t/000-syntax.t Sun Aug 07 10:01:07 2011 +0200 @@ -0,0 +1,23 @@ +use 5.010; +use strict; +use warnings; +use Test::More; +use File::Find; +use File::Temp; + +my @files; +find(sub { + -f -x and ~/^\./ or return; + push @files, $File::Find::name; +}, "blib"); + +plan tests => scalar @files; + +my $tmp = File::Temp->new(); +foreach my $file (@files) { + system("perl -c $file 1>$tmp 2>&1"); + is($? => 0, "syntax $file is ok") + or do { seek $tmp, 0, 0; + diag <$tmp> }; + +}