git.rot13.org Git - Fuse-DBI/blob - 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.09_1';
  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 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 =cut
 134
 135 my $dbh;
 136 my $sth;
 137 my $ctime_start;
 138
 139 sub read_filenames;
 140 sub fuse_module_loaded;
 141
 142 # 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 my $debug = 0;
 148
 149 sub mount {
 150         my $class = shift;
 151         my $self = {};
 152         bless($self, $class);
 153
 154         my $arg = shift;
 155
 156         print Dumper($arg);
 157
 158         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         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         # save (some) arguments in self
 167         foreach (qw(mount invalidate)) {
 168                 $self->{$_} = $arg->{$_};
 169         }
 170
 171         foreach (qw(filenames read update)) {
 172                 carp "mount needs '$_' SQL" unless ($arg->{$_});
 173         }
 174
 175         $ctime_start = time();
 176
 177         my $pid;
 178         if ($arg->{'fork'}) {
 179                 $pid = fork();
 180                 die "fork() failed: $!" unless defined $pid;
 181                 # child will return to caller
 182                 if ($pid) {
 183                         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                 }
 194         }
 195
 196         $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
 197
 198         $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
 199
 200         $self->{'sth'} = $sth;
 201         $self->{'dbh'} = $dbh;
 202
 203         $self->{'read_filenames'} = sub { $self->read_filenames };
 204         $self->read_filenames;
 205
 206         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         $fuse_self = $self;
 218
 219         Fuse::main(
 220                 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                 rmdir=>\&e_unlink,
 231                 debug=>$debug,
 232         );
 233
 234         exit(0) if ($arg->{'fork'});
 235
 236         return 1;
 237
 238 };
 239
 240 =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 =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         if ($self->{'mount'} && $self->is_mounted) {
 281                 system "( fusermount -u ".$self->{'mount'}." 2>&1 ) >/dev/null";
 282                 sleep 1;
 283                 if ($self->is_mounted) {
 284                         system "sudo umount ".$self->{'mount'} ||
 285                         return 0;
 286                 }
 287                 return 1;
 288         }
 289
 290         return 0;
 291 }
 292
 293 $SIG{'INT'} = sub {
 294         if ($fuse_self && $fuse_self->can('umount')) {
 295                 print STDERR "umount called by SIG INT\n";
 296         }
 297 };
 298
 299 $SIG{'QUIT'} = sub {
 300         if ($fuse_self && $fuse_self->can('umount')) {
 301                 print STDERR "umount called by SIG QUIT\n";
 302         }
 303 };
 304
 305 sub DESTROY {
 306         my $self = shift;
 307         if ($self->umount) {
 308                 print STDERR "umount called by DESTROY\n";
 309         }
 310 }
 311
 312 =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 This function in called by C<mount>, but might be useful alone also.
 320
 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         } else {
 329                 return 0;
 330         }
 331 }
 332
 333 my $files;
 334
 335 sub read_filenames {
 336         my $self = shift;
 337
 338         my $sth = $self->{'sth'} || die "no sth argument";
 339
 340         # create empty filesystem
 341         $files = {
 342                 '.' => {
 343                         type => 0040,
 344                         mode => 0755,
 345                 },
 346                 '..' => {
 347                         type => 0040,
 348                         mode => 0755,
 349                 },
 350         #       a => {
 351         #               cont => "File 'a'.\n",
 352         #               type => 0100,
 353         #               ctime => time()-2000
 354         #       },
 355         };
 356
 357         # 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                 $row->{'filename'} ||= 'NULL-'.$row->{'id'};
 363                 $files->{$row->{'filename'}} = {
 364                         size => $row->{'size'},
 365                         mode => $row->{'writable'} ? 0644 : 0444,
 366                         id => $row->{'id'} || undef,
 367                         row => $row,
 368                 };
 369
 370
 371                 my $d;
 372                 foreach (split(m!/!, $row->{'filename'})) {
 373                         # first, entry is assumed to be file
 374                         if ($d) {
 375                                 $files->{$d} = {
 376                                                 mode => 0755,
 377                                                 type => 0040
 378                                 };
 379                                 $files->{$d.'/.'} = {
 380                                                 mode => 0755,
 381                                                 type => 0040
 382                                 };
 383                                 $files->{$d.'/..'} = {
 384                                                 mode => 0755,
 385                                                 type => 0040
 386                                 };
 387                         }
 388                         $d .= "/" if ($d);
 389                         $d .= "$_";
 390                 }
 391         }
 392
 393         print "found ",scalar(keys %{$files})," files\n";
 394 }
 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         return -ENOENT() unless exists($files->{$file});
 409         my ($size) = $files->{$file}->{size} || 0;
 410         my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,int(($size+BLOCK-1)/BLOCK),0,0,1,BLOCK);
 411         my ($atime, $ctime, $mtime);
 412         $atime = $ctime = $mtime = $files->{$file}->{ctime} || $ctime_start;
 413
 414         my ($modes) = (($files->{$file}->{type} || 0100)<<9) + $files->{$file}->{mode};
 415
 416         # 2 possible types of return values:
 417         #return -ENOENT(); # or any other error you care to
 418         #print "getattr($file) ",join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n";
 419         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         print((scalar keys %{$files})." files total\n");
 427         my %out;
 428         foreach my $f (sort keys %{$files}) {
 429                 if ($dirname) {
 430                         if ($f =~ s/^\Q$dirname\E\///) {
 431                                 $out{$f}++ if ($f =~ /^[^\/]+$/);
 432                         }
 433                 } else {
 434                         $out{$f}++ if ($f =~ /^[^\/]+$/);
 435                 }
 436         }
 437         if (! %out) {
 438                 $out{'no files? bug?'}++;
 439         }
 440         print scalar keys %out," files in dir '$dirname'\n";
 441         print "## ",join(" ",keys %out),"\n";
 442         return (keys %out),0;
 443 }
 444
 445 sub read_content {
 446         my $file = shift || die "need file";
 447
 448         warn "# read_content($file)\n" if ($debug);
 449
 450         my @args = $fuse_self->{'read_ref'}->($files->{$file});
 451         my $sql = shift @args || die "need SQL for $file";
 452
 453         $fuse_self->{'read_sth'}->{$sql} ||= $fuse_self->{dbh}->prepare($sql) || die $dbh->errstr();
 454         my $sth = $fuse_self->{'read_sth'}->{$sql} || die;
 455
 456         $sth->execute(@args) || die $sth->errstr;
 457         $files->{$file}->{cont} = $sth->fetchrow_array;
 458         # I should modify ctime only if content in database changed
 459         #$files->{$file}->{ctime} = time() unless ($files->{$file}->{ctime});
 460         print "file '$file' content [",length($files->{$file}->{cont})," bytes] read in cache\n";
 461 }
 462
 463
 464 sub e_open {
 465         # VFS sanity check; it keeps all the necessary state, not much to do here.
 466         my $file = filename_fixup(shift);
 467         my $flags = shift;
 468
 469         return -ENOENT() unless exists($files->{$file});
 470         return -EISDIR() unless exists($files->{$file}->{id});
 471
 472         read_content($file,$files->{$file}->{id}) unless exists($files->{$file}->{cont});
 473
 474         $files->{$file}->{cont} ||= '';
 475         print "open '$file' ",length($files->{$file}->{cont})," bytes\n";
 476         return 0;
 477 }
 478
 479 sub e_read {
 480         # 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         my ($file) = filename_fixup(shift);
 484         my ($buf_len,$off) = @_;
 485
 486         return -ENOENT() unless exists($files->{$file});
 487
 488         my $len = length($files->{$file}->{cont});
 489
 490         print "read '$file' [$len bytes] offset $off length $buf_len\n";
 491
 492         return -EINVAL() if ($off > $len);
 493         return 0 if ($off == $len);
 494
 495         $buf_len = $len-$off if ($len - $off < $buf_len);
 496
 497         return substr($files->{$file}->{cont},$off,$buf_len);
 498 }
 499
 500 sub clear_cont {
 501         print "transaction rollback\n";
 502         $dbh->rollback || die $dbh->errstr;
 503         print "invalidate all cached content\n";
 504         foreach my $f (keys %{$files}) {
 505                 delete $files->{$f}->{cont};
 506                 delete $files->{$f}->{ctime};
 507         }
 508         print "begin new transaction\n";
 509         #$dbh->begin_work || die $dbh->errstr;
 510 }
 511
 512
 513 sub update_db {
 514         my $file = shift || die "need file";
 515
 516         $files->{$file}->{ctime} = time();
 517
 518         my ($cont,$id) = (
 519                 $files->{$file}->{cont},
 520                 $files->{$file}->{id}
 521         );
 522
 523         my @args = $fuse_self->{'update_ref'}->($files->{$file});
 524
 525         my $sql = shift @args || die "need SQL for $file";
 526
 527         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                 || die $dbh->errstr();
 534
 535         if (!$sth->execute(@args)) {
 536                 print "update problem: ",$sth->errstr;
 537                 clear_cont;
 538                 return 0;
 539         } else {
 540                 if (! $dbh->commit) {
 541                         print "ERROR: commit problem: ",$sth->errstr;
 542                         clear_cont;
 543                         return 0;
 544                 }
 545                 print "updated '$file' [",$files->{$file}->{id},"]\n";
 546
 547                 $fuse_self->{'invalidate'}->() if ($fuse_self->can('invalidate'));
 548         }
 549         return 1;
 550 }
 551
 552 sub e_write {
 553         my $file = filename_fixup(shift);
 554         my ($buffer,$off) = @_;
 555
 556         return -ENOENT() unless exists($files->{$file});
 557
 558         my $cont = $files->{$file}->{cont};
 559         my $len = length($cont);
 560
 561         print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
 562
 563         $files->{$file}->{cont} = "";
 564
 565         $files->{$file}->{cont} .= substr($cont,0,$off) if ($off > 0);
 566         $files->{$file}->{cont} .= $buffer;
 567         $files->{$file}->{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
 568
 569         $files->{$file}->{size} = length($files->{$file}->{cont});
 570
 571         if (! update_db($file)) {
 572                 return -ENOSYS();
 573         } else {
 574                 return length($buffer);
 575         }
 576 }
 577
 578 sub e_truncate {
 579         my $file = filename_fixup(shift);
 580         my $size = shift;
 581
 582         print "truncate to $size\n";
 583
 584         $files->{$file}->{cont} = substr($files->{$file}->{cont},0,$size);
 585         $files->{$file}->{size} = $size;
 586         return 0
 587 };
 588
 589
 590 sub e_utime {
 591         my ($atime,$mtime,$file) = @_;
 592         $file = filename_fixup($file);
 593
 594         return -ENOENT() unless exists($files->{$file});
 595
 596         print "utime '$file' $atime $mtime\n";
 597
 598         $files->{$file}->{time} = $mtime;
 599         return 0;
 600 }
 601
 602 sub e_statfs {
 603
 604         my $size = 0;
 605         my $inodes = 0;
 606
 607         foreach my $f (keys %{$files}) {
 608                 if ($f !~ /(^|\/)\.\.?$/) {
 609                         $size += $files->{$f}->{size} || 0;
 610                         $inodes++;
 611                 }
 612                 print "$inodes: $f [$size]\n";
 613         }
 614
 615         $size = int(($size+BLOCK-1)/BLOCK);
 616
 617         my @ret = (255, $inodes, 1, $size, $size-1, BLOCK);
 618
 619         #print "statfs: ",join(",",@ret),"\n";
 620
 621         return @ret;
 622 }
 623
 624 sub e_unlink {
 625         my $file = filename_fixup(shift);
 626
 627 #       if (exists( $dirs{$file} )) {
 628 #               print "unlink '$file' will re-read template names\n";
 629 #               print Dumper($fuse_self);
 630 #               $fuse_self->{'read_filenames'}->();
 631 #               return 0;
 632         if (exists( $files->{$file} )) {
 633                 print "unlink '$file' will invalidate cache\n";
 634                 read_content($file,$files->{$file}->{id});
 635                 return 0;
 636         }
 637
 638         return -ENOENT();
 639 }
 640 1;
 641 __END__
 642
 643 =head1 EXPORT
 644
 645 Nothing.
 646
 647 =head1 BUGS
 648
 649 Size information (C<ls -s>) is wrong. It's a problem in upstream Fuse module
 650 (for which I'm to blame lately), so when it gets fixes, C<Fuse::DBI> will
 651 automagically pick it up.
 652
 653 =head1 SEE ALSO
 654
 655 C<FUSE (Filesystem in USErspace)> website
 656 L<http://fuse.sourceforge.net/>
 657
 658 Example for WebGUI which comes with this distribution in
 659 directory C<examples/webgui.pl>. It also contains a lot of documentation
 660 about design of this module, usage and limitations.
 661
 662 =head1 AUTHOR
 663
 664 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
 665
 666 =head1 COPYRIGHT AND LICENSE
 667
 668 Copyright (C) 2004 by Dobrica Pavlinusic
 669
 670 This library is free software; you can redistribute it and/or modify
 671 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 672 at your option, any later version of Perl 5 you may have available.
 673
 674
 675 =cut
 676