imager and fuse seem to work, catter should be reviewed!
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Sun, 24 Jul 2011 00:22:11 +0200
changeset 5 bef1e4dd8e85
parent 4 fb2455a007a7
child 6 129b39480dc5
imager and fuse seem to work, catter should be reviewed!
fuse
imager
--- a/fuse	Fri Jul 22 17:06:09 2011 +0200
+++ b/fuse	Sun Jul 24 00:22:11 2011 +0200
@@ -32,7 +32,8 @@
 { package fs;
   use strict;
   use warnings;
-  use POSIX qw(:errno_h);
+  use POSIX qw(:errno_h); 
+  use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
   use autodie qw(:all);
 
   our ($ROOT, $DATA, $IDX);
@@ -40,18 +41,15 @@
   my %CACHE;
 
     sub getattr {
-		my $path = $IDX . shift;
-		return stat $path if -d $path;
-		# rest are the idx
-		my @attr = stat $path or return -(ENOENT);
-		my %meta = _get_meta($path);
-		use Data::Dumper;
-		warn Dumper \%meta;
-		$attr[7] = $meta{devsize};
-		$attr[9] = $meta{timestamp};
-		$attr[2] &= ~0222;		# r/o
-		warn Dumper \@attr;
-		return @attr;
+	my $path = $IDX . shift;
+	return stat $path if -d $path;
+	# 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 {
@@ -60,7 +58,6 @@
 	return (readdir($dh), 0);
     }
 
-
     sub openfile {
 	my $path = $IDX . shift;
 	return 0 if exists $FILE{$path};
@@ -78,6 +75,7 @@
 	    $block-- if not $FILE{$path}{meta}{format};
 	    $FILE{$path}{blocklist}{$block} = $file;
 	}
+	close $fh;
 	return 0;
     }
 
@@ -88,7 +86,7 @@
 	return "" if $offset >= $finfo->{meta}{devsize};
 
 	my $buffer = "";
-	for (my $need = $size; $need; $need = $size - length($buffer)) {
+	for (my $need = $size; $need > 0; $need = $size - length($buffer)) {
 	    $buffer .= _readblock($finfo, $need, $offset + length($buffer));
 	}
 
@@ -108,10 +106,25 @@
 	    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>;
+	my $fn = "$DATA/" . $finfo->{blocklist}{$block};
+	if (-e $fn) {
+		open(my $fh => $fn);
+		binmode($fh);
+		seek($fh => $blockoffset, 0) or die "seek: $!";
+		local $/ = \$length;
+		return scalar <$fh>;
+	}
+	elsif (-e "$fn.gz") {
+		open(my $fh => "$fn.gz");
+		binmode($fh);
+		my $buffer;
+		gunzip($fh => \$buffer)
+			or die $GunzipError;
+		close($fh);
+		return substr($buffer, $blockoffset, $size);
+	}
+	
+	die "$fn: $!\n";
     }
 
     sub writebuffer {
@@ -120,10 +133,11 @@
 	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;
+	for (my $written = 0; $written < $size;) {
+	     # OPTIMIZE: we should not ask for writing more than the
+	     # blocksize
+	     my $n = _writeblock($finfo, substr($buffer, $written), $offset + $written) 
+		or return $written;
 	     $written += $n;
 	}
 	return $size;
@@ -137,14 +151,15 @@
 	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);
+	    #open(my $fh => "$DATA/" . $finfo->{blocklist}{$block});
+	    #local $/ = undef;
+	    #$CACHE{$finfo}{$block} = <$fh>;
+	    #close($fh);
+	    $CACHE{$finfo}{$block} = _readblock($finfo, $finfo->{meta}{blocksize}, $block * $finfo->{meta}{blocksize});
 	}
 
 	my $length = $finfo->{meta}{blocksize} - $blockoffset;
-	$length = $size if $size <= $length;
+	$length = $size if $size < $length;
 
 	substr($CACHE{$finfo}{$block}, $blockoffset, $length)
 	    = substr($buffer, 0, $length);
--- a/imager	Fri Jul 22 17:06:09 2011 +0200
+++ b/imager	Sun Jul 24 00:22:11 2011 +0200
@@ -18,7 +18,6 @@
 use constant KiB => 1024;
 use constant MiB => 1024 * KiB;
 use constant GiB => 1024 * MiB;
-use constant BLOCKSIZE => 1 * MiB;
 use constant NOW => time();
 use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW));
 
@@ -30,6 +29,7 @@
 my %o = (
     compress => undef,
     verbose => undef,
+    blocksize => 4 * MiB,
 ); lock_keys(%o);
 
 my $NOW = time();
@@ -47,6 +47,16 @@
 			 -noperldoc => system("perldoc -V >/dev/null 2>&1"))
 		   },
 	"z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
+	"b|blocksize=s" => sub {
+	    given ($_[1]) {
+		when (/(\d+)G/i) { $o{blocksize} = $1 * GiB };
+		when (/(\d+)M/i) { $o{blocksize} = $1 * MiB };
+		when (/(\d+)K/i) { $o{blocksize} = $1 * KiB };
+		when (/^(\d+)$/) { $o{blocksize} = $1 };
+		default	       { die "Blocksize $_[1] is incorrect!\n"
+		};
+	    }
+	},
     ) and @ARGV == 2 or pod2usage;
     ($src, $dst) = @ARGV;
 
@@ -64,8 +74,9 @@
     print {$index} <<__EOT;
 # imager
 format: 1
+host: @{[hostname]}
 filesystem: $src
-blocksize: @{[BLOCKSIZE]}
+blocksize: $o{blocksize}
 devsize: $size
 timestamp: @{[NOW]}
 datetime: @{[DATETIME]}
@@ -74,7 +85,7 @@
 
     open(my $in => $src);
     binmode($in);
-    local $/ = \(my $bs = BLOCKSIZE);
+    local $/ = \(my $bs = $o{blocksize});
     local $| = 1;
 
     my %stats = (
@@ -90,7 +101,7 @@
 	$ext = $o{compress} ? ".gz" : "";
 
 	# the extension we do not put into the index
-	my $log = sprintf "%6d %s %s" => ($.-1), $cs, $file;
+	my $log = sprintf "%12d %s %s" => ($.-1), $cs, $file;
 
 	if (not (-e "$data/$file" or -e "$data/$file$ext")) {
 	    mkpath dirname("$data/$file$ext");
@@ -114,7 +125,7 @@
 	    $stats{skipped}++;
 	}
 
-	say $log . sprintf "%3d%%" => 100 * ($. * BLOCKSIZE)/$size;
+	say $log . sprintf "%3d%%" => 100 * ($. * $o{blocksize})/$size;
 	say {$index} $log;
     }