moved to git default tip
authorHeiko Schlittermann <hs@schlittermann.de>
Mon, 12 Sep 2016 14:29:09 +0200
changeset 13 630b878cfd55
parent 12 01a602d2806e
moved to git
00-MOVED-TO-GIT
Build.PL
INSTALL
bin/.perltidyrc
bin/blockfuse
t/000-syntax.t
t/001-root.t
--- /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
--- 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 <hs\@schlittermann.de>",
-    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();
--- 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 <hs@schlittermann.de>
-Sources from https://ssl.schlittermann.de/hg/blockfuse (hg repo).
--- 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
--- 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 <http://www.gnu.org/licenses/>.
-
-
-# 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, "</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
--- 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> };
-
-}
--- 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();