9 use POSIX qw(setpgid);

     9 use POSIX qw(setpgid :errno_h);

    10 use IO::Uncompress::Gunzip qw(gunzip $GunzipError);

    33     $fs::DATA = "$src/data";

    41     $DATA = "$src/data";

    34     $fs::IDX = "$src/idx";

    42     $IDX = "$src/idx";

    35 

    43 

    36     die ME.": $fs::DATA: $!" if not -d $fs::DATA;

    44     die ME.": $DATA: $!" if not -d $DATA;

    37     die ME.": $fs::IDX: $!" if not -d $fs::IDX;

    45     die ME.": $IDX: $!" if not -d $IDX;

    51 	getattr => "fs::getattr",

    60 	getattr => \&getattr,

    52 	getdir => "fs::getdir",

    61 	getdir => \&getdir,

    53 	open => "fs::openfile",

    62 	open => \&openfile,

    54 	read => "fs::readbuffer",

    63 	read => \&readbuffer,

    55 	write => "fs::writebuffer",

    64 	write => \&writebuffer,

    58 }

    67     exit;

    59 

    68 

    60 { package fs;

    69 }

    61   use strict;

    70 

    62   use warnings;

    71 # not the fuse functions

    63   use POSIX qw(:errno_h); 

    72 

    64   use IO::Uncompress::Gunzip qw(gunzip $GunzipError);

    73 {

    65   use autodie qw(:all);

    74     my (%IMAGE, %DIRTY);

    66 

    75 

    67   our ($ROOT, $DATA, $IDX);

    76 sub tie_vars {

    68   my %IMAGE;

    77     return if not defined $_[0];

    69   my %DIRTY;

    78     my $file = -d $_[0] ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")->filename : shift;

    70 

    79     tie %DIRTY, "DB_File" => $file

    71     sub getattr {

    80 	or die "Can't tie to $file: $!\n";

    72 	my $path = $IDX . shift;

    81 }

    73 	return stat $path if -d $path;

    82 

    74 	# rest are the idx

    83 sub getattr {

    75 	my @attr = stat $path or return -(ENOENT);

    84     my $path = $IDX . shift;

    76 	my %meta = _get_meta($path);

    85     return stat $path if -d $path;

    77 	$attr[7] = $meta{devsize};

    86     my @attr = stat $path or return -(ENOENT);

    78 	$attr[9] = $meta{timestamp};

    87     my %meta = _get_meta($path);

    79 	$attr[2] &= ~0222;		# r/o

    88     $attr[7] = $meta{devsize};

    80 	return @attr;

    89     $attr[9] = $meta{timestamp};

    81     }

    90     $attr[2] &= ~0222;		# r/o

    82 

    91     return @attr;

    83     sub getdir {

    92 }

    84 	my $path = $IDX . shift;

    93 

    85 	opendir(my $dh, $path) or return 0;

    94 sub getdir {

    86 	return (readdir($dh), 0);

    95     my $path = $IDX . shift;

    87     }

    96     opendir(my $dh, $path) or return 0;

    88 

    97     return (readdir($dh), 0);

    89     sub openfile {

    98 }

    90 	my $path = $IDX . shift;

    99 

    91 	return 0 if exists $IMAGE{$path};

   100 sub openfile {

    92 	$IMAGE{$path}{meta} = { _get_meta($path) };

   101     my $path = $IDX . shift;

    93 	$IMAGE{$path}{blocklist} = {};

   102     return 0 if exists $IMAGE{$path};

    94 

   103     $IMAGE{$path}{meta} = { _get_meta($path) };

    95 	open(my $fh => $path);

   104     $IMAGE{$path}{blocklist} = {};

    96 	{   # the file header

   105 

    97 	    local $/ = "";

   106     # skip the file header

    98 	    scalar <$fh>;

   107     open(my $fh => $path);

    99 	}

   108     {   local $/ = ""; scalar <$fh> }

   100 	while (<$fh>) {

   109 

   101 	    /^#/ and last;

   110     # should check for the format

   102 	    my ($block, $cs, $file) = split;

   111     # $IMAGE{$path}{meta}{format}

   103 	    $block-- if not $IMAGE{$path}{meta}{format};

   112 

   104 	    $IMAGE{$path}{blocklist}{$block} = $file;

   113     # now read the block list

   105 	}

   114     while (<$fh>) {

   106 	close $fh;

   115 	/^#/ and last;

   107 	return 0;

   116 	my ($block, $cs, $file) = split;

   108     }

   117 	$IMAGE{$path}{blocklist}{$block} = $file;

   109 

   118     }

   110     sub readbuffer {

   119     close $fh;

   111 	my $path = $IDX . shift;

   120     return 0;

   112 	my ($size, $offset) = @_;

   121 }

   113 	my $finfo = $IMAGE{$path} or die "File $path is not opened!";

   122 

   114 	return "" if $offset >= $finfo->{meta}{devsize};

   123 sub readbuffer {

   115 

   124     my $path = $IDX . shift;

   116 	my $buffer = "";

   125     my ($size, $offset) = @_;

   117 	for (my $need = $size; $need > 0; $need = $size - length($buffer)) {

   126     my $finfo = $IMAGE{$path} or die "File $path is not opened!";

   118 	    $buffer .= _readblock($finfo, $need, $offset + length($buffer));

   127     return "" if $offset >= $finfo->{meta}{devsize};

   119 	}

   128 

   120 

   129     my $buffer = "";

   121 	return $buffer;

   130     for (my $need = $size; $need > 0; $need = $size - length($buffer)) {

   122     }

   131 	$buffer .= _readblock($finfo, $need, $offset + length($buffer));

   123 

   132     }

   124     sub _readblock {

   133 

   125 	my ($finfo, $size, $offset) = @_;

   134     return $buffer;

   126 

   135 }

   127 	my $block = int($offset / $finfo->{meta}{blocksize});

   136 

   128 	my $blockoffset = $offset % $finfo->{meta}{blocksize};

   137 sub _readblock {

   129 

   138     my ($finfo, $size, $offset) = @_;

   130 	my $length = $finfo->{meta}{blocksize} - $blockoffset;

   139 

   131 	$length = $size if $size <= $length;

   140     my $block = int($offset / $finfo->{meta}{blocksize});

   132 

   141     my $blockoffset = $offset % $finfo->{meta}{blocksize};

   133 	if (exists $DIRTY{$finfo.$block}) {

   142 

   134 	    return substr $DIRTY{$finfo.$block}, $blockoffset, $length;

   143     my $length = $finfo->{meta}{blocksize} - $blockoffset;

   135 	}

   144     $length = $size if $size <= $length;

   136 

   145 

   137 	my $fn = "$DATA/" . $finfo->{blocklist}{$block};

   146     if (exists $DIRTY{$finfo.$block}) {

   138 	if (-e $fn) {

   147 	return substr $DIRTY{$finfo.$block}, $blockoffset, $length;

   139 		open(my $fh => $fn);

   148     }

   140 		binmode($fh);

   149 

   141 		seek($fh => $blockoffset, 0) or die "seek: $!";

   150     my $fn = "$DATA/" . $finfo->{blocklist}{$block};

   142 		local $/ = \$length;

   151     if (-e $fn) {

   143 		return scalar <$fh>;

   152 	    open(my $fh => $fn);

   144 	}

   153 	    binmode($fh);

   145 	elsif (-e "$fn.gz") {

   154 	    seek($fh => $blockoffset, 0) or die "seek: $!";

   146 		open(my $fh => "$fn.gz");

   155 	    local $/ = \$length;

   147 		binmode($fh);

   156 	    return scalar <$fh>;

   148 		my $buffer;

   157     }

   149 		gunzip($fh => \$buffer)

   158     elsif (-e "$fn.gz") {

   150 			or die $GunzipError;

   159 	    open(my $fh => "$fn.gz");

   151 		close($fh);

   160 	    binmode($fh);

   152 		return substr($buffer, $blockoffset, $size);

   161 	    my $buffer;

   153 	}

   162 	    gunzip($fh => \$buffer)

   154 	

   163 		    or die $GunzipError;

   155 	die "$fn: $!\n";

   164 	    close($fh);

   156     }

   165 	    return substr($buffer, $blockoffset, $size);

   157 

   166     }

   158     sub writebuffer {

   167     

   159 	my $path = $IDX . shift;

   168     die "$fn: $!\n";

   160 	my ($buffer, $offset) = @_;

   169 }

   161 	my $size = length($buffer);

   170 

   162 	my $finfo = $IMAGE{$path} or die "File $path is not opened!";

   171 sub writebuffer {

   163 

   172     my $path = $IDX . shift;

   164 	for (my $written = 0; $written < $size;) {

   173     my ($buffer, $offset) = @_;

   165 	     # OPTIMIZE: we should not ask for writing more than the

   174     my $size = length($buffer);

   166 	     # blocksize

   175     my $finfo = $IMAGE{$path} or die "File $path is not opened!";

   167 	     my $n = _writeblock($finfo, substr($buffer, $written), $offset + $written) 

   176 

   168 		or return $written;

   177     for (my $written = 0; $written < $size;) {

   169 	     $written += $n;

   178 	 # OPTIMIZE: we should not ask for writing more than the

   170 	}

   179 	 # blocksize

   171 	return $size;

   180 	 my $n = _writeblock($finfo, substr($buffer, $written), $offset + $written) 

   172     }

   181 	    or return $written;

   173 

   182 	 $written += $n;

   174     sub _writeblock {

   183     }

   175 	my ($finfo, $buffer, $offset) = @_;

   184     return $size;

   176 	my $size = length($buffer);

   185 }

   177 

   186 

   178 	my $block = int($offset / $finfo->{meta}{blocksize});

   187 sub _writeblock {

   179 	my $blockoffset = $offset % $finfo->{meta}{blocksize};

   188     my ($finfo, $buffer, $offset) = @_;

   180 

   189     my $size = length($buffer);

   181 	if (not exists $DIRTY{$finfo.$block}) {

   190 

   182 	    $DIRTY{$finfo.$block} = _readblock(

   191     my $block = int($offset / $finfo->{meta}{blocksize});

   183 		    $finfo, 

   192     my $blockoffset = $offset % $finfo->{meta}{blocksize};

   184 		    $finfo->{meta}{blocksize}, 

   193 

   185 		    $block * $finfo->{meta}{blocksize});

   194     if (not exists $DIRTY{$finfo.$block}) {

   186 	}

   195 	$DIRTY{$finfo.$block} = _readblock(

   187 

   196 		$finfo, 

   188 	my $length = $finfo->{meta}{blocksize} - $blockoffset;

   197 		$finfo->{meta}{blocksize}, 

   189 	$length = $size if $size < $length;

   198 		$block * $finfo->{meta}{blocksize});

   190 

   199     }

   191 	substr($DIRTY{$finfo.$block}, $blockoffset, $length)

   200 

   192 	    = substr($buffer, 0, $length);

   201     my $length = $finfo->{meta}{blocksize} - $blockoffset;

   193 

   202     $length = $size if $size < $length;

   194 	return $length;

   203 

   195     }

   204     substr($DIRTY{$finfo.$block}, $blockoffset, $length)

   196 

   205 	= substr($buffer, 0, $length);

   197     sub _get_meta {

   206 

   198 	my $path = shift;

   207     return $length;

   199 	my %meta;

   208 }

   200 	open(my $fh => $path);

   209 

   201 	while(<$fh>) {

   210 sub _get_meta {

   202 	    last if /^$/;

   211     my $path = shift;

   203 	    /^(?<k>\S+):\s+(?<v>.*?)\s*$/ and do { $meta{$+{k}} = $+{v}; next; };

   212     my %meta;

   204 	}

   213     open(my $fh => $path);

   205 	return %meta;

   214     while(<$fh>) {

   206     }

   215 	last if /^$/;

   207 

   216 	/^(?<k>\S+):\s+(?<v>.*?)\s*$/ and do { $meta{$+{k}} = $+{v}; next; };

   208 }

   217     }

   218     return %meta;

   219 }

   220 

   221 }

   222