# HG changeset patch # User Heiko Schlittermann # Date 1473683349 -7200 # Node ID 630b878cfd55ed65d139651f52195a4e5dae26e4 # Parent 01a602d2806e370a1f1aa688ed4f5d74ce60df19 moved to git diff -r 01a602d2806e -r 630b878cfd55 00-MOVED-TO-GIT --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/00-MOVED-TO-GIT Mon Sep 12 14:29:09 2016 +0200 @@ -0,0 +1,3 @@ +This project moved to + + git://git.schlittermann.de/blockfuse.git diff -r 01a602d2806e -r 630b878cfd55 Build.PL --- a/Build.PL Mon Sep 12 14:24:12 2016 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,24 +0,0 @@ -use strict; -use warnings; -use Module::Build; - -Module::Build->new( - dist_name => "blockfuse", - dist_author => "Heiko Schlittermann ", - dist_version_from => "bin/blockfuse", - dist_abstract => "map a block device into a ordinary file", - license => "GPL_3", - create_license => 1, - script_files => [glob "bin/*"], - requires => { - perl => "5.10.0", - autodie => "0", - Fuse => "0", - "IPC::System::Simple" => "0", - "Pod::Usage" => "0", - }, - build_requires => { - "Test::More" => "0.92", - "Digest::MD5" => "0", - }, -)->create_build_script(); diff -r 01a602d2806e -r 630b878cfd55 INSTALL --- a/INSTALL Mon Sep 12 14:24:12 2016 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,19 +0,0 @@ -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 01a602d2806e -r 630b878cfd55 bin/.perltidyrc --- a/bin/.perltidyrc Mon Sep 12 14:24:12 2016 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,2 +0,0 @@ ---paren-tightness=2 ---square-bracket-tightness=2 diff -r 01a602d2806e -r 630b878cfd55 bin/blockfuse --- a/bin/blockfuse Mon Sep 12 14:24:12 2016 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,177 +0,0 @@ -#! /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 . - - -# blockfuse maps the block devices found in /dev/ to regular -# files in your mountpoint. [disabled: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, " $$); -} - -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 is a Fuse helper to mount the "/dev" structure to some -mointpoint and map all block devices into ordinary files. This makes -B happy. - -=head1 OPTIONS - -=over - -=item B<-d> | B<--debug> - -Switch on Fuse debugging. It will prevent B 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 - -The program is licensed under the conditions of the GPL, please the -the source file for details. - -Source: L - -=head1 SEE ALSO - -L - -=cut diff -r 01a602d2806e -r 630b878cfd55 t/000-syntax.t --- a/t/000-syntax.t Mon Sep 12 14:24:12 2016 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,23 +0,0 @@ -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> }; - -} diff -r 01a602d2806e -r 630b878cfd55 t/001-root.t --- a/t/001-root.t Mon Sep 12 14:24:12 2016 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,67 +0,0 @@ -use strict; -use warnings; -use Test::More; -use English qw(-no_match_vars); -use File::Temp; -use File::Basename; -use File::Find; -use Cwd qw(abs_path); -use POSIX qw(SEEK_END); -use Digest::MD5; - -plan skip_all => "Need root permissions to perform these tests.\n" - . "\t try: sudo ./Build test verbose=1 test-files=$0" - if not $EUID == 0; - -my $dir = File::Temp->newdir(TEMPLATE => "blockfuse.XXXXXX"); - -END { system("umount $dir 2>/dev/null") if $dir }; -system("blib/script/blockfuse $dir"); -is($?, 0, "mounted"); - -my %size; -find(sub { - (my $name = $File::Find::name) =~ s/^\/dev//; - if (-d) { - ok(-d "$dir/$name", "dir $name"); - } - elsif (-b) { - ok(-f "$dir/$name", "block->file $name"); - if (open(my $block, $_)) { - seek($block, 0, SEEK_END); - my $size = tell($block); - close($block); - is($size, -s "$dir/$name", "size $name"); - $size{$name} = $size; - } - } - elsif (-l and (-b abs_path $_ or -d abs_path $_)) { - ok(-l "$dir/$name", "link $name"); - } -}, "/dev"); - -# now md5sum test for the smallest device -my $smallest = (sort { $size{$a} <=> $size{$b} } grep {$size{$_}} keys %size)[0]; -$smallest =~ s/^\///; - - -my %digest = ( - dev => Digest::MD5->new(), - file => Digest::MD5->new(), -); - -note "checking digests of $smallest"; -{ - local $/ = \4096; - open(my $dev, "/dev/$smallest") or die "/dev/$smallest: $!"; - $digest{dev}->add($_) while defined($_ = <$dev>); - - open(my $file, "$dir/$smallest") or die "$dir/$smallest: $!"; - $digest{file}->add($_) while defined($_ = <$file>); -} - -is($digest{file}->hexdigest(), $digest{dev}->hexdigest(), "digests of $smallest are equal"); - - - -done_testing();