bin/fuse-imager
changeset 21 e0f19213f8b6
parent 19 49ff641055a3
child 31 221af7ffe050
--- a/bin/fuse-imager	Thu Jul 28 10:03:15 2011 +0200
+++ b/bin/fuse-imager	Thu Jul 28 11:12:38 2011 +0200
@@ -15,10 +15,11 @@
 use File::Basename;
 
 my %o = (
-    debug => undef,
+    debug  => undef,
     detach => 1,
-    tmp => undef,
-); lock_keys %o;
+    tmp    => undef,
+);
+lock_keys %o;
 
 use constant ME => basename $0;
 my ($DATA, $IDX);
@@ -28,41 +29,49 @@
 MAIN: {
 
     GetOptions(
-	"d|debug!" => \$o{debug},
-	"detach!" => \$o{detach},
-	"tmp:s" =>  sub { $o{tmp} = length  $_[1] ? $_[1] : $ENV{TMP}// "/tmp" },
-	"h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
-	"m|man" =>  sub { pod2usage(-verbose => 2, -exit => 0,
-		-noperlpod => system("perldoc -V 1>/dev/null 2>&1")) },
-	) and @ARGV == 2 or pod2usage;
+        "d|debug!" => \$o{debug},
+        "detach!"  => \$o{detach},
+        "tmp:s" => sub { $o{tmp} = length $_[1] ? $_[1] : $ENV{TMP} // "/tmp" },
+        "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },
+        "m|man"  => sub {
+            pod2usage(
+                -verbose   => 2,
+                -exit      => 0,
+                -noperlpod => system("perldoc -V 1>/dev/null 2>&1")
+            );
+        },
+      )
+      and @ARGV == 2
+      or pod2usage;
 
     my ($src, $mp) = @ARGV;
 
     $DATA = "$src/data";
-    $IDX = "$src/idx";
+    $IDX  = "$src/idx";
 
-    die ME.": $DATA: $!" if not -d $DATA;
-    die ME.": $IDX: $!" if not -d $IDX;
+    die ME . ": $DATA: $!" if not -d $DATA;
+    die ME . ": $IDX: $!"  if not -d $IDX;
 
     if (!$o{debug} and $o{detach}) {
-	fork() and exit;
-	$0 = "FUSE $src $mp";
-	open(STDOUT => ">/dev/null");
-	open(STDIN => "/dev/null");
+        fork() and exit;
+        $0 = "FUSE $src $mp";
+        open(STDOUT => ">/dev/null");
+        open(STDIN  => "/dev/null");
 
-	setpgid($$ => $$);
+        setpgid($$ => $$);
     }
 
     tie_vars $o{tmp};
 
-    Fuse::main(mountpoint => $mp,
-	debug => $o{debug} // 0,
-	getattr => \&getattr,
-	getdir => \&getdir,
-	open => \&openfile,
-	read => \&readbuffer,
-	write => \&writebuffer,
-	);
+    Fuse::main(
+        mountpoint => $mp,
+        debug      => $o{debug} // 0,
+        getattr    => \&getattr,
+        getdir     => \&getdir,
+        open       => \&openfile,
+        read       => \&readbuffer,
+        write      => \&writebuffer,
+    );
 
     exit;
 
@@ -73,154 +82,161 @@
 {
     my (%IMAGE, %DIRTY);
 
-sub tie_vars {
-    return if not defined $_[0];
-    my $file = -d $_[0] ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")->filename : shift;
-    tie %DIRTY, "DB_File" => $file
-	or die "Can't tie to $file: $!\n";
-}
-
-sub getattr {
-    my $path = $IDX . shift;
-    return stat $path if -d $path;
-    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 tie_vars {
+        return if not defined $_[0];
+        my $file =
+          -d $_[0]
+          ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")
+          ->filename
+          : shift;
+        tie %DIRTY, "DB_File" => $file
+          or die "Can't tie to $file: $!\n";
+    }
 
-sub openfile {
-    my $path = $IDX . shift;
-    return 0 if exists $IMAGE{$path};
-    $IMAGE{$path}{meta} = { _get_meta($path) };
-    $IMAGE{$path}{blocklist} = {};
-
-    # skip the file header
-    open(my $fh => $path);
-    {   local $/ = ""; scalar <$fh> }
-
-    # should check for the format
-    # $IMAGE{$path}{meta}{format}
+    sub getattr {
+        my $path = $IDX . shift;
+        return stat $path if -d $path;
+        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;
+    }
 
-    # now read the block list
-    while (<$fh>) {
-	/^#/ and last;
-	my ($block, $cs, $file) = split;
-	$IMAGE{$path}{blocklist}{$block} = $file;
-    }
-    close $fh;
-    return 0;
-}
-
-sub readbuffer {
-    my $path = $IDX . shift;
-    my ($size, $offset) = @_;
-    my $finfo = $IMAGE{$path} or die "File $path is not opened!";
-    return "" if $offset >= $finfo->{meta}{devsize};
-
-    my $buffer = "";
-    for (my $need = $size; $need > 0; $need = $size - length($buffer)) {
-	$buffer .= _readblock($finfo, $need, $offset + length($buffer));
+    sub getdir {
+        my $path = $IDX . shift;
+        opendir(my $dh, $path) or return 0;
+        return (readdir($dh), 0);
     }
 
-    return $buffer;
-}
+    sub openfile {
+        my $path = $IDX . shift;
+        return 0 if exists $IMAGE{$path};
+        $IMAGE{$path}{meta}      = { _get_meta($path) };
+        $IMAGE{$path}{blocklist} = {};
 
-sub _readblock {
-    my ($finfo, $size, $offset) = @_;
+        # skip the file header
+        open(my $fh => $path);
+        { local $/ = ""; scalar <$fh> }
+
+        # should check for the format
+        # $IMAGE{$path}{meta}{format}
 
-    my $block = int($offset / $finfo->{meta}{blocksize});
-    my $blockoffset = $offset % $finfo->{meta}{blocksize};
+        # now read the block list
+        while (<$fh>) {
+            /^#/ and last;
+            my ($block, $cs, $file) = split;
+            $IMAGE{$path}{blocklist}{$block} = $file;
+        }
+        close $fh;
+        return 0;
+    }
 
-    my $length = $finfo->{meta}{blocksize} - $blockoffset;
-    $length = $size if $size <= $length;
+    sub readbuffer {
+        my $path = $IDX . shift;
+        my ($size, $offset) = @_;
+        my $finfo = $IMAGE{$path} or die "File $path is not opened!";
+        return "" if $offset >= $finfo->{meta}{devsize};
 
-    if (exists $DIRTY{$finfo.$block}) {
-	return substr $DIRTY{$finfo.$block}, $blockoffset, $length;
+        my $buffer = "";
+        for (my $need = $size ; $need > 0 ; $need = $size - length($buffer)) {
+            $buffer .= _readblock($finfo, $need, $offset + length($buffer));
+        }
+
+        return $buffer;
     }
 
-    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 _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 $DIRTY{ $finfo . $block }) {
+            return substr $DIRTY{ $finfo . $block }, $blockoffset, $length;
+        }
 
-sub writebuffer {
-    my $path = $IDX . shift;
-    my ($buffer, $offset) = @_;
-    my $size = length($buffer);
-    my $finfo = $IMAGE{$path} or die "File $path is not opened!";
+        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);
+        }
 
-    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;
-}
-
-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 $DIRTY{$finfo.$block}) {
-	$DIRTY{$finfo.$block} = _readblock(
-		$finfo, 
-		$finfo->{meta}{blocksize}, 
-		$block * $finfo->{meta}{blocksize});
+        die "$fn: $!\n";
     }
 
-    my $length = $finfo->{meta}{blocksize} - $blockoffset;
-    $length = $size if $size < $length;
+    sub writebuffer {
+        my $path = $IDX . shift;
+        my ($buffer, $offset) = @_;
+        my $size = length($buffer);
+        my $finfo = $IMAGE{$path} or die "File $path is not opened!";
+
+        for (my $written = 0 ; $written < $size ;) {
 
-    substr($DIRTY{$finfo.$block}, $blockoffset, $length)
-	= substr($buffer, 0, $length);
+            # 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;
+    }
 
-    return $length;
-}
+    sub _writeblock {
+        my ($finfo, $buffer, $offset) = @_;
+        my $size = length($buffer);
+
+        my $block       = int($offset / $finfo->{meta}{blocksize});
+        my $blockoffset = $offset % $finfo->{meta}{blocksize};
 
-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; };
+        if (not exists $DIRTY{ $finfo . $block }) {
+            $DIRTY{ $finfo . $block } = _readblock(
+                $finfo,
+                $finfo->{meta}{blocksize},
+                $block * $finfo->{meta}{blocksize}
+            );
+        }
+
+        my $length = $finfo->{meta}{blocksize} - $blockoffset;
+        $length = $size if $size < $length;
+
+        substr($DIRTY{ $finfo . $block }, $blockoffset, $length) =
+          substr($buffer, 0, $length);
+
+        return $length;
     }
-    return %meta;
-}
+
+    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;
+    }
 
 }
 
-
 __END__
 
 =head1 NAME