1 #! /usr/bin/perl

     2 

     3 use 5.010;

     4 use strict;

     5 use warnings;

     6 use autodie qw(:all);

     7 use Getopt::Long;

     8 use Fuse;

     9 use POSIX qw(setpgid :errno_h);

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

    11 use Pod::Usage;

    12 use Hash::Util qw(lock_keys);

    13 use File::Temp;

    14 use DB_File;

    15 use File::Basename;

    16 

    17 my %o = (

    18     debug => undef,

    19     detach => 1,

    20     tmp => undef,

    21 ); lock_keys %o;

    22 

    23 use constant ME => basename $0;

    24 my ($DATA, $IDX);

    25 

    26 sub tie_vars;

    27 

    28 MAIN: {

    29 

    30     GetOptions(

    31 	"d|debug!" => \$o{debug},

    32 	"detach!" => \$o{detach},

    33 	"tmp:s" =>  sub { $o{tmp} = length  $_[1] ? $_[1] : $ENV{TMP}// "/tmp" },

    34 	"h|help" => sub { pod2usage(-verbose => 1, -exit => 0) },

    35 	"m|man" =>  sub { pod2usage(-verbose => 2, -exit => 0,

    36 		-noperlpod => system("perldoc -V 1>/dev/null 2>&1")) },

    37 	) and @ARGV == 2 or pod2usage;

    38 

    39     my ($src, $mp) = @ARGV;

    40 

    41     $DATA = "$src/data";

    42     $IDX = "$src/idx";

    43 

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

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

    46 

    47     if (!$o{debug} and $o{detach}) {

    48 	fork() and exit;

    49 	$0 = "FUSE $src $mp";

    50 	open(STDOUT => ">/dev/null");

    51 	open(STDIN => "/dev/null");

    52 

    53 	setpgid($$ => $$);

    54     }

    55 

    56     tie_vars $o{tmp};

    57 

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

    59 	debug => $o{debug} // 0,

    60 	getattr => \&getattr,

    61 	getdir => \&getdir,

    62 	open => \&openfile,

    63 	read => \&readbuffer,

    64 	write => \&writebuffer,

    65 	);

    66 

    67     exit;

    68 

    69 }

    70 

    71 # not the fuse functions

    72 

    73 {

    74     my (%IMAGE, %DIRTY);

    75 

    76 sub tie_vars {

    77     return if not defined $_[0];

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

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

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

    81 }

    82 

    83 sub getattr {

    84     my $path = $IDX . shift;

    85     return stat $path if -d $path;

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

    87     my %meta = _get_meta($path);

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

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

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

    91     return @attr;

    92 }

    93 

    94 sub getdir {

    95     my $path = $IDX . shift;

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

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

    98 }

    99 

   100 sub openfile {

   101     my $path = $IDX . shift;

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

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

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

   105 

   106     # skip the file header

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

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

   109 

   110     # should check for the format

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

   112 

   113     # now read the block list

   114     while (<$fh>) {

   115 	/^#/ and last;

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

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

   118     }

   119     close $fh;

   120     return 0;

   121 }

   122 

   123 sub readbuffer {

   124     my $path = $IDX . shift;

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

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

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

   128 

   129     my $buffer = "";

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

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

   132     }

   133 

   134     return $buffer;

   135 }

   136 

   137 sub _readblock {

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

   139 

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

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

   142 

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

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

   145 

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

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

   148     }

   149 

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

   151     if (-e $fn) {

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

   153 	    binmode($fh);

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

   155 	    local $/ = \$length;

   156 	    return scalar <$fh>;

   157     }

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

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

   160 	    binmode($fh);

   161 	    my $buffer;

   162 	    gunzip($fh => \$buffer)

   163 		    or die $GunzipError;

   164 	    close($fh);

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

   166     }

   167     

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

   169 }

   170 

   171 sub writebuffer {

   172     my $path = $IDX . shift;

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

   174     my $size = length($buffer);

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

   176 

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

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

   179 	 # blocksize

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

   181 	    or return $written;

   182 	 $written += $n;

   183     }

   184     return $size;

   185 }

   186 

   187 sub _writeblock {

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

   189     my $size = length($buffer);

   190 

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

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

   193 

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

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

   196 		$finfo, 

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

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

   199     }

   200 

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

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

   203 

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

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

   206 

   207     return $length;

   208 }

   209 

   210 sub _get_meta {

   211     my $path = shift;

   212     my %meta;

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

   214     while(<$fh>) {

   215 	last if /^$/;

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

   217     }

   218     return %meta;

   219 }

   220 

   221 }

   222 

   223 

   224 __END__

   225 

   226 =head1 NAME

   227 

   228     fuse-imager - the fuse mount helper for imagers backups

   229 

   230 =head1 SYNOPSIS

   231 

   232     fuse-imager [options] {src} {mount point}

   233 

   234 =head1 DESCRIPTION

   235 

   236 B<fuse-imager> mounts the src directory (containing F<data/> and F<idx/>

   237 directories) the the specified mount point.

   238 

   239 =head1 OPTIONS

   240 

   241 =over 4

   242 

   243 =item B<--tmp> [I<dir/>]

   244 

   245 Write dirty blocks into a buffer file in the specified tmp directory.

   246 If no directory is specified, the system default (usually F</tmp>) will

   247 be used. (default: no temp file)

   248 

   249 B<Beware>: The temporary file may get B<HUUGE>.

   250 

   251 =item B<-d>|B<--debug>

   252 

   253 Enables debugging output from B<Fuse>. When using this option,

   254 B<Fuse> does not detach from the terminal. (default: off)

   255 

   256 =item B<-->I<[no]>B<detach> 

   257 

   258 Detach or don't detach from the terminal. (default: detach)

   259 

   260 =item B<-h>|B<--help>

   261 

   262 =item B<-m>|B<--man>

   263 

   264 The common help and man options.

   265 

   266 =back

   267 

   268 =cut