--- a/fuse Tue Jul 26 10:30:03 2011 +0200
+++ b/fuse Tue Jul 26 11:54:40 2011 +0200
@@ -6,23 +6,31 @@
use autodie qw(:all);
use Getopt::Long;
use Fuse;
-use POSIX qw(setpgid);
+use POSIX qw(setpgid :errno_h);
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use Pod::Usage;
use Hash::Util qw(lock_keys);
+use File::Temp;
+use DB_File;
use File::Basename;
my %o = (
debug => undef,
detach => 1,
+ tmp => undef,
); lock_keys %o;
use constant ME => basename $0;
+my ($DATA, $IDX);
+
+sub tie_vars;
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")) },
@@ -30,11 +38,11 @@
my ($src, $mp) = @ARGV;
- $fs::DATA = "$src/data";
- $fs::IDX = "$src/idx";
+ $DATA = "$src/data";
+ $IDX = "$src/idx";
- die ME.": $fs::DATA: $!" if not -d $fs::DATA;
- die ME.": $fs::IDX: $!" if not -d $fs::IDX;
+ die ME.": $DATA: $!" if not -d $DATA;
+ die ME.": $IDX: $!" if not -d $IDX;
if (!$o{debug} and $o{detach}) {
fork() and exit;
@@ -45,168 +53,174 @@
setpgid($$ => $$);
}
+ tie_vars $o{tmp};
Fuse::main(mountpoint => $mp,
debug => $o{debug} // 0,
- getattr => "fs::getattr",
- getdir => "fs::getdir",
- open => "fs::openfile",
- read => "fs::readbuffer",
- write => "fs::writebuffer",
+ getattr => \&getattr,
+ getdir => \&getdir,
+ open => \&openfile,
+ read => \&readbuffer,
+ write => \&writebuffer,
);
+ exit;
+
}
-{ package fs;
- use strict;
- use warnings;
- use POSIX qw(:errno_h);
- use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
- use autodie qw(:all);
+# not the fuse functions
+
+{
+ my (%IMAGE, %DIRTY);
- our ($ROOT, $DATA, $IDX);
- my %IMAGE;
- my %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;
- # 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 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 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 $IMAGE{$path};
- $IMAGE{$path}{meta} = { _get_meta($path) };
- $IMAGE{$path}{blocklist} = {};
+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}
- open(my $fh => $path);
- { # the file header
- local $/ = "";
- scalar <$fh>;
- }
- while (<$fh>) {
- /^#/ and last;
- my ($block, $cs, $file) = split;
- $block-- if not $IMAGE{$path}{meta}{format};
- $IMAGE{$path}{blocklist}{$block} = $file;
- }
- close $fh;
- return 0;
+ # now read the block list
+ while (<$fh>) {
+ /^#/ and last;
+ my ($block, $cs, $file) = split;
+ $IMAGE{$path}{blocklist}{$block} = $file;
}
-
- 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};
+ close $fh;
+ return 0;
+}
- my $buffer = "";
- for (my $need = $size; $need > 0; $need = $size - length($buffer)) {
- $buffer .= _readblock($finfo, $need, $offset + length($buffer));
- }
+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};
- return $buffer;
+ my $buffer = "";
+ for (my $need = $size; $need > 0; $need = $size - length($buffer)) {
+ $buffer .= _readblock($finfo, $need, $offset + length($buffer));
}
- sub _readblock {
- my ($finfo, $size, $offset) = @_;
-
- my $block = int($offset / $finfo->{meta}{blocksize});
- my $blockoffset = $offset % $finfo->{meta}{blocksize};
+ return $buffer;
+}
- my $length = $finfo->{meta}{blocksize} - $blockoffset;
- $length = $size if $size <= $length;
-
- if (exists $DIRTY{$finfo.$block}) {
- return substr $DIRTY{$finfo.$block}, $blockoffset, $length;
- }
+sub _readblock {
+ my ($finfo, $size, $offset) = @_;
- 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";
+ 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);
+ }
+
+ die "$fn: $!\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;
+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;) {
+ # 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});
}
- sub _writeblock {
- my ($finfo, $buffer, $offset) = @_;
- my $size = length($buffer);
-
- 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 (not exists $DIRTY{$finfo.$block}) {
- $DIRTY{$finfo.$block} = _readblock(
- $finfo,
- $finfo->{meta}{blocksize},
- $block * $finfo->{meta}{blocksize});
- }
+ substr($DIRTY{$finfo.$block}, $blockoffset, $length)
+ = substr($buffer, 0, $length);
- my $length = $finfo->{meta}{blocksize} - $blockoffset;
- $length = $size if $size < $length;
+ return $length;
+}
- substr($DIRTY{$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; };
}
-
- 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;
- }
+ return %meta;
+}
}
+
__END__
=head1 NAME
@@ -226,6 +240,14 @@
=over 4
+=item B<--tmp> [I<dir/>]
+
+Write dirty blocks into a buffer file in the specified tmp directory.
+If no directory is specified, the system default (usually F</tmp>) will
+be used. (default: no temp file)
+
+B<Beware>: The temporary file may get B<HUUGE>.
+
=item B<-d>|B<--debug>
Enables debugging output from B<Fuse>. When using this option,