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
  16 our $VERSION = '0.03';
  17
  18 =head1 NAME
  19
  20 Fuse::DBI - mount your database as filesystem and use it
  21
  22 =head1 SYNOPSIS
  23
  24   use Fuse::DBI;
  25   Fuse::DBI->mount( ... );
  26
  27 See C<run> below for examples how to set parametars.
  28
  29 =head1 DESCRIPTION
  30
  31 This module will use C<Fuse> module, part of C<FUSE (Filesystem in USErspace)>
  32 available at L<http://sourceforge.net/projects/avf> to mount
  33 your database as file system.
  34
  35 That will give you posibility to use normal file-system tools (cat, grep, vi)
  36 to manipulate data in database.
  37
  38 It's actually opposite of Oracle's intention to put everything into database.
  39
  40
  41 =head1 METHODS
  42
  43 =cut
  44
  45 =head2 mount
  46
  47 Mount your database as filesystem.
  48
  49   my $mnt = Fuse::DBI->mount({
  50         filenames => 'select name from files_table as filenames',
  51         read => 'sql read',
  52         update => 'sql update',
  53         dsn => 'DBI:Pg:dbname=webgui',
  54         user => 'database_user',
  55         password => 'database_password'
  56   });
  57
  58 =cut
  59
  60 my $dbh;
  61 my $sth;
  62 my $ctime_start;
  63
  64 sub read_filenames;
  65 sub fuse_module_loaded;
  66
  67 # evil, evil way to solve this. It makes this module non-reentrant. But, since
  68 # fuse calls another copy of this script for each mount anyway, this shouldn't
  69 # be a problem.
  70 my $fuse_self;
  71
  72 sub mount {
  73         my $class = shift;
  74         my $self = {};
  75         bless($self, $class);
  76
  77         my $arg = shift;
  78
  79         print Dumper($arg);
  80
  81         carp "mount needs 'dsn' to connect to (e.g. dsn => 'DBI:Pg:dbname=test')" unless ($arg->{'dsn'});
  82         carp "mount needs 'mount' as mountpoint" unless ($arg->{'mount'});
  83
  84         # save (some) arguments in self
  85         foreach (qw(mount invalidate)) {
  86                 $self->{$_} = $arg->{$_};
  87         }
  88
  89         foreach (qw(filenames read update)) {
  90                 carp "mount needs '$_' SQL" unless ($arg->{$_});
  91         }
  92
  93         $ctime_start = time();
  94
  95         my $pid;
  96         if ($arg->{'fork'}) {
  97                 $pid = fork();
  98                 die "fork() failed: $!" unless defined $pid;
  99                 # child will return to caller
 100                 if ($pid) {
 101                         return $self;
 102                 }
 103         }
 104
 105         $dbh = DBI->connect($arg->{'dsn'},$arg->{'user'},$arg->{'password'}, {AutoCommit => 0, RaiseError => 1}) || die $DBI::errstr;
 106
 107         $sth->{'filenames'} = $dbh->prepare($arg->{'filenames'}) || die $dbh->errstr();
 108
 109         $sth->{'read'} = $dbh->prepare($arg->{'read'}) || die $dbh->errstr();
 110         $sth->{'update'} = $dbh->prepare($arg->{'update'}) || die $dbh->errstr();
 111
 112
 113         $self->{'sth'} = $sth;
 114
 115         $self->{'read_filenames'} = sub { $self->read_filenames };
 116         $self->read_filenames;
 117
 118         $self->{'mounted'} = 1;
 119
 120         $fuse_self = \$self;
 121
 122         Fuse::main(
 123                 mountpoint=>$arg->{'mount'},
 124                 getattr=>\&e_getattr,
 125                 getdir=>\&e_getdir,
 126                 open=>\&e_open,
 127                 statfs=>\&e_statfs,
 128                 read=>\&e_read,
 129                 write=>\&e_write,
 130                 utime=>\&e_utime,
 131                 truncate=>\&e_truncate,
 132                 unlink=>\&e_unlink,
 133                 rmdir=>\&e_unlink,
 134                 debug=>0,
 135         );
 136
 137         $self->{'mounted'} = 0;
 138
 139         exit(0) if ($arg->{'fork'});
 140
 141         return 1;
 142
 143 };
 144
 145 =head2 umount
 146
 147 Unmount your database as filesystem.
 148
 149   $mnt->umount;
 150
 151 This will also kill background process which is translating
 152 database to filesystem.
 153
 154 =cut
 155
 156 sub umount {
 157         my $self = shift;
 158
 159         if ($self->{'mounted'}) {
 160                 system "fusermount -u ".$self->{'mount'} || croak "umount error: $!";
 161         }
 162
 163         return 1;
 164 }
 165
 166 $SIG{'INT'} = sub {
 167         print STDERR "umount called by SIG INT\n";
 168         umount;
 169 };
 170
 171 sub DESTROY {
 172         my $self = shift;
 173         return if (! $self->{'mounted'});
 174         print STDERR "umount called by DESTROY\n";
 175         $self->umount;
 176 }
 177
 178 =head2 fuse_module_loaded
 179
 180 Checks if C<fuse> module is loaded in kernel.
 181
 182   die "no fuse module loaded in kernel"
 183         unless (Fuse::DBI::fuse_module_loaded);
 184
 185 This function in called by L<mount>, but might be useful alone also.
 186
 187 =cut
 188
 189 sub fuse_module_loaded {
 190         my $lsmod = `lsmod`;
 191         die "can't start lsmod: $!" unless ($lsmod);
 192         if ($lsmod =~ m/fuse/s) {
 193                 return 1;
 194         } else {
 195                 return 0;
 196         }
 197 }
 198
 199 my %files;
 200 my %dirs;
 201
 202 sub read_filenames {
 203         my $self = shift;
 204
 205         my $sth = $self->{'sth'} || die "no sth argument";
 206
 207         # create empty filesystem
 208         (%files) = (
 209                 '.' => {
 210                         type => 0040,
 211                         mode => 0755,
 212                 },
 213         #       a => {
 214         #               cont => "File 'a'.\n",
 215         #               type => 0100,
 216         #               ctime => time()-2000
 217         #       },
 218         );
 219
 220         # fetch new filename list from database
 221         $sth->{'filenames'}->execute() || die $sth->{'filenames'}->errstr();
 222
 223         # read them in with sesible defaults
 224         while (my $row = $sth->{'filenames'}->fetchrow_hashref() ) {
 225                 $files{$row->{'filename'}} = {
 226                         size => $row->{'size'},
 227                         mode => $row->{'writable'} ? 0644 : 0444,
 228                         id => $row->{'id'} || 99,
 229                 };
 230
 231                 my $d;
 232                 foreach (split(m!/!, $row->{'filename'})) {
 233                         # first, entry is assumed to be file
 234                         if ($d) {
 235                                 $files{$d} = {
 236                                                 size => $dirs{$d}++,
 237                                                 mode => 0755,
 238                                                 type => 0040
 239                                 };
 240                                 $files{$d.'/.'} = {
 241                                                 mode => 0755,
 242                                                 type => 0040
 243                                 };
 244                                 $files{$d.'/..'} = {
 245                                                 mode => 0755,
 246                                                 type => 0040
 247                                 };
 248                         }
 249                         $d .= "/" if ($d);
 250                         $d .= "$_";
 251                 }
 252         }
 253
 254         print "found ",scalar(keys %files)-scalar(keys %dirs)," files, ",scalar(keys %dirs), " dirs\n";
 255 }
 256
 257
 258 sub filename_fixup {
 259         my ($file) = shift;
 260         $file =~ s,^/,,;
 261         $file = '.' unless length($file);
 262         return $file;
 263 }
 264
 265 sub e_getattr {
 266         my ($file) = filename_fixup(shift);
 267         $file =~ s,^/,,;
 268         $file = '.' unless length($file);
 269         return -ENOENT() unless exists($files{$file});
 270         my ($size) = $files{$file}{size} || 1;
 271         my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
 272         my ($atime, $ctime, $mtime);
 273         $atime = $ctime = $mtime = $files{$file}{ctime} || $ctime_start;
 274
 275         my ($modes) = (($files{$file}{type} || 0100)<<9) + $files{$file}{mode};
 276
 277         # 2 possible types of return values:
 278         #return -ENOENT(); # or any other error you care to
 279         #print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
 280         return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
 281 }
 282
 283 sub e_getdir {
 284         my ($dirname) = shift;
 285         $dirname =~ s!^/!!;
 286         # return as many text filenames as you like, followed by the retval.
 287         print((scalar keys %files)." files total\n");
 288         my %out;
 289         foreach my $f (sort keys %files) {
 290                 if ($dirname) {
 291                         if ($f =~ s/^\E$dirname\Q\///) {
 292                                 $out{$f}++ if ($f =~ /^[^\/]+$/);
 293                         }
 294                 } else {
 295                         $out{$f}++ if ($f =~ /^[^\/]+$/);
 296                 }
 297         }
 298         if (! %out) {
 299                 $out{'no files? bug?'}++;
 300         }
 301         print scalar keys %out," files in dir '$dirname'\n";
 302         print "## ",join(" ",keys %out),"\n";
 303         return (keys %out),0;
 304 }
 305
 306 sub read_content {
 307         my ($file,$id) = @_;
 308
 309         die "read_content needs file and id" unless ($file && $id);
 310
 311         $sth->{'read'}->execute($id) || die $sth->{'read'}->errstr;
 312         $files{$file}{cont} = $sth->{'read'}->fetchrow_array;
 313         $files{$file}{ctime} = time();
 314         print "file '$file' content [",length($files{$file}{cont})," bytes] read in cache\n";
 315 }
 316
 317
 318 sub e_open {
 319         # VFS sanity check; it keeps all the necessary state, not much to do here.
 320         my $file = filename_fixup(shift);
 321         my $flags = shift;
 322
 323         return -ENOENT() unless exists($files{$file});
 324         return -EISDIR() unless exists($files{$file}{id});
 325
 326         read_content($file,$files{$file}{id}) unless exists($files{$file}{cont});
 327
 328         print "open '$file' ",length($files{$file}{cont})," bytes\n";
 329         return 0;
 330 }
 331
 332 sub e_read {
 333         # return an error numeric, or binary/text string.
 334         # (note: 0 means EOF, "0" will give a byte (ascii "0")
 335         # to the reading program)
 336         my ($file) = filename_fixup(shift);
 337         my ($buf_len,$off) = @_;
 338
 339         return -ENOENT() unless exists($files{$file});
 340
 341         my $len = length($files{$file}{cont});
 342
 343         print "read '$file' [$len bytes] offset $off length $buf_len\n";
 344
 345         return -EINVAL() if ($off > $len);
 346         return 0 if ($off == $len);
 347
 348         $buf_len = $len-$off if ($len - $off < $buf_len);
 349
 350         return substr($files{$file}{cont},$off,$buf_len);
 351 }
 352
 353 sub clear_cont {
 354         print "transaction rollback\n";
 355         $dbh->rollback || die $dbh->errstr;
 356         print "invalidate all cached content\n";
 357         foreach my $f (keys %files) {
 358                 delete $files{$f}{cont};
 359         }
 360         print "begin new transaction\n";
 361         #$dbh->begin_work || die $dbh->errstr;
 362 }
 363
 364
 365 sub update_db {
 366         my $file = shift || die;
 367
 368         $files{$file}{ctime} = time();
 369
 370         my ($cont,$id) = (
 371                 $files{$file}{cont},
 372                 $files{$file}{id}
 373         );
 374
 375         if (!$sth->{'update'}->execute($cont,$id)) {
 376                 print "update problem: ",$sth->{'update'}->errstr;
 377                 clear_cont;
 378                 return 0;
 379         } else {
 380                 if (! $dbh->commit) {
 381                         print "ERROR: commit problem: ",$sth->{'update'}->errstr;
 382                         clear_cont;
 383                         return 0;
 384                 }
 385                 print "updated '$file' [",$files{$file}{id},"]\n";
 386
 387                 $$fuse_self->{'invalidate'}->() if (ref $$fuse_self->{'invalidate'});
 388         }
 389         return 1;
 390 }
 391
 392 sub e_write {
 393         my $file = filename_fixup(shift);
 394         my ($buffer,$off) = @_;
 395
 396         return -ENOENT() unless exists($files{$file});
 397
 398         my $cont = $files{$file}{cont};
 399         my $len = length($cont);
 400
 401         print "write '$file' [$len bytes] offset $off length ",length($buffer),"\n";
 402
 403         $files{$file}{cont} = "";
 404
 405         $files{$file}{cont} .= substr($cont,0,$off) if ($off > 0);
 406         $files{$file}{cont} .= $buffer;
 407         $files{$file}{cont} .= substr($cont,$off+length($buffer),$len-$off-length($buffer)) if ($off+length($buffer) < $len);
 408
 409         $files{$file}{size} = length($files{$file}{cont});
 410
 411         if (! update_db($file)) {
 412                 return -ENOSYS();
 413         } else {
 414                 return length($buffer);
 415         }
 416 }
 417
 418 sub e_truncate {
 419         my $file = filename_fixup(shift);
 420         my $size = shift;
 421
 422         print "truncate to $size\n";
 423
 424         $files{$file}{cont} = substr($files{$file}{cont},0,$size);
 425         $files{$file}{size} = $size;
 426         return 0
 427 };
 428
 429
 430 sub e_utime {
 431         my ($atime,$mtime,$file) = @_;
 432         $file = filename_fixup($file);
 433
 434         return -ENOENT() unless exists($files{$file});
 435
 436         print "utime '$file' $atime $mtime\n";
 437
 438         $files{$file}{time} = $mtime;
 439         return 0;
 440 }
 441
 442 sub e_statfs { return 255, 1, 1, 1, 1, 2 }
 443
 444 sub e_unlink {
 445         my $file = filename_fixup(shift);
 446
 447         if (exists( $dirs{$file} )) {
 448                 print "unlink '$file' will re-read template names\n";
 449                 print Dumper($fuse_self);
 450                 $$fuse_self->{'read_filenames'}->();
 451                 return 0;
 452         } elsif (exists( $files{$file} )) {
 453                 print "unlink '$file' will invalidate cache\n";
 454                 read_content($file,$files{$file}{id});
 455                 return 0;
 456         }
 457
 458         return -ENOENT();
 459 }
 460 1;
 461 __END__
 462
 463 =head1 EXPORT
 464
 465 Nothing.
 466
 467 =head1 SEE ALSO
 468
 469 C<FUSE (Filesystem in USErspace)> website
 470 L<http://sourceforge.net/projects/avf>
 471
 472 =head1 AUTHOR
 473
 474 Dobrica Pavlinusic, E<lt>dpavlin@rot13.orgE<gt>
 475
 476 =head1 COPYRIGHT AND LICENSE
 477
 478 Copyright (C) 2004 by Dobrica Pavlinusic
 479
 480 This library is free software; you can redistribute it and/or modify
 481 it under the same terms as Perl itself, either Perl version 5.8.4 or,
 482 at your option, any later version of Perl 5 you may have available.
 483
 484
 485 =cut
 486