1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use autodie qw(:all);

     7 

     8 use Fuse;

     9 

    10 my $src = shift // die "need source directory\n";

    11 my $mp = shift // die "need mountpoint\n";

    12 

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

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

    15 

    16 Fuse::main(mountpoint => $mp,

    17     debug => 0,

    18     getattr => "fs::getattr",

    19     getdir => "fs::getdir",

    20     open => "fs::openfile",

    21     read => "fs::readbuffer",

    22     write => "fs::writebuffer",

    23     );

    24 

    25 

    26 { package fs;

    27   use strict;

    28   use warnings;

    29   use POSIX qw(:errno_h);

    30   use autodie qw(:all);

    31 

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

    33   my %FILE;

    34   my %CACHE;

    35 

    36     sub getattr {

    37 	my $path = $IDX . shift;

    38 	return stat $path if $path eq "$IDX/";

    39 	# rest are the idx

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

    41 	my %meta = _get_meta($path);

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

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

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

    45 	return @attr;

    46     }

    47 

    48     sub getdir {

    49 	my $path = $IDX . shift;

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

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

    52     }

    53 

    54 

    55     sub openfile {

    56 	my $path = $IDX . shift;

    57 	return 0 if exists $FILE{$path};

    58 	$FILE{$path}{meta} = { _get_meta($path) };

    59 	$FILE{$path}{blocklist} = {};

    60 

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

    62 	{   # the file header

    63 	    local $/ = "";

    64 	    scalar <$fh>;

    65 	}

    66 	while (<$fh>) {

    67 	    /^#/ and last;

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

    69 	    $block-- if not $FILE{$path}{meta}{format};

    70 	    $FILE{$path}{blocklist}{$block} = $file;

    71 	}

    72 	return 0;

    73     }

    74 

    75     sub readbuffer {

    76 	my $path = $IDX . shift;

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

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

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

    80 

    81 	my $buffer = "";

    82 	for (my $need = $size; $need; $need = $size - length($buffer)) {

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

    84 	}

    85 

    86 	return $buffer;

    87     }

    88 

    89     sub _readblock {

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

    91 

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

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

    94 

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

    96 	$length = $size if $size <= $length;

    97 

    98 	if (exists $CACHE{$finfo}{$block}) {

    99 	    return substr $CACHE{$finfo}{$block}, $blockoffset, $length;

   100 	}

   101 

   102 	open(my $fh => "$DATA/" . $finfo->{blocklist}{$block});

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

   104 	local $/ = \$length;

   105 	return scalar <$fh>;

   106     }

   107 

   108     sub writebuffer {

   109 	my $path = $IDX . shift;

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

   111 	my $size = length($buffer);

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

   113 

   114 	my $written = 0;

   115 	while ($written < $size) {

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

   117 	     return $written if not $n;

   118 	     $written += $n;

   119 	}

   120 	return $size;

   121     }

   122 

   123     sub _writeblock {

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

   125 	my $size = length($buffer);

   126 

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

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

   129 

   130 	if (not exists $CACHE{$finfo}{$block}) {

   131 	    open(my $fh => "$DATA/" . $finfo->{blocklist}{$block});

   132 	    local $/ = undef;

   133 	    $CACHE{$finfo}{$block} = <$fh>;

   134 	    close($fh);

   135 	}

   136 

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

   138 	$length = $size if $size <= $length;

   139 

   140 	substr($CACHE{$finfo}{$block}, $blockoffset, $length)

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

   142 

   143 	return $length;

   144     }

   145 

   146     sub _get_meta {

   147 	my $path = shift;

   148 	my %meta;

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

   150 	while(<$fh>) {

   151 	    last if /^$/;

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

   153 	}

   154 	return %meta;

   155     }

   156 

   157 }