Line # Revision Author
1 1 dpavlin #!/usr/bin/perl
2
3 9 dpavlin package Fuse::DBI;
4
5 use 5.008;
6 use strict;
7 use warnings;
8
9 7 dpavlin use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10 1 dpavlin use Fuse;
11 use DBI;
12 11 dpavlin use Carp;
13 use Data::Dumper;
14 1 dpavlin
15 61 dpavlin our $VERSION = '0.09_1';
16 1 dpavlin
17 52 dpavlin # block size for this filesystem
18 use constant BLOCK => 1024;
19
20 9 dpavlin =head1 NAME
21 1 dpavlin
22 9 dpavlin Fuse::DBI - mount your database as filesystem and use it
23 1 dpavlin
24 9 dpavlin =head1 SYNOPSIS
25 6 dpavlin
26 9 dpavlin use Fuse::DBI;
27 11 dpavlin Fuse::DBI->mount( ... );
28 1 dpavlin
29 28 dpavlin See C<run> below for examples how to set parameters.
30 1 dpavlin
31 9 dpavlin =head1 DESCRIPTION
32 1 dpavlin
33 23 dpavlin This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
34 36 dpavlin available at L<http://fuse.sourceforge.net/> to mount
35 9 dpavlin your database as file system.
36 1 dpavlin
37 28 dpavlin That will give you possibility to use normal file-system tools (cat, grep, vi)
38 9 dpavlin to manipulate data in database.
39 1 dpavlin
40 9 dpavlin It's actually opposite of Oracle's intention to put everything into database.
41 1 dpavlin
42
43 9 dpavlin =head1 METHODS
44
45 =cut
46
47 11 dpavlin =head2 mount
48 9 dpavlin
49 Mount your database as filesystem.
50
51 28 dpavlin Let's suppose that your database have table C<files> with following structure:
52
53 id: int
54 filename: text
55 size: int
56 content: text
57 writable: boolean
58
59 Following is example how to mount table like that to C</mnt>:
60
61 11 dpavlin my $mnt = Fuse::DBI->mount({
62 28 dpavlin 'filenames' => 'select id,filename,size,writable from files',
63 'read' => 'select content from files where id = ?',
64 'update' => 'update files set content = ? where id = ?',
65 'dsn' => 'DBI:Pg:dbname=test_db',
66 'user' => 'database_user',
67 'password' => 'database_password',
68 'invalidate' => sub { ... },
69 9 dpavlin });
70
71 28 dpavlin Options:
72
73 =over 5
74
75 =item filenames
76
77 SQL query which returns C<id> (unique id for that row), C<filename>,
78 C<size> and C<writable> boolean flag.
79
80 =item read
81
82 SQL query which returns only one column with content of file and has
83 placeholder C<?> for C<id>.
84
85 =item update
86
87 SQL query with two pace-holders, one for new content and one for C<id>.
88
89 =item dsn
90
91 C<DBI> dsn to connect to (contains database driver and name of database).
92
93 =item user
94
95 User with which to connect to database
96
97 =item password
98
99 Password for connecting to database
100
101 =item invalidate
102
103 Optional anonymous code reference which will be executed when data is updated in
104 database. It can be used as hook to delete cache (for example on-disk-cache)
105 which is created from data edited through C<Fuse::DBI>.
106
107 =item fork
108
109 Optional flag which forks after mount so that executing script will continue
110 running. Implementation is experimental.
111
112 =back
113
114 62 dpavlin There is also alternative way which can generate C<read> and C<update>
115 queries on the fly:
116
117 my $mnt = Fuse::DBI->mount({
118 'filenames' => 'select id,filename,size,writable from files',
119 'read' => sub {
120 my ($path,$file) = @_;
121 return( 'select content from files where id = ?', $file->{row}->{id} );
122 },
123 'update' => sub {
124 my ($path,$file) = @_;
125 return( 'update files set content = ? where id = ?', $file->{row}->{id} );
126 },
127 'dsn' => 'DBI:Pg:dbname=test_db',
128 'user' => 'database_user',
129 'password' => 'database_password',
130 'invalidate' => sub { ... },
131 });
132
133 9 dpavlin =cut
134
135 my $dbh;
136 my $sth;
137 my $ctime_start;
138
139 11 dpavlin sub read_filenames;
140 21 dpavlin sub fuse_module_loaded;
141 9 dpavlin
142 24 dpavlin # evil, evil way to solve this. It makes this module non-reentrant. But, since
143 # fuse calls another copy of this script for each mount anyway, this shouldn't
144 # be a problem.
145 my $fuse_self;
146
147 64 dpavlin my $debug = 0;
148
149 11 dpavlin sub mount {
150 my $class = shift;
151 my $self = {};
152 bless($self, $class);
153 9 dpavlin
154 11 dpavlin my $arg = shift;
155 9 dpavlin
156 11 dpavlin print Dumper($arg);
157
158 51 dpavlin unless ($self->fuse_module_loaded) {
159 print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
160 system "sudo modprobe fuse" || die "can't modprobe fuse using sudo!\n";
161 }
162
163 11 dpavlin carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
164 carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
165
166 12 dpavlin # save (some) arguments in self
167 24 dpavlin foreach (qw(mount invalidate)) {
168 $self->{$_} = $arg->{$_};
169 }
170 12 dpavlin
171 9 dpavlin foreach (qw(filenames read update)) {
172 11 dpavlin carp "mount needs '$_' SQL" unless ($arg->{$_});
173 9 dpavlin }
174
175 21 dpavlin $ctime_start = time();
176 9 dpavlin
177 22 dpavlin my $pid;
178 21 dpavlin if ($arg->{'fork'}) {
179 22 dpavlin $pid = fork();
180 21 dpavlin die "fork() failed: $!" unless defined $pid;
181 # child will return to caller
182 if ($pid) {
183 47 dpavlin my $counter = 4;
184 while ($counter && ! $self->is_mounted) {
185 select(undef, undef, undef, 0.5);
186 $counter--;
187 }
188 if ($self->is_mounted) {
189 return $self;
190 } else {
191 return undef;
192 }
193 21 dpavlin }
194 }
195 9 dpavlin
196 21 dpavlin $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
197
198 26 dpavlin $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
199 9 dpavlin
200 26 dpavlin $self->{'sth'} = $sth;
201 64 dpavlin $self->{'dbh'} = $dbh;
202 26 dpavlin
203 $self->{'read_filenames'} = sub { $self->read_filenames };
204 21 dpavlin $self->read_filenames;
205 9 dpavlin
206 62 dpavlin foreach my $op (qw/read update/) {
207 if (ref($arg->{ $op }) ne 'CODE') {
208 $self->{ $op . '_ref' } = sub {
209 my $row = shift;
210 return ($arg->{ $op }, $row->{'id'});
211 }
212 } else {
213 $self->{ $op . '_ref' } = $arg->{ $op };
214 }
215 }
216
217 64 dpavlin $fuse_self = $self;
218 26 dpavlin
219 22 dpavlin Fuse::main(
220 21 dpavlin mountpoint=>$arg->{'mount'},
221 getattr=>\&e_getattr,
222 getdir=>\&e_getdir,
223 open=>\&e_open,
224 statfs=>\&e_statfs,
225 read=>\&e_read,
226 write=>\&e_write,
227 utime=>\&e_utime,
228 truncate=>\&e_truncate,
229 unlink=>\&e_unlink,
230 26 dpavlin rmdir=>\&e_unlink,
231 64 dpavlin debug=>$debug,
232 21 dpavlin );
233 26 dpavlin
234 22 dpavlin exit(0) if ($arg->{'fork'});
235
236 return 1;
237
238 9 dpavlin };
239
240 47 dpavlin =head2 is_mounted
241
242 Check if fuse filesystem is mounted
243
244 if ($mnt->is_mounted) { ... }
245
246 =cut
247
248 sub is_mounted {
249 my $self = shift;
250
251 my $mounted = 0;
252 my $mount = $self->{'mount'} || confess "can't find mount point!";
253 if (open(MTAB, "/etc/mtab")) {
254 while(<MTAB>) {
255 $mounted = 1 if (/ $mount fuse /i);
256 }
257 close(MTAB);
258 } else {
259 warn "can't open /etc/mtab: $!";
260 }
261
262 return $mounted;
263 }
264
265
266 11 dpavlin =head2 umount
267
268 Unmount your database as filesystem.
269
270 $mnt->umount;
271
272 This will also kill background process which is translating
273 database to filesystem.
274
275 =cut
276
277 sub umount {
278 my $self = shift;
279
280 47 dpavlin if ($self->{'mount'} && $self->is_mounted) {
281 53 dpavlin system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
282 64 dpavlin sleep 1;
283 53 dpavlin if ($self->is_mounted) {
284 51 dpavlin system "sudo umount ".$self->{'mount'} ||
285 return 0;
286 53 dpavlin }
287 47 dpavlin return 1;
288 }
289 40 dpavlin
290 47 dpavlin return 0;
291 21 dpavlin }
292
293 26 dpavlin $SIG{'INT'} = sub {
294 64 dpavlin if ($fuse_self && $fuse_self->can('umount')) {
295 40 dpavlin print STDERR "umount called by SIG INT\n";
296 }
297 26 dpavlin };
298 24 dpavlin
299 40 dpavlin $SIG{'QUIT'} = sub {
300 64 dpavlin if ($fuse_self && $fuse_self->can('umount')) {
301 40 dpavlin print STDERR "umount called by SIG QUIT\n";
302 }
303 };
304
305 24 dpavlin sub DESTROY {
306 my $self = shift;
307 40 dpavlin if ($self->umount) {
308 print STDERR "umount called by DESTROY\n";
309 }
310 24 dpavlin }
311
312 21 dpavlin =head2 fuse_module_loaded
313
314 Checks if C<fuse> module is loaded in kernel.
315
316 die "no fuse module loaded in kernel"
317 unless (Fuse::DBI::fuse_module_loaded);
318
319 28 dpavlin This function in called by C<mount>, but might be useful alone also.
320 21 dpavlin
321 =cut
322
323 sub fuse_module_loaded {
324 my $lsmod = `lsmod`;
325 die "can't start lsmod: $!" unless ($lsmod);
326 if ($lsmod =~ m/fuse/s) {
327 return 1;
328 12 dpavlin } else {
329 21 dpavlin return 0;
330 12 dpavlin }
331 11 dpavlin }
332
333 61 dpavlin my $files;
334 1 dpavlin
335 9 dpavlin sub read_filenames {
336 11 dpavlin my $self = shift;
337
338 26 dpavlin my $sth = $self->{'sth'} || die "no sth argument";
339
340 9 dpavlin # create empty filesystem
341 61 dpavlin $files = {
342 9 dpavlin '.' => {
343 type => 0040,
344 mode => 0755,
345 },
346 40 dpavlin '..' => {
347 type => 0040,
348 mode => 0755,
349 },
350 9 dpavlin # a => {
351 # cont => "File 'a'.\n",
352 # type => 0100,
353 # ctime => time()-2000
354 # },
355 61 dpavlin };
356 1 dpavlin
357 9 dpavlin # fetch new filename list from database
358 $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
359
360 # read them in with sesible defaults
361 while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
362 55 dpavlin $row->{'filename'} ||= 'NULL-'.$row->{'id'};
363 61 dpavlin $files->{$row->{'filename'}} = {
364 9 dpavlin size => $row->{'size'},
365 mode => $row->{'writable'} ? 0644 : 0444,
366 62 dpavlin id => $row->{'id'} || undef,
367 row => $row,
368 9 dpavlin };
369
370 55 dpavlin
371 9 dpavlin my $d;
372 foreach (split(m!/!, $row->{'filename'})) {
373 # first, entry is assumed to be file
374 if ($d) {
375 61 dpavlin $files->{$d} = {
376 9 dpavlin mode => 0755,
377 type => 0040
378 };
379 61 dpavlin $files->{$d.'/.'} = {
380 9 dpavlin mode => 0755,
381 type => 0040
382 };
383 61 dpavlin $files->{$d.'/..'} = {
384 9 dpavlin mode => 0755,
385 type => 0040
386 };
387 }
388 $d .= "/" if ($d);
389 $d .= "$_";
390 1 dpavlin }
391 }
392 9 dpavlin
393 61 dpavlin print "found ",scalar(keys %{$files})," files\n";
394 1 dpavlin }
395
396
397 sub filename_fixup {
398 my ($file) = shift;
399 $file =~ s,^/,,;
400 $file = '.' unless length($file);
401 return $file;
402 }
403
404 sub e_getattr {
405 my ($file) = filename_fixup(shift);
406 $file =~ s,^/,,;
407 $file = '.' unless length($file);
408 61 dpavlin return -ENOENT() unless exists($files->{$file});
409 my ($size) = $files->{$file}->{size} || 0;
410 52 dpavlin my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
411 1 dpavlin my ($atime, $ctime, $mtime);
412 61 dpavlin $atime = $ctime = $mtime = $files->{$file}->{ctime} || $ctime_start;
413 1 dpavlin
414 61 dpavlin my ($modes) = (($files->{$file}->{type} || 0100)<<9) + $files->{$file}->{mode};
415 1 dpavlin
416 # 2 possible types of return values:
417 #return -ENOENT(); # or any other error you care to
418 53 dpavlin #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
419 1 dpavlin return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
420 }
421
422 sub e_getdir {
423 my ($dirname) = shift;
424 $dirname =~ s!^/!!;
425 # return as many text filenames as you like, followed by the retval.
426 61 dpavlin print((scalar keys %{$files})." files total\n");
427 1 dpavlin my %out;
428 61 dpavlin foreach my $f (sort keys %{$files}) {
429 1 dpavlin if ($dirname) {
430 32 dpavlin if ($f =~ s/^\Q$dirname\E\///) {
431 13 dpavlin $out{$f}++ if ($f =~ /^[^\/]+$/);
432 }
433 1 dpavlin } else {
434 $out{$f}++ if ($f =~ /^[^\/]+$/);
435 }
436 }
437 if (! %out) {
438 $out{'no files? bug?'}++;
439 }
440 8 dpavlin print scalar keys %out," files in dir '$dirname'\n";
441 13 dpavlin print "## ",join(" ",keys %out),"\n";
442 1 dpavlin return (keys %out),0;
443 }
444
445 21 dpavlin sub read_content {
446 62 dpavlin my $file = shift || die "need file";
447 21 dpavlin
448 65 dpavlin warn "# read_content($file)\n" if ($debug);
449 21 dpavlin
450 64 dpavlin my @args = $fuse_self->{'read_ref'}->($files->{$file});
451 62 dpavlin my $sql = shift @args || die "need SQL for $file";
452
453 64 dpavlin $fuse_self->{'read_sth'}->{$sql} ||= $fuse_self->{dbh}->prepare($sql) || die $dbh->errstr();
454 my $sth = $fuse_self->{'read_sth'}->{$sql} || die;
455 62 dpavlin
456 $sth->execute(@args) || die $sth->errstr;
457 $files->{$file}->{cont} = $sth->fetchrow_array;
458 31 dpavlin # I should modify ctime only if content in database changed
459 61 dpavlin #$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
460 print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
461 21 dpavlin }
462
463
464 1 dpavlin sub e_open {
465 # VFS sanity check; it keeps all the necessary state, not much to do here.
466 6 dpavlin my $file = filename_fixup(shift);
467 my $flags = shift;
468
469 61 dpavlin return -ENOENT() unless exists($files->{$file});
470 return -EISDIR() unless exists($files->{$file}->{id});
471 6 dpavlin
472 61 dpavlin read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});
473 21 dpavlin
474 61 dpavlin $files->{$file}->{cont} ||= '';
475 print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
476 1 dpavlin return 0;
477 }
478
479 sub e_read {
480 3 dpavlin # return an error numeric, or binary/text string.
481 # (note: 0 means EOF, "0" will give a byte (ascii "0")
482 # to the reading program)
483 1 dpavlin my ($file) = filename_fixup(shift);
484 8 dpavlin my ($buf_len,$off) = @_;
485 3 dpavlin
486 61 dpavlin return -ENOENT() unless exists($files->{$file});
487 3 dpavlin
488 61 dpavlin my $len = length($files->{$file}->{cont});
489 3 dpavlin
490 8 dpavlin print "read '$file' [$len bytes] offset $off length $buf_len\n";
491 3 dpavlin
492 return -EINVAL() if ($off > $len);
493 return 0 if ($off == $len);
494
495 21 dpavlin $buf_len = $len-$off if ($len - $off < $buf_len);
496 3 dpavlin
497 61 dpavlin return substr($files->{$file}->{cont},$off,$buf_len);
498 1 dpavlin }
499
500 6 dpavlin sub clear_cont {
501 7 dpavlin print "transaction rollback\n";
502 $dbh->rollback || die $dbh->errstr;
503 6 dpavlin print "invalidate all cached content\n";
504 61 dpavlin foreach my $f (keys %{$files}) {
505 delete $files->{$f}->{cont};
506 delete $files->{$f}->{ctime};
507 6 dpavlin }
508 7 dpavlin print "begin new transaction\n";
509 21 dpavlin #$dbh->begin_work || die $dbh->errstr;
510 6 dpavlin }
511
512
513 sub update_db {
514 62 dpavlin my $file = shift || die "need file";
515 6 dpavlin
516 61 dpavlin $files->{$file}->{ctime} = time();
517 8 dpavlin
518 21 dpavlin my ($cont,$id) = (
519 61 dpavlin $files->{$file}->{cont},
520 $files->{$file}->{id}
521 21 dpavlin );
522
523 64 dpavlin my @args = $fuse_self->{'update_ref'}->($files->{$file});
524
525 62 dpavlin my $sql = shift @args || die "need SQL for $file";
526
527 64 dpavlin unshift @args, $files->{$file}->{cont} if ($#args == 0);
528
529 warn "## SQL: $sql\n# files->{$file} = ", Dumper($files->{$file}), $/ if ($debug);
530
531 my $sth = $fuse_self->{'update_sth'}->{$sql}
532 ||= $fuse_self->{dbh}->prepare($sql)
533 62 dpavlin || die $dbh->errstr();
534
535 if (!$sth->execute(@args)) {
536 print "update problem: ",$sth->errstr;
537 6 dpavlin clear_cont;
538 return 0;
539 } else {
540 7 dpavlin if (! $dbh->commit) {
541 62 dpavlin print "ERROR: commit problem: ",$sth->errstr;
542 6 dpavlin clear_cont;
543 return 0;
544 }
545 61 dpavlin print "updated '$file' [",$files->{$file}->{id},"]\n";
546 24 dpavlin
547 64 dpavlin $fuse_self->{'invalidate'}->() if ($fuse_self->can('invalidate'));
548 6 dpavlin }
549 return 1;
550</