13 use File::Temp; |
13 use File::Temp; |
14 use DB_File; |
14 use DB_File; |
15 use File::Basename; |
15 use File::Basename; |
16 |
16 |
17 my %o = ( |
17 my %o = ( |
18 debug => undef, |
18 debug => undef, |
19 detach => 1, |
19 detach => 1, |
20 tmp => undef, |
20 tmp => undef, |
21 ); lock_keys %o; |
21 ); |
|
22 lock_keys %o; |
22 |
23 |
23 use constant ME => basename $0; |
24 use constant ME => basename $0; |
24 my ($DATA, $IDX); |
25 my ($DATA, $IDX); |
25 |
26 |
26 sub tie_vars; |
27 sub tie_vars; |
27 |
28 |
28 MAIN: { |
29 MAIN: { |
29 |
30 |
30 GetOptions( |
31 GetOptions( |
31 "d|debug!" => \$o{debug}, |
32 "d|debug!" => \$o{debug}, |
32 "detach!" => \$o{detach}, |
33 "detach!" => \$o{detach}, |
33 "tmp:s" => sub { $o{tmp} = length $_[1] ? $_[1] : $ENV{TMP}// "/tmp" }, |
34 "tmp:s" => sub { $o{tmp} = length $_[1] ? $_[1] : $ENV{TMP} // "/tmp" }, |
34 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
35 "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, |
35 "m|man" => sub { pod2usage(-verbose => 2, -exit => 0, |
36 "m|man" => sub { |
36 -noperlpod => system("perldoc -V 1>/dev/null 2>&1")) }, |
37 pod2usage( |
37 ) and @ARGV == 2 or pod2usage; |
38 -verbose => 2, |
|
39 -exit => 0, |
|
40 -noperlpod => system("perldoc -V 1>/dev/null 2>&1") |
|
41 ); |
|
42 }, |
|
43 ) |
|
44 and @ARGV == 2 |
|
45 or pod2usage; |
38 |
46 |
39 my ($src, $mp) = @ARGV; |
47 my ($src, $mp) = @ARGV; |
40 |
48 |
41 $DATA = "$src/data"; |
49 $DATA = "$src/data"; |
42 $IDX = "$src/idx"; |
50 $IDX = "$src/idx"; |
43 |
51 |
44 die ME.": $DATA: $!" if not -d $DATA; |
52 die ME . ": $DATA: $!" if not -d $DATA; |
45 die ME.": $IDX: $!" if not -d $IDX; |
53 die ME . ": $IDX: $!" if not -d $IDX; |
46 |
54 |
47 if (!$o{debug} and $o{detach}) { |
55 if (!$o{debug} and $o{detach}) { |
48 fork() and exit; |
56 fork() and exit; |
49 $0 = "FUSE $src $mp"; |
57 $0 = "FUSE $src $mp"; |
50 open(STDOUT => ">/dev/null"); |
58 open(STDOUT => ">/dev/null"); |
51 open(STDIN => "/dev/null"); |
59 open(STDIN => "/dev/null"); |
52 |
60 |
53 setpgid($$ => $$); |
61 setpgid($$ => $$); |
54 } |
62 } |
55 |
63 |
56 tie_vars $o{tmp}; |
64 tie_vars $o{tmp}; |
57 |
65 |
58 Fuse::main(mountpoint => $mp, |
66 Fuse::main( |
59 debug => $o{debug} // 0, |
67 mountpoint => $mp, |
60 getattr => \&getattr, |
68 debug => $o{debug} // 0, |
61 getdir => \&getdir, |
69 getattr => \&getattr, |
62 open => \&openfile, |
70 getdir => \&getdir, |
63 read => \&readbuffer, |
71 open => \&openfile, |
64 write => \&writebuffer, |
72 read => \&readbuffer, |
65 ); |
73 write => \&writebuffer, |
|
74 ); |
66 |
75 |
67 exit; |
76 exit; |
68 |
77 |
69 } |
78 } |
70 |
79 |
71 # not the fuse functions |
80 # not the fuse functions |
72 |
81 |
73 { |
82 { |
74 my (%IMAGE, %DIRTY); |
83 my (%IMAGE, %DIRTY); |
75 |
84 |
76 sub tie_vars { |
85 sub tie_vars { |
77 return if not defined $_[0]; |
86 return if not defined $_[0]; |
78 my $file = -d $_[0] ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")->filename : shift; |
87 my $file = |
79 tie %DIRTY, "DB_File" => $file |
88 -d $_[0] |
80 or die "Can't tie to $file: $!\n"; |
89 ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX") |
|
90 ->filename |
|
91 : shift; |
|
92 tie %DIRTY, "DB_File" => $file |
|
93 or die "Can't tie to $file: $!\n"; |
|
94 } |
|
95 |
|
96 sub getattr { |
|
97 my $path = $IDX . shift; |
|
98 return stat $path if -d $path; |
|
99 my @attr = stat $path or return -(ENOENT); |
|
100 my %meta = _get_meta($path); |
|
101 $attr[7] = $meta{devsize}; |
|
102 $attr[9] = $meta{timestamp}; |
|
103 $attr[2] &= ~0222; # r/o |
|
104 return @attr; |
|
105 } |
|
106 |
|
107 sub getdir { |
|
108 my $path = $IDX . shift; |
|
109 opendir(my $dh, $path) or return 0; |
|
110 return (readdir($dh), 0); |
|
111 } |
|
112 |
|
113 sub openfile { |
|
114 my $path = $IDX . shift; |
|
115 return 0 if exists $IMAGE{$path}; |
|
116 $IMAGE{$path}{meta} = { _get_meta($path) }; |
|
117 $IMAGE{$path}{blocklist} = {}; |
|
118 |
|
119 # skip the file header |
|
120 open(my $fh => $path); |
|
121 { local $/ = ""; scalar <$fh> } |
|
122 |
|
123 # should check for the format |
|
124 # $IMAGE{$path}{meta}{format} |
|
125 |
|
126 # now read the block list |
|
127 while (<$fh>) { |
|
128 /^#/ and last; |
|
129 my ($block, $cs, $file) = split; |
|
130 $IMAGE{$path}{blocklist}{$block} = $file; |
|
131 } |
|
132 close $fh; |
|
133 return 0; |
|
134 } |
|
135 |
|
136 sub readbuffer { |
|
137 my $path = $IDX . shift; |
|
138 my ($size, $offset) = @_; |
|
139 my $finfo = $IMAGE{$path} or die "File $path is not opened!"; |
|
140 return "" if $offset >= $finfo->{meta}{devsize}; |
|
141 |
|
142 my $buffer = ""; |
|
143 for (my $need = $size ; $need > 0 ; $need = $size - length($buffer)) { |
|
144 $buffer .= _readblock($finfo, $need, $offset + length($buffer)); |
|
145 } |
|
146 |
|
147 return $buffer; |
|
148 } |
|
149 |
|
150 sub _readblock { |
|
151 my ($finfo, $size, $offset) = @_; |
|
152 |
|
153 my $block = int($offset / $finfo->{meta}{blocksize}); |
|
154 my $blockoffset = $offset % $finfo->{meta}{blocksize}; |
|
155 |
|
156 my $length = $finfo->{meta}{blocksize} - $blockoffset; |
|
157 $length = $size if $size <= $length; |
|
158 |
|
159 if (exists $DIRTY{ $finfo . $block }) { |
|
160 return substr $DIRTY{ $finfo . $block }, $blockoffset, $length; |
|
161 } |
|
162 |
|
163 my $fn = "$DATA/" . $finfo->{blocklist}{$block}; |
|
164 if (-e $fn) { |
|
165 open(my $fh => $fn); |
|
166 binmode($fh); |
|
167 seek($fh => $blockoffset, 0) or die "seek: $!"; |
|
168 local $/ = \$length; |
|
169 return scalar <$fh>; |
|
170 } |
|
171 elsif (-e "$fn.gz") { |
|
172 open(my $fh => "$fn.gz"); |
|
173 binmode($fh); |
|
174 my $buffer; |
|
175 gunzip($fh => \$buffer) |
|
176 or die $GunzipError; |
|
177 close($fh); |
|
178 return substr($buffer, $blockoffset, $size); |
|
179 } |
|
180 |
|
181 die "$fn: $!\n"; |
|
182 } |
|
183 |
|
184 sub writebuffer { |
|
185 my $path = $IDX . shift; |
|
186 my ($buffer, $offset) = @_; |
|
187 my $size = length($buffer); |
|
188 my $finfo = $IMAGE{$path} or die "File $path is not opened!"; |
|
189 |
|
190 for (my $written = 0 ; $written < $size ;) { |
|
191 |
|
192 # OPTIMIZE: we should not ask for writing more than the |
|
193 # blocksize |
|
194 my $n = |
|
195 _writeblock($finfo, substr($buffer, $written), $offset + $written) |
|
196 or return $written; |
|
197 $written += $n; |
|
198 } |
|
199 return $size; |
|
200 } |
|
201 |
|
202 sub _writeblock { |
|
203 my ($finfo, $buffer, $offset) = @_; |
|
204 my $size = length($buffer); |
|
205 |
|
206 my $block = int($offset / $finfo->{meta}{blocksize}); |
|
207 my $blockoffset = $offset % $finfo->{meta}{blocksize}; |
|
208 |
|
209 if (not exists $DIRTY{ $finfo . $block }) { |
|
210 $DIRTY{ $finfo . $block } = _readblock( |
|
211 $finfo, |
|
212 $finfo->{meta}{blocksize}, |
|
213 $block * $finfo->{meta}{blocksize} |
|
214 ); |
|
215 } |
|
216 |
|
217 my $length = $finfo->{meta}{blocksize} - $blockoffset; |
|
218 $length = $size if $size < $length; |
|
219 |
|
220 substr($DIRTY{ $finfo . $block }, $blockoffset, $length) = |
|
221 substr($buffer, 0, $length); |
|
222 |
|
223 return $length; |
|
224 } |
|
225 |
|
226 sub _get_meta { |
|
227 my $path = shift; |
|
228 my %meta; |
|
229 open(my $fh => $path); |
|
230 while (<$fh>) { |
|
231 last if /^$/; |
|
232 /^(?<k>\S+):\s+(?<v>.*?)\s*$/ |
|
233 and do { $meta{ $+{k} } = $+{v}; next; }; |
|
234 } |
|
235 return %meta; |
|
236 } |
|
237 |
81 } |
238 } |
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 |
239 |
224 __END__ |
240 __END__ |
225 |
241 |
226 =head1 NAME |
242 =head1 NAME |
227 |
243 |