use Data::Config from WebGUI installation to read configuration file and
[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
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