--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/catter Tue Jul 12 00:21:58 2011 +0200
@@ -0,0 +1,42 @@
+#! /usr/bin/perl
+# Eigentlich geht das selbe mit:
+# grep -v '^\[' IDX-File | while read x x file x; do test "$file" && cat DATA/$file; done
+#
+use 5.010;
+use strict;
+use warnings;
+use File::Basename;
+use Cwd qw(abs_path);
+use autodie qw(:all);
+
+use constant KiB => 1024;
+use constant MiB => 1024 * KiB;
+use constant GiB => 1024 * MiB;
+
+my $BS = 64 * MiB;
+my $IDX = shift // die "Need index file\n";
+my $DST = shift // die "Need destination for writing the image.\n";
+my $DATA = abs_path(dirname($IDX) . "/../data");
+
+open(my $idx => $IDX);
+
+{ local $/ = "";
+ scalar <$idx>;
+}
+
+my $out;
+if ($DST eq "-") { open($out => ">&STDOUT") }
+else { open($out => ">", $DST) };
+
+while (<$idx>) {
+ next if /^#/;
+ my ($blk, $hash, $path) = split;
+ open(my $in => "$DATA/$path");
+ {
+ my $buffer;
+ local $/ = \$BS;
+ print {$out} $buffer while defined($buffer = <$in>);
+ }
+ close($in);
+}
+close($out);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/fuse Tue Jul 12 00:21:58 2011 +0200
@@ -0,0 +1,157 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use autodie qw(:all);
+
+use Fuse;
+
+my $src = shift // die "need source directory\n";
+my $mp = shift // die "need mountpoint\n";
+
+$fs::DATA = "$src/data";
+$fs::IDX = "$src/idx";
+
+Fuse::main(mountpoint => $mp,
+ debug => 0,
+ getattr => "fs::getattr",
+ getdir => "fs::getdir",
+ open => "fs::openfile",
+ read => "fs::readbuffer",
+ write => "fs::writebuffer",
+ );
+
+
+{ package fs;
+ use strict;
+ use warnings;
+ use POSIX qw(:errno_h);
+ use autodie qw(:all);
+
+ our ($ROOT, $DATA, $IDX);
+ my %FILE;
+ my %CACHE;
+
+ sub getattr {
+ my $path = $IDX . shift;
+ return stat $path if $path eq "$IDX/";
+ # rest are the idx
+ my @attr = stat $path or return -(ENOENT);
+ my %meta = _get_meta($path);
+ $attr[7] = $meta{devsize};
+ $attr[9] = $meta{timestamp};
+ $attr[2] &= ~0222; # r/o
+ return @attr;
+ }
+
+ sub getdir {
+ my $path = $IDX . shift;
+ opendir(my $dh, $path) or return 0;
+ return (readdir($dh), 0);
+ }
+
+
+ sub openfile {
+ my $path = $IDX . shift;
+ return 0 if exists $FILE{$path};
+ $FILE{$path}{meta} = { _get_meta($path) };
+ $FILE{$path}{blocklist} = {};
+
+ open(my $fh => $path);
+ { # the file header
+ local $/ = "";
+ scalar <$fh>;
+ }
+ while (<$fh>) {
+ /^#/ and last;
+ my ($block, $cs, $file) = split;
+ $block-- if not $FILE{$path}{meta}{format};
+ $FILE{$path}{blocklist}{$block} = $file;
+ }
+ return 0;
+ }
+
+ sub readbuffer {
+ my $path = $IDX . shift;
+ my ($size, $offset) = @_;
+ my $finfo = $FILE{$path} or die "File $path is not opened!";
+ return "" if $offset >= $finfo->{meta}{devsize};
+
+ my $buffer = "";
+ for (my $need = $size; $need; $need = $size - length($buffer)) {
+ $buffer .= _readblock($finfo, $need, $offset + length($buffer));
+ }
+
+ return $buffer;
+ }
+
+ sub _readblock {
+ my ($finfo, $size, $offset) = @_;
+
+ my $block = int($offset / $finfo->{meta}{blocksize});
+ my $blockoffset = $offset % $finfo->{meta}{blocksize};
+
+ my $length = $finfo->{meta}{blocksize} - $blockoffset;
+ $length = $size if $size <= $length;
+
+ if (exists $CACHE{$finfo}{$block}) {
+ return substr $CACHE{$finfo}{$block}, $blockoffset, $length;
+ }
+
+ open(my $fh => "$DATA/" . $finfo->{blocklist}{$block});
+ seek($fh => $blockoffset, 0) or die "seek: $!";
+ local $/ = \$length;
+ return scalar <$fh>;
+ }
+
+ sub writebuffer {
+ my $path = $IDX . shift;
+ my ($buffer, $offset) = @_;
+ my $size = length($buffer);
+ my $finfo = $FILE{$path} or die "File $path is not opened!";
+
+ my $written = 0;
+ while ($written < $size) {
+ my $n = _writeblock($finfo, substr($buffer, $written), $offset + $written);
+ return $written if not $n;
+ $written += $n;
+ }
+ return $size;
+ }
+
+ sub _writeblock {
+ my ($finfo, $buffer, $offset) = @_;
+ my $size = length($buffer);
+
+ my $block = int($offset / $finfo->{meta}{blocksize});
+ my $blockoffset = $offset % $finfo->{meta}{blocksize};
+
+ if (not exists $CACHE{$finfo}{$block}) {
+ open(my $fh => "$DATA/" . $finfo->{blocklist}{$block});
+ local $/ = undef;
+ $CACHE{$finfo}{$block} = <$fh>;
+ close($fh);
+ }
+
+ my $length = $finfo->{meta}{blocksize} - $blockoffset;
+ $length = $size if $size <= $length;
+
+ substr($CACHE{$finfo}{$block}, $blockoffset, $length)
+ = substr($buffer, 0, $length);
+
+ return $length;
+ }
+
+ sub _get_meta {
+ my $path = shift;
+ my %meta;
+ open(my $fh => $path);
+ while(<$fh>) {
+ last if /^$/;
+ /^(?<k>\S+):\s+(?<v>.*?)\s*$/ and do { $meta{$+{k}} = $+{v}; next; };
+ }
+ return %meta;
+ }
+
+}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/imager Tue Jul 12 00:21:58 2011 +0200
@@ -0,0 +1,113 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use POSIX qw(strftime);
+use autodie qw(:all);
+use Digest::MD5 qw(md5_hex);
+use File::Path qw(make_path);
+use File::Basename;
+use File::Temp;
+use Sys::Hostname;
+
+use constant KiB => 1024;
+use constant MiB => 1024 * KiB;
+use constant GiB => 1024 * MiB;
+
+sub get_devsize;
+sub get_devname;
+
+$SIG{INT} = sub { die "Got INT\n" };
+
+my $DEV = shift // die "Need device name\n";
+my $DIR = shift // die "Need destination (root) directory\n";
+my $BS = 8 * MiB; # should be multiple of 4k (file system block size)
+my $NOW = time();
+my $DATETIME = strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime($NOW));
+my $SIZE = get_devsize($DEV);
+
+my $DATA = "$DIR/data";
+my $IDX = "$DIR/idx/{HOSTNAME}/{DEVICE}/";
+$IDX =~ s/{HOSTNAME}/hostname/e;
+$IDX =~ s/{DEVICE}/get_devname($DEV)/e;
+
+
+-d $DIR or die "$0: $DIR: $!\n";
+make_path($DATA, $IDX);
+
+
+my $index = File::Temp->new(DIR => $IDX);
+
+print {$index} <<__EOT;
+format: 1
+filesystem: $DEV
+blocksize: $BS
+devsize: $SIZE
+timestamp: $NOW
+datetime: $DATETIME
+
+__EOT
+
+
+open(my $dev => $DEV);
+local $/ = \$BS;
+local $| = 1;
+
+my %stats = (
+ written => 0,
+ skipped => 0
+);
+
+while (my $data = <$dev>) {
+ my $cs = md5_hex($data);
+ #(my $file = $cs) =~ s/(........)(?=.)/$1\//g;
+ #(my $file = $cs) =~ s/(.)(..)(....)(........)(.*)/$1\/$2\/$3\/$4\/$5/g;
+ (my $file = $cs) =~ s/(...)(..)(.)(.*)/$1\/$2\/$3\/$4/g;
+ #$file = dirname($file) . "/$cs";
+
+ my $log = sprintf "%6d %s %s" => ($.-1), $cs, $file;
+
+ if (!-e "$DATA/$file") {
+ make_path dirname("$DATA/$file");
+ open(my $out, ">$DATA/$file");
+ print {$out} $data;
+ close($out);
+ $log .= " *";
+ $stats{written}++;
+ }
+ else {
+ $log .= " ";
+ $stats{skipped}++;
+ }
+
+ say $log . sprintf "%3d%%" => 100 * ($. * $BS)/$SIZE;
+ say {$index} $log;
+}
+
+say {$index} "# DONE (runtime " . (time() - $^T) . "s)";
+
+say "# DONE (runtime " . (time() - $^T) . "s)";
+say "# WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";
+say "# SAVINGS "
+ . sprintf "%3d%%" => 100 * ($stats{skipped}/($stats{written}+$stats{skipped}));
+
+rename $index->filename => "$IDX/$DATETIME";
+close $index;
+
+#---
+#
+sub get_devsize {
+ my ($devname) = @_;
+ open(my $fh => $devname);
+ seek($fh, 0, 2);
+ return tell($fh);
+}
+
+sub get_devname {
+ my $_ = shift;
+ s/^\/dev\///;
+ s/_/__/g;
+ s/\//_/g;
+ return $_;
+}