0.08: support for filenames which are null (it will ne named NULL-id)
[Fuse-DBI] / DBI.pm
1 #!/usr/bin/perl
2
3 package Fuse::DBI;
4
5 use 5.008;
6 use strict;
7 use warnings;
8
9 use POSIX qw(ENOENT EISDIR EINVAL ENOSYS O_RDWR);
10 use Fuse;
11 use DBI;
12 use Carp;
13 use Data::Dumper;
14
15 our $VERSION = '0.08';
16
17 # block size for this filesystem
18 use constant BLOCK => 1024;
19
20 =head1 NAME
21
22 Fuse::DBI - mount your database as filesystem and use it
23
24 =head1 SYNOPSIS
25
26   use Fuse::DBI;
27   Fuse::DBI->mount( ... );
28
29 See C<run> below for examples how to set parameters.
30
31 =head1 DESCRIPTION
32
33 This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
34 available at L<http://fuse.sourceforge.net/> to mount
35 your database as file system.
36
37 That will give you possibility to use normal file-system tools (cat, grep, vi)
38 to manipulate data in database.
39
40 It's actually opposite of Oracle's intention to put everything into database.
41
42
43 =head1 METHODS
44
45 =cut
46
47 =head2 mount
48
49 Mount your database as filesystem.
50
51 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   my $mnt = Fuse::DBI->mount({
62         '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   });
70
71 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 =cut
115
116 my $dbh;
117 my $sth;
118 my $ctime_start;
119
120 sub read_filenames;
121 sub fuse_module_loaded;
122
123 # evil, evil way to solve this. It makes this module non-reentrant. But, since
124 # fuse calls another copy of this script for each mount anyway, this shouldn't
125 # be a problem.
126 my $fuse_self;
127
128 sub mount {
129         my $class = shift;
130         my $self = {};
131         bless($self, $class);
132
133         my $arg = shift;
134
135         print Dumper($arg);
136
137         unless ($self->fuse_module_loaded) {
138                 print STDERR "no fuse module loaded. Trying sudo modprobe fuse!\n";
139                 system "sudo modprobe fuse" || die "can't modprobe fuse using sudo!\n";
140         }
141
142         carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
143         carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
144
145         # save (some) arguments in self
146         foreach (qw(mount invalidate)) {
147                 $self->{$_} = $arg->{$_};
148         }
149
150         foreach (qw(filenames read update)) {
151                 carp "mount needs '$_' SQL" unless ($arg->{$_});
152         }
153
154         $ctime_start = time();
155
156         my $pid;
157         if ($arg->{'fork'}) {
158                 $pid = fork();
159                 die "fork() failed: $!" unless defined $pid;
160                 # child will return to caller
161                 if ($pid) {
162                         my $counter = 4;
163                         while ($counter && ! $self->is_mounted) {
164                                 select(undef, undef, undef, 0.5);
165                                 $counter--;
166                         }
167                         if ($self->is_mounted) {
168                                 return $self;
169                         } else {
170                                 return undef;
171                         }
172                 }
173         }
174
175         $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
176
177         $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
178
179         $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
180         $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
181
182
183         $self->{'sth'} = $sth;
184
185         $self->{'read_filenames'} = sub { $self->read_filenames };
186         $self->read_filenames;
187
188         $fuse_self = \$self;
189
190         Fuse::main(
191                 mountpoint=>$arg->{'mount'},
192                 getattr=>\&e_getattr,
193                 getdir=>\&e_getdir,
194                 open=>\&e_open,
195                 statfs=>\&e_statfs,
196                 read=>\&e_read,
197                 write=>\&e_write,
198                 utime=>\&e_utime,
199                 truncate=>\&e_truncate,
200                 unlink=>\&e_unlink,
201                 rmdir=>\&e_unlink,
202                 debug=>0,
203         );
204         
205         exit(0) if ($arg->{'fork'});
206
207         return 1;
208
209 };
210
211 =head2 is_mounted
212
213 Check if fuse filesystem is mounted
214
215   if ($mnt->is_mounted) { ... }
216
217 =cut
218
219 sub is_mounted {
220         my $self = shift;
221
222         my $mounted = 0;
223         my $mount = $self->{'mount'} || confess "can't find mount point!";
224         if (open(MTAB, "/etc/mtab")) {
225                 while(<MTAB>) {
226                         $mounted = 1 if (/ $mount fuse /i);
227                 }
228                 close(MTAB);
229         } else {
230                 warn "can't open /etc/mtab: $!";
231         }
232
233         return $mounted;
234 }
235
236
237 =head2 umount
238
239 Unmount your database as filesystem.
240
241   $mnt->umount;
242
243 This will also kill background process which is translating
244 database to filesystem.
245
246 =cut
247
248 sub umount {
249         my $self = shift;
250
251         if ($self->{'mount'} && $self->is_mounted) {
252                 system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
253                 if ($self->is_mounted) {
254                         system "sudo umount ".$self->{'mount'} ||
255                         return 0;
256                 }
257                 return 1;
258         }
259
260         return 0;
261 }
262
263 $SIG{'INT'} = sub {
264         if ($fuse_self && $$fuse_self->umount) {
265                 print STDERR "umount called by SIG INT\n";
266         }
267 };
268
269 $SIG{'QUIT'} = sub {
270         if ($fuse_self && $$fuse_self->umount) {
271                 print STDERR "umount called by SIG QUIT\n";
272         }
273 };
274
275 sub DESTROY {
276         my $self = shift;
277         if ($self->umount) {
278                 print STDERR "umount called by DESTROY\n";
279         }
280 }
281
282 =head2 fuse_module_loaded
283
284 Checks if C<fuse> module is loaded in kernel.
285
286   die "no fuse module loaded in kernel"
287         unless (Fuse::DBI::fuse_module_loaded);
288
289 This function in called by C<mount>, but might be useful alone also.
290
291 =cut
292
293 sub fuse_module_loaded {
294         my $lsmod = `lsmod`;
295         die "can't start lsmod: $!" unless ($lsmod);
296         if ($lsmod =~ m/fuse/s) {
297                 return 1;
298         } else {
299                 return 0;
300         }
301 }
302
303 my %files;
304
305 sub read_filenames {
306         my $self = shift;
307
308         my $sth = $self->{'sth'} || die "no sth argument";
309
310         # create empty filesystem
311         (%files) = (
312                 '.' => {
313                         type => 0040,
314                         mode => 0755,
315                 },
316                 '..' => {
317                         type => 0040,
318                         mode => 0755,
319                 },
320         #       a => {
321         #               cont => "File 'a'.\n",
322         #               type => 0100,
323         #               ctime => time()-2000
324         #       },
325         );
326
327         # fetch new filename list from database
328         $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
329
330         # read them in with sesible defaults
331         while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
332                 $row->{'filename'} ||= 'NULL-'.$row->{'id'};
333                 $files{$row->{'filename'}} = {
334                         size => $row->{'size'},
335                         mode => $row->{'writable'} ? 0644 : 0444,
336                         id => $row->{'id'} || 99,
337                 };
338
339
340                 my $d;
341                 foreach (split(m!/!, $row->{'filename'})) {
342                         # first, entry is assumed to be file
343                         if ($d) {
344                                 $files{$d} = {
345                                                 mode => 0755,
346                                                 type => 0040
347                                 };
348                                 $files{$d.'/.'} = {
349                                                 mode => 0755,
350                                                 type => 0040
351                                 };
352                                 $files{$d.'/..'} = {
353                                                 mode => 0755,
354                                                 type => 0040
355                                 };
356                         }
357                         $d .= "/" if ($d);
358                         $d .= "$_";
359                 }
360         }
361
362         print "found ",scalar(keys %files)," files\n";
363 }
364
365
366 sub filename_fixup {
367         my ($file) = shift;
368         $file =~ s,^/,,;
369         $file = '.' unless length($file);
370         return $file;
371 }
372
373 sub e_getattr {
374         my ($file) = filename_fixup(shift);
375         $file =~ s,^/,,;
376         $file = '.' unless length($file);
377         return -ENOENT() unless exists($files{$file});
378         my ($size) = $files{$file}{size} || 0;
379         my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
380         my ($atime, $ctime, $mtime);
381         $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
382
383         my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
384
385         # 2 possible types of return values:
386         #return -ENOENT(); # or any other error you care to
387         #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
388         return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
389 }
390
391 sub e_getdir {
392         my ($dirname) = shift;
393         $dirname =~ s!^/!!;
394         # return as many text filenames as you like, followed by the retval.
395         print((scalar keys %files)." files total\n");
396         my %out;
397         foreach my $f (sort keys %files) {
398                 if ($dirname) {
399                         if ($f =~ s/^\Q$dirname\E\///) {
400                                 $out{$f}++ if ($f =~ /^[^\/]+$/);
401                         }
402                 } else {
403                         $out{$f}++ if ($f =~ /^[^\/]+$/);
404                 }
405         }
406         if (! %out) {
407                 $out{'no files? bug?'}++;
408         }
409         print scalar keys %out," files in dir '$dirname'\n";
410         print "## ",join(" ",keys %out),"\n";
411         return (keys %out),0;
412 }
413
414 sub read_content {
415         my ($file,$id) = @_;
416
417         die "read_content needs file and id" unless ($file && $id);
418
419         $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
420         $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
421         # I should modify ctime only if content in database changed
422         #$files{$file}{ctime} = time() unless ($files{$file}{ctime});
423         print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
424 }
425
426
427 sub e_open {
428         # VFS sanity check; it keeps all the necessary state, not much to do here.
429         my $file = filename_fixup(shift);
430         my $flags = shift;
431
432         return -ENOENT() unless exists($files{$file});
433         return -EISDIR() unless exists($files{$file}{id});
434
435         read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
436
437         $files{$file}{cont} ||= '';
438         print "open '$file' ",length($files{$file}{cont})," bytes\n";
439         return 0;
440 }
441
442 sub e_read {
443         # return an error numeric, or binary/text string.
444         # (note: 0 means EOF, "0" will give a byte (ascii "0")
445         # to the reading program)
446         my ($file) = filename_fixup(shift);
447         my ($buf_len,$off) = @_;
448
449         return -ENOENT() unless exists($files{$file});
450
451         my $len = length($files{$file}{cont});
452
453         print "read '$file' [$len bytes] offset $off length $buf_len\n";
454
455         return -EINVAL() if ($off > $len);
456         return 0 if ($off == $len);
457
458         $buf_len = $len-$off if ($len - $off < $buf_len);
459
460         return substr($files{$file}{cont},$off,$buf_len);
461 }
462
463 sub clear_cont {
464         print "transaction rollback\n";
465         $dbh->rollback || die $dbh->errstr;
466         print "invalidate all cached content\n";
467         foreach my $f (keys %files) {
468                 delete $files{$f}{cont};
469                 delete $files{$f}{ctime};
470         }
471         print "begin new transaction\n";
472         #$dbh->begin_work || die $dbh->errstr;
473 }
474
475
476 sub update_db {
477         my $file = shift || die;
478
479         $files{$file}{ctime} = time();
480
481         my ($cont,$id) = (
482                 $files{$file}{cont},
483                 $files{$file}{id}
484         );
485
486         if (!$sth->{'update'}->execute($cont,$id)) {
487                 print "update problem: ",$sth->{'update'}->errstr;
488                 clear_cont;
489                 return 0;
490         } else {
491                 if (! $dbh->commit) {
492                         print "ERROR: commit problem: ",$sth->{'update'}->errstr;
493                         clear_cont;
494                         return 0;
495                 }
496                 print "updated '$file' [",$files{$file}{id},"]\n";
497
498                 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
499         }
500         return 1;
501 }
502
503 sub e_write {
504         my $file = filename_fixup(shift);
505         my ($buffer,$off) = @_;
506
507         return -ENOENT() unless exists($files{$file});
508
509         my $cont = $files{$file}{cont};
510         my $len = length($cont);
511
512         print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
513
514         $files{$file}{cont} = "";
515
516         $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
517         $files{$file}{cont} .= $buffer;
518         $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
519
520         $files{$file}{size} = length($files{$file}{cont});
521
522         if (! update_db($file)) {
523                 return -ENOSYS();
524         } else {
525                 return length($buffer);
526         }
527 }
528
529 sub e_truncate {
530         my $file = filename_fixup(shift);
531         my $size = shift;
532
533         print "truncate to $size\n";
534
535         $files{$file}{cont} = substr($files{$file}{cont},0,$size);
536         $files{$file}{size} = $size;
537         return 0
538 };
539
540
541 sub e_utime {
542         my ($atime,$mtime,$file) = @_;
543         $file = filename_fixup($file);
544
545         return -ENOENT() unless exists($files{$file});
546
547         print "utime '$file' $atime $mtime\n";
548
549         $files{$file}{time} = $mtime;
550         return 0;
551 }
552
553 sub e_statfs {
554
555         my $size = 0;
556         my $inodes = 0;
557
558         foreach my $f (keys %files) {
559                 if ($f !~ /(^|\/)\.\.?$/) {
560                         $size += $files{$f}{size} || 0;
561                         $inodes++;
562                 }
563                 print "$inodes: $f [$size]\n";
564         }
565
566         $size = int(($size+BLOCK-1)/BLOCK);
567
568         my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
569
570         #print "statfs: ",join(",",@ret),"\n";
571
572         return @ret;
573 }
574
575 sub e_unlink {
576         my $file = filename_fixup(shift);
577
578 #       if (exists( $dirs{$file} )) {
579 #               print "unlink '$file' will re-read template names\n";
580 #               print Dumper($fuse_self);
581 #               $$fuse_self->{'read_filenames'}->();
582 #               return 0;
583         if (exists( $files{$file} )) {
584                 print "unlink '$file' will invalidate cache\n";
585                 read_content($file,$files{$file}{id});
586                 return 0;
587         }
588
589         return -ENOENT();
590 }
591 1;
592 __END__
593
594 =head1 EXPORT
595
596 Nothing.
597
598 =head1 BUGS
599
600 Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
601 (for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
602 automagically pick it up.
603
604 =head1 SEE ALSO
605
606 C<FUSE (Filesystem in USErspace)> website
607 L<http://fuse.sourceforge.net/>
608
609 Example for WebGUI which comes with this distribution in
610 directory C<examples/webgui.pl>. It also contains a lot of documentation
611 about design of this module, usage and limitations.
612
613 =head1 AUTHOR
614
615 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
616
617 =head1 COPYRIGHT AND LICENSE
618
619 Copyright (C) 2004 by Dobrica Pavlinusic
620
621 This library is free software; you can redistribute it and/or modify
622 it under the same terms as Perl itself, either Perl version 5.8.4 or,
623 at your option, any later version of Perl 5 you may have available.
624
625
626 =cut
627