# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1310422918 -7200
# Node ID e92e765779e715ac04e417ea8042e0703f0e69cd

first 3 tools…

diff -r 000000000000 -r e92e765779e7 catter
--- /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);
diff -r 000000000000 -r e92e765779e7 fuse
--- /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;
+    }
+
+}
diff -r 000000000000 -r e92e765779e7 imager
--- /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 $_;
+}