line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DBI::Filesystem; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
=head1 NAME |
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
DBI::Filesystem - Store a filesystem in a relational database |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
=head1 SYNOPSIS |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
use DBI::Filesystem; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# Preliminaries. Create the mount point: |
12
|
|
|
|
|
|
|
mkdir '/tmp/mount'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# Create the databas: |
15
|
|
|
|
|
|
|
system "mysqladmin -uroot create test_filesystem"; |
16
|
|
|
|
|
|
|
system "mysql -uroot -e 'grant all privileges on test_filesystem.* to $ENV{USER}@localhost' mysql"; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# (Usually you would do this in the shell.) |
19
|
|
|
|
|
|
|
# (You will probably need to add the admin user's password) |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
# Create the filesystem object |
22
|
|
|
|
|
|
|
$fs = DBI::Filesystem->new('dbi:mysql:test_filesystem',{initialize=>1}); |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
# Mount it on the mount point. |
25
|
|
|
|
|
|
|
# This call will block until the filesystem is mounted by another |
26
|
|
|
|
|
|
|
# process by calling "fusermount -u /tmp/mount" |
27
|
|
|
|
|
|
|
$fs->mount('/tmp/mount'); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# Alternatively, manipulate the filesystem directly from within Perl. |
30
|
|
|
|
|
|
|
# Any of these methods could raise a fatal error, so always wrap in |
31
|
|
|
|
|
|
|
# an eval to catch those errors. |
32
|
|
|
|
|
|
|
eval { |
33
|
|
|
|
|
|
|
# directory creation |
34
|
|
|
|
|
|
|
$fs->create_directory('/dir1'); |
35
|
|
|
|
|
|
|
$fs->create_directory('/dir1/subdir_1a'); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# file creation |
38
|
|
|
|
|
|
|
$fs->create_file('/dir1/subdir_1a/test.txt'); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# file I/O |
41
|
|
|
|
|
|
|
$fs->write('/dir1/subdir_1a/test.txt','This is my favorite file',0); |
42
|
|
|
|
|
|
|
my $data = $fs->read('/dir1/subdir_1a/test.txt',100,0); |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
# reading contents of a directory |
45
|
|
|
|
|
|
|
my @entries = $fs->getdir('/dir1'); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# fstat file/directory |
48
|
|
|
|
|
|
|
my @stat = $fs->stat('/dir1/subdir_1a/test.txt'); |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
#chmod/chown file |
51
|
|
|
|
|
|
|
$fs->chmod('/dir1/subdir_1a/test.txt',0600); |
52
|
|
|
|
|
|
|
$fs->chown('/dir1/subdir_1a/test.txt',1001,1001); #uid,gid |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# rename file/directory |
55
|
|
|
|
|
|
|
$fs->rename('/dir1'=>'/dir2'); |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
# create a symbolic link |
58
|
|
|
|
|
|
|
$fs->symlink('/dir2' => '/dir1'); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# create a hard link |
61
|
|
|
|
|
|
|
$fs->link('/dir2/subdir_1a/test.txt' => '/dir2/hardlink.txt'); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
# read symbolic link |
64
|
|
|
|
|
|
|
my $target = $fs->read_symlink('/dir1/symlink.txt'); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
# unlink a file |
67
|
|
|
|
|
|
|
$fs->unlink_file('/dir2/subdir_1a/test.txt'); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
# remove a directory |
70
|
|
|
|
|
|
|
$fs->remove_directory('/dir2/subdir_1a'); |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# get the inode (integer) that corresponds to a file/directory |
73
|
|
|
|
|
|
|
my $inode = $fs->path2inode('/dir2'); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
# get the path(s) that correspond to an inode |
76
|
|
|
|
|
|
|
my @paths = $fs->inode2paths($inode); |
77
|
|
|
|
|
|
|
}; |
78
|
|
|
|
|
|
|
if ($@) { warn "file operation failed with $@"; } |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 DESCRIPTION |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
This module can be used to create a fully-functioning "Fuse" userspace |
83
|
|
|
|
|
|
|
filesystem on top of a relational database. Unlike other |
84
|
|
|
|
|
|
|
filesystem-to-DBM mappings, such as Fuse::DBI, this one creates and |
85
|
|
|
|
|
|
|
manages a specific schema designed to support filesystem |
86
|
|
|
|
|
|
|
operations. If you wish to mount a filesystem on an arbitrary DBM |
87
|
|
|
|
|
|
|
schema, you probably want Fuse::DBI, not this. |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
Most filesystem functionality is implemented, including hard and soft |
90
|
|
|
|
|
|
|
links, sparse files, ownership and access modes, UNIX permission |
91
|
|
|
|
|
|
|
checking and random access to binary files. Very large files (up to |
92
|
|
|
|
|
|
|
multiple gigabytes) are supported without performance degradation. |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
Why would you use this? The main reason is that it allows you to use |
95
|
|
|
|
|
|
|
DBMs functionality such as accessibility over the network, database |
96
|
|
|
|
|
|
|
replication, failover, etc. In addition, the underlying |
97
|
|
|
|
|
|
|
DBI::Filesystem module can be extended via subclassing to allow |
98
|
|
|
|
|
|
|
additional functionality such as arbitrary access control rules, |
99
|
|
|
|
|
|
|
searchable file and directory metadata, full-text indexing of file |
100
|
|
|
|
|
|
|
contents, etc. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
Before mounting the DBMS, you must have created the database and |
103
|
|
|
|
|
|
|
assigned yourself sufficient privileges to read and write to it. You |
104
|
|
|
|
|
|
|
must also create an empty directory to serve as the mount point. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
A convenient front-end to this library is provided by B, |
107
|
|
|
|
|
|
|
which is installed along with this library. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head2 Unsupported Features |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
The following features are not implemented: |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
* statfs -- df on the filesystem will not provide any useful information |
114
|
|
|
|
|
|
|
on free space or other filesystem information. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
* extended attributes -- Extended attributes are not supported. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
* nanosecond times -- atime, mtime and ctime are accurate only to the |
119
|
|
|
|
|
|
|
second. |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
* ioctl -- none are supported |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
* poll -- polling on the filesystem to detect file update events will not work. |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
* lock -- file handle locking among processes running on the local machine |
126
|
|
|
|
|
|
|
works, but protocol-level locking, which would allow cooperative |
127
|
|
|
|
|
|
|
locks on different machines talking to the same database server, |
128
|
|
|
|
|
|
|
is not implemented. |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
You must be the superuser in order to create a file system with the |
131
|
|
|
|
|
|
|
suid and dev features enabled, and must invoke this commmand with |
132
|
|
|
|
|
|
|
the mount options "allow_other", "suid" and/or "dev": |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
-o dev,suid,allow_other |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
=head2 Supported Database Management Systems |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
DBMSs differ in what subsets of the SQL language they support, |
139
|
|
|
|
|
|
|
supported datatypes, date/time handling, and support for large binary |
140
|
|
|
|
|
|
|
objects. DBI::Filesystem currently supports MySQL, PostgreSQL and |
141
|
|
|
|
|
|
|
SQLite. Other DBMSs can be supported by creating a subclass file |
142
|
|
|
|
|
|
|
named, e.g. DBI::Filesystem:Oracle, where the last part of the class |
143
|
|
|
|
|
|
|
name corresponds to the DBD driver name ("Oracle" in this |
144
|
|
|
|
|
|
|
example). See DBI::Filesystem::SQLite, DBI::Filesystem::mysql and |
145
|
|
|
|
|
|
|
DBI::Filesystem:Pg for an illustration of the methods that need to be |
146
|
|
|
|
|
|
|
defined/overridden. |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head2 Fuse Installation Notes |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
For best performance, you will need to run this filesystem using a |
151
|
|
|
|
|
|
|
version of Perl that supports IThreads. Otherwise it will fall back to |
152
|
|
|
|
|
|
|
non-threaded mode, which will introduce occasional delays during |
153
|
|
|
|
|
|
|
directory listings and have notably slower performance when reading |
154
|
|
|
|
|
|
|
from more than one file simultaneously. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
If you are running Perl 5.14 or higher, you *MUST* use at least 0.15 |
157
|
|
|
|
|
|
|
of the Perl Fuse module. At the time this was written, the version of |
158
|
|
|
|
|
|
|
Fuse 0.15 on CPAN was failing its regression tests on many |
159
|
|
|
|
|
|
|
platforms. I have found that the easiest way to get a fully |
160
|
|
|
|
|
|
|
operational Fuse module is to clone and compile a patched version of |
161
|
|
|
|
|
|
|
the source, following this recipe: |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
$ git clone git://github.com/dpavlin/perl-fuse.git |
164
|
|
|
|
|
|
|
$ cd perl-fuse |
165
|
|
|
|
|
|
|
$ perl Makefile.PL |
166
|
|
|
|
|
|
|
$ make test (optional) |
167
|
|
|
|
|
|
|
$ sudo make install |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head1 HIGH LEVEL METHODS |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
The following methods are most likely to be needed by users of this module. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=cut |
174
|
|
|
|
|
|
|
|
175
|
5
|
|
|
5
|
|
18828
|
use strict; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
197
|
|
176
|
5
|
|
|
5
|
|
25
|
use warnings; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
153
|
|
177
|
5
|
|
|
5
|
|
31
|
use DBI; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
262
|
|
178
|
5
|
|
|
5
|
|
2244
|
use Fuse 'fuse_get_context',':xattr'; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
use threads; |
180
|
|
|
|
|
|
|
use threads::shared; |
181
|
|
|
|
|
|
|
use File::Basename 'basename','dirname'; |
182
|
|
|
|
|
|
|
use File::Spec; |
183
|
|
|
|
|
|
|
use POSIX qw(ENOENT EISDIR ENOTDIR ENOTEMPTY EINVAL ECONNABORTED EACCES EIO EPERM EEXIST |
184
|
|
|
|
|
|
|
O_RDONLY O_WRONLY O_RDWR O_CREAT F_OK R_OK W_OK X_OK |
185
|
|
|
|
|
|
|
S_IXUSR S_IXGRP S_IXOTH); |
186
|
|
|
|
|
|
|
use Carp 'croak'; |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
our $VERSION = '1.04'; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
use constant SCHEMA_VERSION => 3; |
191
|
|
|
|
|
|
|
use constant ENOATTR => ENOENT; # not sure this is right? |
192
|
|
|
|
|
|
|
use constant MAX_PATH_LEN => 4096; # characters |
193
|
|
|
|
|
|
|
use constant BLOCKSIZE => 16384; # bytes |
194
|
|
|
|
|
|
|
use constant FLUSHBLOCKS => 256; # flush after we've accumulated this many cached blocks |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
my %Blockbuff :shared; |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
=head2 $fs = DBI::Filesystem->new($dsn,{options...}) |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
Create the new DBI::Filesystem object. The mandatory first argument is |
202
|
|
|
|
|
|
|
a DBI data source, in the format "dbi::". The |
203
|
|
|
|
|
|
|
other arguments may include the database name, host, port, and |
204
|
|
|
|
|
|
|
security credentials. See the documentation for your DBMS for details. |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
Non-mandatory options are contained in a hash reference with one or |
207
|
|
|
|
|
|
|
more of the following keys: |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
initialize If true, then initialize the database schema. Many |
210
|
|
|
|
|
|
|
DBMSs require you to create the database first. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
ignore_permissions If true, then Unix permission checking is not |
213
|
|
|
|
|
|
|
performed when creating/reading/writing files. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
allow_magic_dirs If true, allow SQL statements in "magic" directories |
216
|
|
|
|
|
|
|
to be executed (see below). |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
WARNING: Initializing the schema quietly destroys anything that might |
219
|
|
|
|
|
|
|
have been there before! |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
=cut |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
# DBI::Filesystem->new($dsn,{create=>1,ignore_permissions=>1}) |
224
|
|
|
|
|
|
|
sub new { |
225
|
|
|
|
|
|
|
my $class = shift; |
226
|
|
|
|
|
|
|
my ($dsn,$options) = @_; |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
my ($dbd) = $dsn =~ /dbi:([^:]+)/; |
229
|
|
|
|
|
|
|
$dbd or croak "Could not figure out the DBI subclass to load from $dsn"; |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
$options ||= {}; |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
# load the appropriate DBD subclass and fix up its @ISA so that we become |
234
|
|
|
|
|
|
|
# the parent class |
235
|
|
|
|
|
|
|
my $c = ref $class||$class; |
236
|
|
|
|
|
|
|
my $subclass = __PACKAGE__.'::DBD::'.$dbd; |
237
|
|
|
|
|
|
|
eval "require $subclass;1" or croak $@ unless $subclass->can('new'); |
238
|
|
|
|
|
|
|
eval "unshift \@$subclass\:\:ISA,'$c' unless \$subclass->isa('$c')"; |
239
|
|
|
|
|
|
|
die $@ if $@; |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
my $self = bless { |
242
|
|
|
|
|
|
|
dsn => $dsn, |
243
|
|
|
|
|
|
|
%$options |
244
|
|
|
|
|
|
|
},$subclass; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
local $self->{dbh}; # to avoid cloning database handle into child threads |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
$self->initialize_schema if $options->{initialize}; |
249
|
|
|
|
|
|
|
$self->check_schema_version; |
250
|
|
|
|
|
|
|
return $self; |
251
|
|
|
|
|
|
|
} |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
=head2 $boolean = $fs->ignore_permissions([$boolean]); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
Get/set the ignore_permissions flag. If ignore_permissions is true, |
256
|
|
|
|
|
|
|
then all permission checks on file and directory access modes are |
257
|
|
|
|
|
|
|
disabled, allowing you to create files owned by root, etc. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=cut |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
sub ignore_permissions { |
262
|
|
|
|
|
|
|
my $self = shift; |
263
|
|
|
|
|
|
|
my $d = $self->{ignore_permissions}; |
264
|
|
|
|
|
|
|
$self->{ignore_permissions} = shift if @_; |
265
|
|
|
|
|
|
|
$d; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=head2 $boolean = $fs->allow_magic_dirs([$boolean]); |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
Get/set the allow_magic_dirs flag. If true, then directories whose |
271
|
|
|
|
|
|
|
names begin with "%%" will be searched for a dotfile named ".query" |
272
|
|
|
|
|
|
|
that contains a SQL statement to be run every time a directory listing |
273
|
|
|
|
|
|
|
is required from this directory. See getdir() below. |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
=cut |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
sub allow_magic_dirs { |
278
|
|
|
|
|
|
|
my $self = shift; |
279
|
|
|
|
|
|
|
my $d = $self->{allow_magic_dirs}; |
280
|
|
|
|
|
|
|
$self->{allow_magic_dirs} = shift if @_; |
281
|
|
|
|
|
|
|
$d; |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
############### filesystem handlers below ##################### |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
our $Self; # because entrypoints cannot be passed as closures |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=head2 $fs->mount($mountpoint, [\%fuseopts]) |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
This method will mount the filesystem on the indicated mountpoint |
291
|
|
|
|
|
|
|
using Fuse and block until the filesystem is unmounted using the |
292
|
|
|
|
|
|
|
"fusermount -u" command or equivalent. The mountpoint must be an empty |
293
|
|
|
|
|
|
|
directory unless the "nonempty" mount option is passed. |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
You may pass in a hashref of options to pass to the Fuse |
296
|
|
|
|
|
|
|
module. Recognized options and their defaults are: |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
debug Turn on verbose debugging of Fuse operations [false] |
299
|
|
|
|
|
|
|
threaded Turn on threaded operations [true] |
300
|
|
|
|
|
|
|
nullpath_ok Allow filehandles on open files to be used even after file |
301
|
|
|
|
|
|
|
is unlinked [true] |
302
|
|
|
|
|
|
|
mountopts Comma-separated list of mount options |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
Mount options to be passed to Fuse are described at |
305
|
|
|
|
|
|
|
http://manpages.ubuntu.com/manpages/precise/man8/mount.fuse.8.html. In |
306
|
|
|
|
|
|
|
addition, you may pass the usual mount options such as "ro", etc. They |
307
|
|
|
|
|
|
|
are presented as a comma-separated list as shown here: |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
$fs->mount('/tmp/foo',{debug=>1,mountopts=>'ro,nonempty'}) |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
Common mount options include: |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
Fuse specific |
314
|
|
|
|
|
|
|
nonempty Allow mounting over non-empty directories if true [false] |
315
|
|
|
|
|
|
|
allow_other Allow other users to access the mounted filesystem [false] |
316
|
|
|
|
|
|
|
fsname Set the filesystem source name shown in df and /etc/mtab |
317
|
|
|
|
|
|
|
auto_cache Enable automatic flushing of data cache on open [false] |
318
|
|
|
|
|
|
|
hard_remove Allow true unlinking of open files [true] |
319
|
|
|
|
|
|
|
nohard_remove Activate alternate semantics for unlinking open files |
320
|
|
|
|
|
|
|
(see below) |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
General |
323
|
|
|
|
|
|
|
ro Read-only filesystem |
324
|
|
|
|
|
|
|
dev Allow device-special files |
325
|
|
|
|
|
|
|
nodev Do not allow device-special files |
326
|
|
|
|
|
|
|
suid Allow suid files |
327
|
|
|
|
|
|
|
nosuid Do not allow suid files |
328
|
|
|
|
|
|
|
exec Allow executable files |
329
|
|
|
|
|
|
|
noexec Do not allow executable files |
330
|
|
|
|
|
|
|
atime Update file/directory access times |
331
|
|
|
|
|
|
|
noatime Do not update file/directory access times |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
Some options require special privileges. In particular allow_other |
334
|
|
|
|
|
|
|
must be enabled in /etc/fuse.conf, and the dev and suid options can |
335
|
|
|
|
|
|
|
only be used by the root user. |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
The "hard_remove" mount option is passed by default. This option |
338
|
|
|
|
|
|
|
allows files to be unlinked in one process while another process holds |
339
|
|
|
|
|
|
|
an open filehandle on them. The contents of the file will not actually |
340
|
|
|
|
|
|
|
be deleted until the last open filehandle is closed. The downside of |
341
|
|
|
|
|
|
|
this is that certain functions will fail when called on filehandles |
342
|
|
|
|
|
|
|
connected to unlinked files, including fstat(), ftruncate(), chmod(), |
343
|
|
|
|
|
|
|
and chown(). If this is an issue, then pass option |
344
|
|
|
|
|
|
|
"nohard_remove". This will activate Fuse's alternative semantic in |
345
|
|
|
|
|
|
|
which unlinked open files are renamed to a hidden file with a name |
346
|
|
|
|
|
|
|
like ".fuse_hiddenXXXXXXX'. The hidden file is removed when the last |
347
|
|
|
|
|
|
|
filehandle is closed. |
348
|
|
|
|
|
|
|
|
349
|
|
|
|
|
|
|
=cut |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub mount { |
352
|
|
|
|
|
|
|
my $self = shift; |
353
|
|
|
|
|
|
|
my $mtpt = shift or croak "Usage: mount(\$mountpoint)"; |
354
|
|
|
|
|
|
|
my $fuse_opts = shift; |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
$fuse_opts ||= {}; |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
my %mt_opts = map {$_=>1} split ',',($fuse_opts->{mountopts}||''); |
359
|
|
|
|
|
|
|
$mt_opts{hard_remove}++ unless $mt_opts{nohard_remove}; |
360
|
|
|
|
|
|
|
delete $mt_opts{nohard_remove}; |
361
|
|
|
|
|
|
|
$fuse_opts->{mountopts} = join ',',keys %mt_opts; |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
my $pkg = __PACKAGE__; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
$Self = $self; # because entrypoints cannot be passed as closures |
366
|
|
|
|
|
|
|
$self->check_schema |
367
|
|
|
|
|
|
|
or croak "This database does not appear to contain a valid schema. Do you need to initialize it?\n"; |
368
|
|
|
|
|
|
|
$self->mounted(1); |
369
|
|
|
|
|
|
|
my @args = ( |
370
|
|
|
|
|
|
|
mountpoint => $mtpt, |
371
|
|
|
|
|
|
|
getdir => "$pkg\:\:e_getdir", |
372
|
|
|
|
|
|
|
getattr => "$pkg\:\:e_getattr", |
373
|
|
|
|
|
|
|
fgetattr => "$pkg\:\:e_fgetattr", |
374
|
|
|
|
|
|
|
open => "$pkg\:\:e_open", |
375
|
|
|
|
|
|
|
release => "$pkg\:\:e_release", |
376
|
|
|
|
|
|
|
flush => "$pkg\:\:e_flush", |
377
|
|
|
|
|
|
|
read => "$pkg\:\:e_read", |
378
|
|
|
|
|
|
|
write => "$pkg\:\:e_write", |
379
|
|
|
|
|
|
|
ftruncate => "$pkg\:\:e_ftruncate", |
380
|
|
|
|
|
|
|
truncate => "$pkg\:\:e_truncate", |
381
|
|
|
|
|
|
|
create => "$pkg\:\:e_create", |
382
|
|
|
|
|
|
|
mknod => "$pkg\:\:e_mknod", |
383
|
|
|
|
|
|
|
mkdir => "$pkg\:\:e_mkdir", |
384
|
|
|
|
|
|
|
rmdir => "$pkg\:\:e_rmdir", |
385
|
|
|
|
|
|
|
link => "$pkg\:\:e_link", |
386
|
|
|
|
|
|
|
rename => "$pkg\:\:e_rename", |
387
|
|
|
|
|
|
|
access => "$pkg\:\:e_access", |
388
|
|
|
|
|
|
|
chmod => "$pkg\:\:e_chmod", |
389
|
|
|
|
|
|
|
chown => "$pkg\:\:e_chown", |
390
|
|
|
|
|
|
|
symlink => "$pkg\:\:e_symlink", |
391
|
|
|
|
|
|
|
readlink => "$pkg\:\:e_readlink", |
392
|
|
|
|
|
|
|
unlink => "$pkg\:\:e_unlink", |
393
|
|
|
|
|
|
|
utime => "$pkg\:\:e_utime", |
394
|
|
|
|
|
|
|
getxattr => "$pkg\:\:e_getxattr", |
395
|
|
|
|
|
|
|
listxattr => "$pkg\:\:e_listxattr", |
396
|
|
|
|
|
|
|
nullpath_ok => 1, |
397
|
|
|
|
|
|
|
debug => 0, |
398
|
|
|
|
|
|
|
threaded => 1, |
399
|
|
|
|
|
|
|
%$fuse_opts, |
400
|
|
|
|
|
|
|
); |
401
|
|
|
|
|
|
|
push @args,$self->_subclass_implemented_calls(); |
402
|
|
|
|
|
|
|
Fuse::main(@args); |
403
|
|
|
|
|
|
|
} |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
# this method detects when one of the currently unimplemented |
406
|
|
|
|
|
|
|
# Fuse methods is defined in a subclass, and creates the appropriate |
407
|
|
|
|
|
|
|
# Fuse stub to call it |
408
|
|
|
|
|
|
|
sub _subclass_implemented_calls{ |
409
|
|
|
|
|
|
|
my $self = shift; |
410
|
|
|
|
|
|
|
my @args; |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
my @u = (qw(statfs fsync |
413
|
|
|
|
|
|
|
setxattr getxattr listxattr removexattr |
414
|
|
|
|
|
|
|
opendir readdir releasedir fsyncdir |
415
|
|
|
|
|
|
|
init destroy lock utimens |
416
|
|
|
|
|
|
|
bmap ioctl poll)); |
417
|
|
|
|
|
|
|
my @implemented = grep {$self->can($_)} @u; |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
my $pkg = __PACKAGE__; |
420
|
|
|
|
|
|
|
foreach my $method (@implemented) { |
421
|
|
|
|
|
|
|
next if $self->can("e_$method"); # don't overwrite |
422
|
|
|
|
|
|
|
my $hook = "$pkg\:\:e_$method"; |
423
|
|
|
|
|
|
|
eval <
|
424
|
|
|
|
|
|
|
sub $hook { |
425
|
|
|
|
|
|
|
my \$path = fixup(shift) if \@_; |
426
|
|
|
|
|
|
|
my \@result = eval {\$${pkg}\:\:Self->$method(\$path,\@_)}; |
427
|
|
|
|
|
|
|
return \$Self->errno(\$@) if \$@; |
428
|
|
|
|
|
|
|
return wantarray ? \@result:\$result[0]; |
429
|
|
|
|
|
|
|
} |
430
|
|
|
|
|
|
|
END |
431
|
|
|
|
|
|
|
; |
432
|
|
|
|
|
|
|
warn $@ if $@; |
433
|
|
|
|
|
|
|
push @args,($method => $hook); |
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
return @args; |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
=head2 $boolean = $fs->mounted([$boolean]) |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
This method returns true if the filesystem is currently |
441
|
|
|
|
|
|
|
mounted. Subclasses can change this value by passing the new value as |
442
|
|
|
|
|
|
|
the argument. |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=cut |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
sub mounted { |
447
|
|
|
|
|
|
|
my $self = shift; |
448
|
|
|
|
|
|
|
my $d = $self->{mounted}; |
449
|
|
|
|
|
|
|
$self->{mounted} = shift if @_; |
450
|
|
|
|
|
|
|
return $d; |
451
|
|
|
|
|
|
|
} |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=head2 Fuse hook functions |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
This module defines a series of short hook functions that form the |
456
|
|
|
|
|
|
|
glue between Fuse's function-oriented callback hooks and this module's |
457
|
|
|
|
|
|
|
object-oriented methods. A typical hook function looks like this: |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
sub e_getdir { |
460
|
|
|
|
|
|
|
my $path = fixup(shift); |
461
|
|
|
|
|
|
|
my @entries = eval {$Self->getdir($path)}; |
462
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
463
|
|
|
|
|
|
|
return (@entries,0); |
464
|
|
|
|
|
|
|
} |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
The preferred naming convention is that the Fuse callback is named |
467
|
|
|
|
|
|
|
"getdir", the function hook is named e_getdir(), and the method is |
468
|
|
|
|
|
|
|
$fs->getdir(). The DBI::Filesystem object is stored in a singleton |
469
|
|
|
|
|
|
|
global named $Self. The hook fixes up the path it receives from Fuse, |
470
|
|
|
|
|
|
|
and then calls the getdir() method in an eval{} block. If the getdir() |
471
|
|
|
|
|
|
|
method raises an error such as "file not found", the error message is |
472
|
|
|
|
|
|
|
passed to the errno() method to turn into a ERRNO code, and this is |
473
|
|
|
|
|
|
|
returned to the caller. Otherwise, the hook returns the results in the |
474
|
|
|
|
|
|
|
format proscribed by Fuse. |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
If you are subclassing DBI::Filesystem, there is no need to define new |
477
|
|
|
|
|
|
|
hook functions. All hooks described by Fuse are already defined or |
478
|
|
|
|
|
|
|
generated dynamically as needed. Simply create a correctly-named |
479
|
|
|
|
|
|
|
method in your subclass. |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
These are the hooks that are defined: |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
e_getdir e_open e_access e_unlink e_removexattr |
484
|
|
|
|
|
|
|
e_getattr e_release e_rename e_rmdir |
485
|
|
|
|
|
|
|
e_fgetattr e_flush e_chmod e_utime |
486
|
|
|
|
|
|
|
e_mkdir e_read e_chown e_getxattr |
487
|
|
|
|
|
|
|
e_mknod e_write e_symlink e_setxattr |
488
|
|
|
|
|
|
|
e_create e_truncate e_readlink e_listxattr |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
These hooks will be created as needed if a subclass implements the |
491
|
|
|
|
|
|
|
corresponding methods: |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
e_statfs e_lock e_init |
494
|
|
|
|
|
|
|
e_fsync e_opendir e_destroy |
495
|
|
|
|
|
|
|
e_readdir e_utimens |
496
|
|
|
|
|
|
|
e_releasedir e_bmap |
497
|
|
|
|
|
|
|
e_fsyncdir e_ioctl |
498
|
|
|
|
|
|
|
e_poll |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=cut |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub e_getdir { |
503
|
|
|
|
|
|
|
my $path = fixup(shift); |
504
|
|
|
|
|
|
|
my @entries = eval {$Self->getdir($path)}; |
505
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
506
|
|
|
|
|
|
|
return (@entries,0); |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
sub e_getattr { |
510
|
|
|
|
|
|
|
my $path = fixup(shift); |
511
|
|
|
|
|
|
|
my @stat = eval {$Self->getattr($path)}; |
512
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
513
|
|
|
|
|
|
|
return @stat; |
514
|
|
|
|
|
|
|
} |
515
|
|
|
|
|
|
|
|
516
|
|
|
|
|
|
|
# the {get,list}xattr methods call for a bit of finessing of return values |
517
|
|
|
|
|
|
|
# |
518
|
|
|
|
|
|
|
sub e_getxattr { |
519
|
|
|
|
|
|
|
my $path = fixup(shift); |
520
|
|
|
|
|
|
|
my $name = shift; |
521
|
|
|
|
|
|
|
my $val = eval {$Self->getxattr($path,$name)}; |
522
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
523
|
|
|
|
|
|
|
return 0 unless defined $val; |
524
|
|
|
|
|
|
|
return $val |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
sub e_listxattr { |
528
|
|
|
|
|
|
|
my $path = fixup(shift); |
529
|
|
|
|
|
|
|
my @val = eval {$Self->listxattr($path)}; |
530
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
531
|
|
|
|
|
|
|
return (@val,0); |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
sub e_fgetattr { |
535
|
|
|
|
|
|
|
my ($path,$inode) = @_; |
536
|
|
|
|
|
|
|
my @stat = eval {$Self->fgetattr(fixup($path),$inode)}; |
537
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
538
|
|
|
|
|
|
|
return @stat; |
539
|
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub e_mkdir { |
542
|
|
|
|
|
|
|
my $path = fixup(shift); |
543
|
|
|
|
|
|
|
my $mode = shift; |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
$mode |= 0040000; |
546
|
|
|
|
|
|
|
my $ctx = $Self->get_context(); |
547
|
|
|
|
|
|
|
my $umask = $ctx->{umask}; |
548
|
|
|
|
|
|
|
eval {$Self->mkdir($path,$mode&(~$umask))}; |
549
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
550
|
|
|
|
|
|
|
return 0; |
551
|
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
|
|
553
|
|
|
|
|
|
|
sub e_mknod { |
554
|
|
|
|
|
|
|
my $path = fixup(shift); |
555
|
|
|
|
|
|
|
my ($mode,$device) = @_; |
556
|
|
|
|
|
|
|
my $ctx = $Self->get_context; |
557
|
|
|
|
|
|
|
my $umask = $ctx->{umask}; |
558
|
|
|
|
|
|
|
eval {$Self->mknod($path,$mode&(~$umask),$device)}; |
559
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
560
|
|
|
|
|
|
|
return 0; |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
|
563
|
|
|
|
|
|
|
sub e_create { |
564
|
|
|
|
|
|
|
my $path = fixup(shift); |
565
|
|
|
|
|
|
|
my ($mode,$flags) = @_; |
566
|
|
|
|
|
|
|
# warn sprintf("create(%s,0%o,0%o)",$path,$mode,$flags); |
567
|
|
|
|
|
|
|
my $ctx = $Self->get_context; |
568
|
|
|
|
|
|
|
my $umask = $ctx->{umask}; |
569
|
|
|
|
|
|
|
my $fh = eval { |
570
|
|
|
|
|
|
|
$Self->mknod($path,$mode&(~$umask)); |
571
|
|
|
|
|
|
|
$Self->open($path,$flags,{}); |
572
|
|
|
|
|
|
|
}; |
573
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
574
|
|
|
|
|
|
|
return (0,$fh); |
575
|
|
|
|
|
|
|
} |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
sub e_open { |
578
|
|
|
|
|
|
|
my ($path,$flags,$info) = @_; |
579
|
|
|
|
|
|
|
# warn sprintf("open(%s,0%o,%s)",$path,$flags,$info); |
580
|
|
|
|
|
|
|
$path = fixup($path); |
581
|
|
|
|
|
|
|
my $fh = eval {$Self->open($path,$flags,$info)}; |
582
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
583
|
|
|
|
|
|
|
(0,$fh); |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
sub e_release { |
587
|
|
|
|
|
|
|
my ($path,$flags,$fh) = @_; |
588
|
|
|
|
|
|
|
eval {$Self->release($fh)}; |
589
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
590
|
|
|
|
|
|
|
return 0; |
591
|
|
|
|
|
|
|
} |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
sub e_flush { |
594
|
|
|
|
|
|
|
my ($path,$fh) = @_; |
595
|
|
|
|
|
|
|
eval {$Self->flush($path,$fh)}; |
596
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
597
|
|
|
|
|
|
|
return 0; |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub e_read { |
602
|
|
|
|
|
|
|
my ($path,$size,$offset,$fh) = @_; |
603
|
|
|
|
|
|
|
$path = fixup($path); |
604
|
|
|
|
|
|
|
my $data = eval {$Self->read($path,$size,$offset,$fh)}; |
605
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
606
|
|
|
|
|
|
|
return $data; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
sub e_write { |
610
|
|
|
|
|
|
|
my ($path,$buffer,$offset,$fh) = @_; |
611
|
|
|
|
|
|
|
$path = fixup($path); |
612
|
|
|
|
|
|
|
my $data = eval {$Self->write($path,$buffer,$offset,$fh)}; |
613
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
614
|
|
|
|
|
|
|
return $data; |
615
|
|
|
|
|
|
|
} |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
sub e_truncate { |
618
|
|
|
|
|
|
|
my ($path,$offset) = @_; |
619
|
|
|
|
|
|
|
$path = fixup($path); |
620
|
|
|
|
|
|
|
eval {$Self->truncate($path,$offset)}; |
621
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
622
|
|
|
|
|
|
|
return 0; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
sub e_ftruncate { |
626
|
|
|
|
|
|
|
my ($path,$offset,$inode) = @_; |
627
|
|
|
|
|
|
|
$path = fixup($path); |
628
|
|
|
|
|
|
|
eval {$Self->truncate($path,$offset,$inode)}; |
629
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
630
|
|
|
|
|
|
|
return 0; |
631
|
|
|
|
|
|
|
} |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
sub e_link { |
634
|
|
|
|
|
|
|
my ($oldname,$newname) = @_; |
635
|
|
|
|
|
|
|
eval {$Self->link($oldname,$newname)}; |
636
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
637
|
|
|
|
|
|
|
return 0; |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
|
640
|
|
|
|
|
|
|
sub e_access { |
641
|
|
|
|
|
|
|
my ($path,$access_mode) = @_; |
642
|
|
|
|
|
|
|
eval {$Self->access($path,$access_mode)}; |
643
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
644
|
|
|
|
|
|
|
return 0; |
645
|
|
|
|
|
|
|
} |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
sub e_rename { |
648
|
|
|
|
|
|
|
my ($oldname,$newname) = @_; |
649
|
|
|
|
|
|
|
eval { $Self->rename($oldname,$newname) }; |
650
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
651
|
|
|
|
|
|
|
return 0; |
652
|
|
|
|
|
|
|
} |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
sub e_chmod { |
655
|
|
|
|
|
|
|
my ($path,$mode) = @_; |
656
|
|
|
|
|
|
|
eval {$Self->chmod($path,$mode)}; |
657
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
658
|
|
|
|
|
|
|
return 0; |
659
|
|
|
|
|
|
|
} |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
sub e_chown { |
662
|
|
|
|
|
|
|
my ($path,$uid,$gid) = @_; |
663
|
|
|
|
|
|
|
eval {$Self->chown($path,$uid,$gid)}; |
664
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
665
|
|
|
|
|
|
|
return 0; |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
sub e_symlink { |
669
|
|
|
|
|
|
|
my ($oldname,$newname) = @_; |
670
|
|
|
|
|
|
|
eval {$Self->symlink($oldname,$newname)}; |
671
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
672
|
|
|
|
|
|
|
return 0; |
673
|
|
|
|
|
|
|
} |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
sub e_readlink { |
676
|
|
|
|
|
|
|
my $path = shift; |
677
|
|
|
|
|
|
|
my $link = eval {$Self->readlink($path)}; |
678
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
679
|
|
|
|
|
|
|
return $link; |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
sub e_unlink { |
683
|
|
|
|
|
|
|
my $path = shift; |
684
|
|
|
|
|
|
|
eval {$Self->unlink($path)}; |
685
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
686
|
|
|
|
|
|
|
return 0; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
sub e_rmdir { |
690
|
|
|
|
|
|
|
my $path = shift; |
691
|
|
|
|
|
|
|
eval {$Self->rmdir($path)}; |
692
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
693
|
|
|
|
|
|
|
return 0; |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
sub e_utime { |
697
|
|
|
|
|
|
|
my ($path,$atime,$mtime) = @_; |
698
|
|
|
|
|
|
|
$path = fixup($path); |
699
|
|
|
|
|
|
|
my $result = eval {$Self->utime($path,$atime,$mtime)}; |
700
|
|
|
|
|
|
|
return $Self->errno($@) if $@; |
701
|
|
|
|
|
|
|
return 0; |
702
|
|
|
|
|
|
|
} |
703
|
|
|
|
|
|
|
|
704
|
|
|
|
|
|
|
=head2 $inode = $fs->mknod($path,$mode,$rdev) |
705
|
|
|
|
|
|
|
|
706
|
|
|
|
|
|
|
This method creates a file or special file (pipe, device file, |
707
|
|
|
|
|
|
|
etc). The arguments are the path of the file to create, the mode of |
708
|
|
|
|
|
|
|
the file, and the device number if creating a special device file, or |
709
|
|
|
|
|
|
|
0 if not. The return value is the inode of the newly-created file, an |
710
|
|
|
|
|
|
|
unique integer ID, which is actually the primary key of the metadata |
711
|
|
|
|
|
|
|
table in the underlying database. |
712
|
|
|
|
|
|
|
|
713
|
|
|
|
|
|
|
The path in this, and all subsequent methods, is relative to the |
714
|
|
|
|
|
|
|
mountpoint. For example, if the filesystem is mounted on /tmp/foobar, |
715
|
|
|
|
|
|
|
and the file you wish to create is named /tmp/foobar/dir1/test.txt, |
716
|
|
|
|
|
|
|
then pass "dir1/test.txt". You can also include a leading slash (as in |
717
|
|
|
|
|
|
|
"/dir1/test.txt") which will simply be stripped off. |
718
|
|
|
|
|
|
|
|
719
|
|
|
|
|
|
|
The mode is a bitwise combination of file type and access mode as |
720
|
|
|
|
|
|
|
described for the st_mode field in the stat(2) man page. If you |
721
|
|
|
|
|
|
|
provide just the access mode (e.g. 0666), then the method will |
722
|
|
|
|
|
|
|
automatically set the file type bits to indicate that this is a |
723
|
|
|
|
|
|
|
regular file. You must provide the file type in the mode in order to |
724
|
|
|
|
|
|
|
create a special file. |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
The rdev field contains the major and minor device numbers for device |
727
|
|
|
|
|
|
|
special files, and is only needed when creating a device special file |
728
|
|
|
|
|
|
|
or pipe; ordinarily you can omit it. The rdev field is described in |
729
|
|
|
|
|
|
|
stat(2). |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
Various exceptions can arise during this call including invalid paths, |
732
|
|
|
|
|
|
|
permission errors and the attempt to create a duplicate file |
733
|
|
|
|
|
|
|
name. These will be presented as fatal errors which can be trapped by |
734
|
|
|
|
|
|
|
an eval {}. See $fs->errno() for a list of potential error messages. |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
Like other file-manipulation methods, this will die with a "permission |
737
|
|
|
|
|
|
|
denied" message if the current user does not have sufficient |
738
|
|
|
|
|
|
|
privileges to write into the desired directory. To disable permission |
739
|
|
|
|
|
|
|
checking, set ignore_permissions() to a true value: |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
$fs->ignore_permissions(1) |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
Unless explicitly provided, the mode will be set to 0100777 (all |
744
|
|
|
|
|
|
|
permissions set). |
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
=cut |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
sub mknod { |
749
|
|
|
|
|
|
|
my $self = shift; |
750
|
|
|
|
|
|
|
my ($path,$mode,$rdev) = @_; |
751
|
|
|
|
|
|
|
my $result = eval {$self->create_inode_and_path($path,'f',$mode,$rdev)}; |
752
|
|
|
|
|
|
|
if ($@) { |
753
|
|
|
|
|
|
|
die "file exists" if $@ =~ /not unique|duplicate/i; |
754
|
|
|
|
|
|
|
die $@; |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
return $result; |
757
|
|
|
|
|
|
|
} |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
=head2 $inode = $fs->mkdir($path,$mode) |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
Create a new directory with the specified path and mode and return the |
762
|
|
|
|
|
|
|
inode of the newly created directory. The path and mode are the same |
763
|
|
|
|
|
|
|
as those described for mknod(), except that the filetype bits for |
764
|
|
|
|
|
|
|
$mode will be set to those for a directory if not provided. Like |
765
|
|
|
|
|
|
|
mknod() this method may raise a fatal error, which should be trapped |
766
|
|
|
|
|
|
|
by an eval{}. |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
Unless explicitly provided, the mode will be set to 0040777 (all |
769
|
|
|
|
|
|
|
permissions set). |
770
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
=cut |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
sub mkdir { |
774
|
|
|
|
|
|
|
my $self = shift; |
775
|
|
|
|
|
|
|
my ($path,$mode) = @_; |
776
|
|
|
|
|
|
|
$self->create_inode_and_path($path,'d',$mode); |
777
|
|
|
|
|
|
|
} |
778
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
=head2 $fs->rename($oldname,$newname) |
780
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
Rename a file or directory. Raises a fatal exception if unsuccessful. |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=cut |
784
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
sub rename { |
786
|
|
|
|
|
|
|
my $self = shift; |
787
|
|
|
|
|
|
|
my ($oldname,$newname) = @_; |
788
|
|
|
|
|
|
|
my ($inode,$parent,$basename,$dynamic) = $self->path2inode($oldname); |
789
|
|
|
|
|
|
|
die "permission denied" if $dynamic; |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# if newname exists then this is an error |
792
|
|
|
|
|
|
|
die "file exists" if eval{$self->path2inode($newname)}; |
793
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
my $newbase = basename($newname); |
795
|
|
|
|
|
|
|
my $newdir = $self->_dirname($newname); |
796
|
|
|
|
|
|
|
my $newparent = $self->path2inode($newdir); # also does path checking |
797
|
|
|
|
|
|
|
$self->check_perm($parent,W_OK); # can we update the old parent? |
798
|
|
|
|
|
|
|
$self->check_perm($newparent,W_OK); # can we update the new parent? |
799
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
801
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached( |
802
|
|
|
|
|
|
|
'update path set name=?,parent=? where parent=? and name=?'); |
803
|
|
|
|
|
|
|
$sth->execute($newbase,$newparent,$parent,$basename); |
804
|
|
|
|
|
|
|
$sth->finish; |
805
|
|
|
|
|
|
|
1; |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
|
808
|
|
|
|
|
|
|
=head2 $fs->unlink($path) |
809
|
|
|
|
|
|
|
|
810
|
|
|
|
|
|
|
Unlink the file or symlink located at $path. If this is the last |
811
|
|
|
|
|
|
|
reference to the file (via hard links or filehandles) then the |
812
|
|
|
|
|
|
|
contents of the file and its inode will be permanently removed. This |
813
|
|
|
|
|
|
|
will raise a fatal exception on any errors. |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
=cut |
816
|
|
|
|
|
|
|
|
817
|
|
|
|
|
|
|
sub unlink { |
818
|
|
|
|
|
|
|
my $self = shift; |
819
|
|
|
|
|
|
|
my $path = shift; |
820
|
|
|
|
|
|
|
my ($inode,$parent,$name,$dynamic) = $self->path2inode($path); |
821
|
|
|
|
|
|
|
die "permission denied" if $dynamic; |
822
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
$parent ||= 1; |
824
|
|
|
|
|
|
|
$self->check_perm($parent,W_OK); |
825
|
|
|
|
|
|
|
|
826
|
|
|
|
|
|
|
$name ||= basename($path); |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
$self->_isdir($inode) and croak "$path is a directory"; |
829
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
830
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached("delete from path where inode=? and parent=? and name=?") |
831
|
|
|
|
|
|
|
or die $dbh->errstr; |
832
|
|
|
|
|
|
|
$sth->execute($inode,$parent,$name) or die $dbh->errstr; |
833
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
eval { |
835
|
|
|
|
|
|
|
$dbh->begin_work(); |
836
|
|
|
|
|
|
|
$dbh->do("update metadata set links=links-1 where inode=$inode"); |
837
|
|
|
|
|
|
|
$dbh->do("update metadata set links=links-1 where inode=$parent"); |
838
|
|
|
|
|
|
|
$self->touch($parent,'mtime'); |
839
|
|
|
|
|
|
|
$self->touch($parent,'ctime'); |
840
|
|
|
|
|
|
|
$dbh->commit(); |
841
|
|
|
|
|
|
|
}; |
842
|
|
|
|
|
|
|
if ($@) { |
843
|
|
|
|
|
|
|
eval {$dbh->rollback()}; |
844
|
|
|
|
|
|
|
die "unlink failed due to $@"; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
$self->unlink_inode($inode); |
847
|
|
|
|
|
|
|
1; |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
|
850
|
|
|
|
|
|
|
=head2 $fs->rmdir($path) |
851
|
|
|
|
|
|
|
|
852
|
|
|
|
|
|
|
Remove the directory at $path. This method will fail under a variety |
853
|
|
|
|
|
|
|
of conditions, raising a fatal exception. Common errors include |
854
|
|
|
|
|
|
|
attempting to remove a file rather than a directory or removing a |
855
|
|
|
|
|
|
|
directory that is not empty. |
856
|
|
|
|
|
|
|
|
857
|
|
|
|
|
|
|
=cut |
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
sub rmdir { |
860
|
|
|
|
|
|
|
my $self = shift; |
861
|
|
|
|
|
|
|
my $path = shift; |
862
|
|
|
|
|
|
|
my ($inode,$parent,$name) = $self->path2inode($path) ; |
863
|
|
|
|
|
|
|
$self->check_perm($parent,W_OK); |
864
|
|
|
|
|
|
|
$self->_isdir($inode) or croak "$path is not a directory"; |
865
|
|
|
|
|
|
|
$self->_getdir($inode ) and croak "$path is not empty"; |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
868
|
|
|
|
|
|
|
eval { |
869
|
|
|
|
|
|
|
$dbh->begin_work; |
870
|
|
|
|
|
|
|
my $now = $self->_now_sql; |
871
|
|
|
|
|
|
|
$dbh->do("update metadata set links=links-1,ctime=$now where inode=$inode"); |
872
|
|
|
|
|
|
|
$dbh->do("update metadata set links=links-1,ctime=$now where inode=$parent"); |
873
|
|
|
|
|
|
|
$dbh->do("delete from path where inode=$inode"); |
874
|
|
|
|
|
|
|
$self->touch($parent,'ctime'); |
875
|
|
|
|
|
|
|
$self->touch($parent,'mtime'); |
876
|
|
|
|
|
|
|
$self->unlink_inode($inode); |
877
|
|
|
|
|
|
|
$dbh->commit; |
878
|
|
|
|
|
|
|
}; |
879
|
|
|
|
|
|
|
if($@) { |
880
|
|
|
|
|
|
|
eval {$dbh->rollback()}; |
881
|
|
|
|
|
|
|
die "update aborted due to $@"; |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
1; |
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
|
888
|
|
|
|
|
|
|
=head2 $fs->link($oldpath,$newpath) |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
Create a hard link from the file at $oldpath to $newpath. If an error |
891
|
|
|
|
|
|
|
occurs the method will die. Note that this method will allow you to |
892
|
|
|
|
|
|
|
create a hard link to directories as well as files. This is disallowed |
893
|
|
|
|
|
|
|
by the "ln" command, and is generally a bad idea as you can create a |
894
|
|
|
|
|
|
|
filesystem with path loops. |
895
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
=cut |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub link { |
899
|
|
|
|
|
|
|
my $self = shift; |
900
|
|
|
|
|
|
|
my ($oldpath,$newpath,$allow_dir_unlink) = @_; |
901
|
|
|
|
|
|
|
$self->check_perm(scalar $self->path2inode($self->_dirname($oldpath)),W_OK); |
902
|
|
|
|
|
|
|
$self->check_perm(scalar $self->path2inode($self->_dirname($newpath)),W_OK); |
903
|
|
|
|
|
|
|
my $inode = $self->path2inode($oldpath); |
904
|
|
|
|
|
|
|
$self->_isdir($inode) && !$allow_dir_unlink |
905
|
|
|
|
|
|
|
and die "hard links of directories not allowed"; |
906
|
|
|
|
|
|
|
eval { |
907
|
|
|
|
|
|
|
$self->create_path($inode,$newpath); |
908
|
|
|
|
|
|
|
}; |
909
|
|
|
|
|
|
|
if ($@) { |
910
|
|
|
|
|
|
|
die "file exists" if $@ =~ /not unique|duplicate/i; |
911
|
|
|
|
|
|
|
die $@; |
912
|
|
|
|
|
|
|
} |
913
|
|
|
|
|
|
|
1; |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
|
916
|
|
|
|
|
|
|
=head2 $fs->symlink($oldpath,$newpath) |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
Create a soft (symbolic) link from the file at $oldpath to |
919
|
|
|
|
|
|
|
$newpath. If an error occurs the method will die. It is safe to create |
920
|
|
|
|
|
|
|
symlinks that involve directories. |
921
|
|
|
|
|
|
|
|
922
|
|
|
|
|
|
|
=cut |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
sub symlink { |
925
|
|
|
|
|
|
|
my $self = shift; |
926
|
|
|
|
|
|
|
my ($oldpath,$newpath) = @_; |
927
|
|
|
|
|
|
|
eval { |
928
|
|
|
|
|
|
|
my $newnode = $self->create_inode_and_path($newpath,'l',0120777); |
929
|
|
|
|
|
|
|
$self->write($newpath,$oldpath); |
930
|
|
|
|
|
|
|
}; |
931
|
|
|
|
|
|
|
if ($@) { |
932
|
|
|
|
|
|
|
die "file exists" if $@ =~ /not unique|duplicate/i; |
933
|
|
|
|
|
|
|
die $@; |
934
|
|
|
|
|
|
|
} |
935
|
|
|
|
|
|
|
1; |
936
|
|
|
|
|
|
|
} |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
=head2 $path = $fs->readlink($path) |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
Read the symlink at $path and return its target. If an error occurs |
941
|
|
|
|
|
|
|
the method will die. |
942
|
|
|
|
|
|
|
|
943
|
|
|
|
|
|
|
=cut |
944
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
sub readlink { |
946
|
|
|
|
|
|
|
my $self = shift; |
947
|
|
|
|
|
|
|
my $path = shift; |
948
|
|
|
|
|
|
|
my $target = $self->read($path,MAX_PATH_LEN); |
949
|
|
|
|
|
|
|
return $target; |
950
|
|
|
|
|
|
|
} |
951
|
|
|
|
|
|
|
|
952
|
|
|
|
|
|
|
=head2 @entries = $fs->getdir($path) |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
Given a directory in $path, return a list of all entries (files, |
955
|
|
|
|
|
|
|
directories) contained within that directory. The '.' and '..' paths |
956
|
|
|
|
|
|
|
are also always returned. This method checks that the current user has |
957
|
|
|
|
|
|
|
read and execute permissions on the directory, and will raise a |
958
|
|
|
|
|
|
|
permission denied error if not (trap this with an eval{}). |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
Experimental feature: If the directory begins with the magic |
961
|
|
|
|
|
|
|
characters "%%" then getdir will look for a dotfile named ".query" |
962
|
|
|
|
|
|
|
within the directory. ".query" must contain a SQL query that returns a |
963
|
|
|
|
|
|
|
series of one or more inodes. These will be used to populate the |
964
|
|
|
|
|
|
|
directory automagically. The query can span multiple lines, and |
965
|
|
|
|
|
|
|
lines that begin with "#" will be ignored. |
966
|
|
|
|
|
|
|
|
967
|
|
|
|
|
|
|
Here is a simple example which will run on all DBMSs. It displays all |
968
|
|
|
|
|
|
|
files with size greater than 2 Mb: |
969
|
|
|
|
|
|
|
|
970
|
|
|
|
|
|
|
select inode from metadata where size>2000000 |
971
|
|
|
|
|
|
|
|
972
|
|
|
|
|
|
|
Another example, which uses MySQL-specific date/time |
973
|
|
|
|
|
|
|
math to find all .jpg files created/modified within the last day: |
974
|
|
|
|
|
|
|
|
975
|
|
|
|
|
|
|
select m.inode from metadata as m,path as p |
976
|
|
|
|
|
|
|
where p.name like '%.jpg' |
977
|
|
|
|
|
|
|
and (now()-interval 1 day) <= m.mtime |
978
|
|
|
|
|
|
|
and m.inode=p.inode |
979
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
(The date/time math syntax is very slightly different for PostgreSQL |
981
|
|
|
|
|
|
|
and considerably different for SQLite) |
982
|
|
|
|
|
|
|
|
983
|
|
|
|
|
|
|
An example that uses extended attributes to search for all documents |
984
|
|
|
|
|
|
|
authored by someone with "Lincoln" in the name: |
985
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
select m.inode from metadata as m,xattr as x |
987
|
|
|
|
|
|
|
where x.name == 'user.Author' |
988
|
|
|
|
|
|
|
and x.value like 'Lincoln%' |
989
|
|
|
|
|
|
|
and m.inode=x.inode |
990
|
|
|
|
|
|
|
|
991
|
|
|
|
|
|
|
The files contained within the magic directories can be read and |
992
|
|
|
|
|
|
|
written just like normal files, but cannot be removed or |
993
|
|
|
|
|
|
|
renamed. Directories are excluded from magic directories. If two or |
994
|
|
|
|
|
|
|
more files from different parts of the filesystem have name clashes, |
995
|
|
|
|
|
|
|
the filesystem will append a number to their end to distinguish them. |
996
|
|
|
|
|
|
|
|
997
|
|
|
|
|
|
|
If the SQL contains an error, then the error message will be contained |
998
|
|
|
|
|
|
|
within a file named "SQL_ERROR". |
999
|
|
|
|
|
|
|
|
1000
|
|
|
|
|
|
|
=cut |
1001
|
|
|
|
|
|
|
|
1002
|
|
|
|
|
|
|
sub getdir { |
1003
|
|
|
|
|
|
|
my $self = shift; |
1004
|
|
|
|
|
|
|
my $path = shift; |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1007
|
|
|
|
|
|
|
$self->_isdir($inode) or croak "not directory"; |
1008
|
|
|
|
|
|
|
$self->check_perm($inode,X_OK|R_OK); |
1009
|
|
|
|
|
|
|
return $self->_getdir($inode,$path); |
1010
|
|
|
|
|
|
|
} |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
sub _getdir { |
1013
|
|
|
|
|
|
|
my $self = shift; |
1014
|
|
|
|
|
|
|
my ($inode,$path) = @_; |
1015
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1016
|
|
|
|
|
|
|
my $col = $dbh->selectcol_arrayref("select name from path where parent=$inode"); |
1017
|
|
|
|
|
|
|
if ($self->allow_magic_dirs && $self->_is_dynamic_dir($inode,$path)) { |
1018
|
|
|
|
|
|
|
my $dynamic = $self->get_dynamic_entries($inode,$path); |
1019
|
|
|
|
|
|
|
push @$col,keys %$dynamic if $dynamic; |
1020
|
|
|
|
|
|
|
} |
1021
|
|
|
|
|
|
|
return '.','..',@$col; |
1022
|
|
|
|
|
|
|
} |
1023
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
# user has passed a SQL WHERE clause as a directory name |
1025
|
|
|
|
|
|
|
sub _sql_directory { |
1026
|
|
|
|
|
|
|
my $self = shift; |
1027
|
|
|
|
|
|
|
my $path = shift; |
1028
|
|
|
|
|
|
|
(my $where = $path) =~ s/^%(?:where)?//; |
1029
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1030
|
|
|
|
|
|
|
my $names = eval {$dbh->selectcol_arrayref("select name from metadata,path where metadata.inode=path.inode and $where")}; |
1031
|
|
|
|
|
|
|
if ($@) { |
1032
|
|
|
|
|
|
|
my $msg = $@; |
1033
|
|
|
|
|
|
|
$msg =~ s/\s+at.+$//; |
1034
|
|
|
|
|
|
|
$msg =~ s![\n/] !!g; |
1035
|
|
|
|
|
|
|
return ('.','..',$msg); |
1036
|
|
|
|
|
|
|
} |
1037
|
|
|
|
|
|
|
return ('.','..',@$names); |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
|
1040
|
|
|
|
|
|
|
sub get_dynamic_entries { |
1041
|
|
|
|
|
|
|
my $self = shift; |
1042
|
|
|
|
|
|
|
my ($inode,$path) = @_; |
1043
|
|
|
|
|
|
|
|
1044
|
|
|
|
|
|
|
return $self->_get_cached_dynamic_entries($inode,$path) |
1045
|
|
|
|
|
|
|
|| $self->_set_cached_dynamic_entries($inode,$path); |
1046
|
|
|
|
|
|
|
} |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
sub _get_cached_dynamic_entries { |
1049
|
|
|
|
|
|
|
my $self = shift; |
1050
|
|
|
|
|
|
|
my ($inode,$path) = @_; |
1051
|
|
|
|
|
|
|
|
1052
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1053
|
|
|
|
|
|
|
my $query = <
|
1054
|
|
|
|
|
|
|
select inode,name,parent |
1055
|
|
|
|
|
|
|
from dynamic_cache |
1056
|
|
|
|
|
|
|
where directory=? and time>=? |
1057
|
|
|
|
|
|
|
END |
1058
|
|
|
|
|
|
|
; |
1059
|
|
|
|
|
|
|
my (%matches,%seenit); |
1060
|
|
|
|
|
|
|
eval { |
1061
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($query); |
1062
|
|
|
|
|
|
|
$sth->execute($inode,time()-1); # cache time 1s at most |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
while (my ($file_inode,$name,$parent)=$sth->fetchrow_array) { |
1065
|
|
|
|
|
|
|
$name .= '('.($seenit{$name}-1).')' if $seenit{$name}++; |
1066
|
|
|
|
|
|
|
$matches{$name} = [$file_inode,$parent]; |
1067
|
|
|
|
|
|
|
} |
1068
|
|
|
|
|
|
|
}; |
1069
|
|
|
|
|
|
|
return unless %matches; |
1070
|
|
|
|
|
|
|
return \%matches; |
1071
|
|
|
|
|
|
|
} |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
sub _set_cached_dynamic_entries { |
1074
|
|
|
|
|
|
|
my $self = shift; |
1075
|
|
|
|
|
|
|
my ($inode,$path) = @_; |
1076
|
|
|
|
|
|
|
|
1077
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
# create a temporary table to hold the results |
1080
|
|
|
|
|
|
|
$dbh->do(<
|
1081
|
|
|
|
|
|
|
create temporary table if not exists dynamic_cache |
1082
|
|
|
|
|
|
|
(directory integer, |
1083
|
|
|
|
|
|
|
time integer, |
1084
|
|
|
|
|
|
|
inode integer, |
1085
|
|
|
|
|
|
|
name varchar(255), |
1086
|
|
|
|
|
|
|
parent integer) |
1087
|
|
|
|
|
|
|
END |
1088
|
|
|
|
|
|
|
; |
1089
|
|
|
|
|
|
|
|
1090
|
|
|
|
|
|
|
$dbh->do("delete from dynamic_cache where directory=$inode"); |
1091
|
|
|
|
|
|
|
|
1092
|
|
|
|
|
|
|
# look for a file named .query |
1093
|
|
|
|
|
|
|
my ($query_inode) = |
1094
|
|
|
|
|
|
|
$dbh->selectrow_array("select inode from path where name='.query' and parent=$inode"); |
1095
|
|
|
|
|
|
|
return unless $query_inode; |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
# fetch the query |
1098
|
|
|
|
|
|
|
my $sql = $self->read(undef,4096,0,$query_inode) or return; |
1099
|
|
|
|
|
|
|
$sql =~ s/#.+\n//g; |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
# run the query |
1102
|
|
|
|
|
|
|
my $isdir = 0x4000; |
1103
|
|
|
|
|
|
|
my $query = <
|
1104
|
|
|
|
|
|
|
insert into dynamic_cache (directory,time,inode,name,parent) |
1105
|
|
|
|
|
|
|
select ?,?,p.inode,p.name,p.parent |
1106
|
|
|
|
|
|
|
from path as p,metadata as m |
1107
|
|
|
|
|
|
|
where p.inode=m.inode |
1108
|
|
|
|
|
|
|
and ($isdir&m.mode)=0 |
1109
|
|
|
|
|
|
|
and p.inode in ($sql) |
1110
|
|
|
|
|
|
|
END |
1111
|
|
|
|
|
|
|
;; |
1112
|
|
|
|
|
|
|
my $sth; |
1113
|
|
|
|
|
|
|
eval { |
1114
|
|
|
|
|
|
|
$sth = $dbh->prepare($query); |
1115
|
|
|
|
|
|
|
$sth->execute($inode,time()); |
1116
|
|
|
|
|
|
|
}; |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
my $error_file = "$path/SQL_ERROR"; |
1119
|
|
|
|
|
|
|
if ($@) { |
1120
|
|
|
|
|
|
|
my $msg = $@; |
1121
|
|
|
|
|
|
|
eval { |
1122
|
|
|
|
|
|
|
my ($i) = eval {$self->_path2inode($error_file)}; |
1123
|
|
|
|
|
|
|
$i ||= $self->mknod($error_file,0444,0); |
1124
|
|
|
|
|
|
|
$self->ftruncate($error_file,0,$i); |
1125
|
|
|
|
|
|
|
$self->write($error_file,$msg,0,$i); |
1126
|
|
|
|
|
|
|
}; |
1127
|
|
|
|
|
|
|
warn $@ if $@; |
1128
|
|
|
|
|
|
|
return; |
1129
|
|
|
|
|
|
|
} else { |
1130
|
|
|
|
|
|
|
eval{ |
1131
|
|
|
|
|
|
|
$self->unlink($error_file) if $self->_path2inode($error_file); |
1132
|
|
|
|
|
|
|
}; |
1133
|
|
|
|
|
|
|
} |
1134
|
|
|
|
|
|
|
$sth->finish; |
1135
|
|
|
|
|
|
|
return $self->_get_cached_dynamic_entries($inode,$path); |
1136
|
|
|
|
|
|
|
} |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
=head2 $boolean = $fs->isdir($path) |
1139
|
|
|
|
|
|
|
|
1140
|
|
|
|
|
|
|
Convenience method. Returns true if the path corresponds to a |
1141
|
|
|
|
|
|
|
directory. May raise a fatal error if the provided path is invalid. |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
=cut |
1144
|
|
|
|
|
|
|
|
1145
|
|
|
|
|
|
|
sub isdir { |
1146
|
|
|
|
|
|
|
my $self = shift; |
1147
|
|
|
|
|
|
|
my $path = shift; |
1148
|
|
|
|
|
|
|
my $inode = $self->path2inode($path) ; |
1149
|
|
|
|
|
|
|
return $self->_isdir($inode); |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
|
1152
|
|
|
|
|
|
|
sub _isdir { |
1153
|
|
|
|
|
|
|
my $self = shift; |
1154
|
|
|
|
|
|
|
my $inode = shift; |
1155
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1156
|
|
|
|
|
|
|
my $mask = 0xf000; |
1157
|
|
|
|
|
|
|
my $isdir = 0x4000; |
1158
|
|
|
|
|
|
|
my ($result) = $dbh->selectrow_array("select ($mask&mode)=$isdir from metadata where inode=$inode") |
1159
|
|
|
|
|
|
|
or die $dbh->errstr; |
1160
|
|
|
|
|
|
|
return $result; |
1161
|
|
|
|
|
|
|
} |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
sub _is_dynamic_dir { |
1164
|
|
|
|
|
|
|
my $self = shift; |
1165
|
|
|
|
|
|
|
my ($inode,$path) = @_; |
1166
|
|
|
|
|
|
|
return unless $path; |
1167
|
|
|
|
|
|
|
return $path =~ m!(?:^|/)%%[^/]+$! && $self->_isdir($inode) |
1168
|
|
|
|
|
|
|
} |
1169
|
|
|
|
|
|
|
|
1170
|
|
|
|
|
|
|
=head2 $fs->chown($path,$uid,$gid) |
1171
|
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
|
This method changes the user and group ids for the indicated path. It |
1173
|
|
|
|
|
|
|
raises a fatal exception on errors. |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
=cut |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
sub chown { |
1178
|
|
|
|
|
|
|
my $self = shift; |
1179
|
|
|
|
|
|
|
my ($path,$uid,$gid) = @_; |
1180
|
|
|
|
|
|
|
my $inode = $self->path2inode($path) ; |
1181
|
|
|
|
|
|
|
|
1182
|
|
|
|
|
|
|
# permission checking here |
1183
|
|
|
|
|
|
|
unless ($self->ignore_permissions) { |
1184
|
|
|
|
|
|
|
my $ctx = $self->get_context; |
1185
|
|
|
|
|
|
|
die "permission denied" unless $uid == 0xffffffff || $ctx->{uid} == 0 || $ctx->{uid}==$uid; |
1186
|
|
|
|
|
|
|
|
1187
|
|
|
|
|
|
|
my $groups = $self->get_groups(@{$ctx}{'uid','gid'}); |
1188
|
|
|
|
|
|
|
die "permission denied" unless $gid == 0xffffffff || $ctx->{uid} == 0 || $ctx->{gid}==$gid || $groups->{$gid}; |
1189
|
|
|
|
|
|
|
} |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1192
|
|
|
|
|
|
|
eval { |
1193
|
|
|
|
|
|
|
$dbh->begin_work(); |
1194
|
|
|
|
|
|
|
$dbh->do("update metadata set uid=$uid where inode=$inode") if $uid!=0xffffffff; |
1195
|
|
|
|
|
|
|
$dbh->do("update metadata set gid=$gid where inode=$inode") if $gid!=0xffffffff; |
1196
|
|
|
|
|
|
|
$self->touch($inode,'ctime'); |
1197
|
|
|
|
|
|
|
$dbh->commit(); |
1198
|
|
|
|
|
|
|
}; |
1199
|
|
|
|
|
|
|
if ($@) { |
1200
|
|
|
|
|
|
|
eval {$dbh->rollback()}; |
1201
|
|
|
|
|
|
|
die "update aborted due to $@"; |
1202
|
|
|
|
|
|
|
} |
1203
|
|
|
|
|
|
|
1; |
1204
|
|
|
|
|
|
|
} |
1205
|
|
|
|
|
|
|
|
1206
|
|
|
|
|
|
|
=head2 $fs->chmod($path,$mode) |
1207
|
|
|
|
|
|
|
|
1208
|
|
|
|
|
|
|
This method changes the access mode for the file or directory at the |
1209
|
|
|
|
|
|
|
indicated path. The mode in this case is just the three octal word |
1210
|
|
|
|
|
|
|
access mode, not the combination of access mode and path type used in |
1211
|
|
|
|
|
|
|
mknod(). |
1212
|
|
|
|
|
|
|
|
1213
|
|
|
|
|
|
|
=cut |
1214
|
|
|
|
|
|
|
|
1215
|
|
|
|
|
|
|
sub chmod { |
1216
|
|
|
|
|
|
|
my $self = shift; |
1217
|
|
|
|
|
|
|
my ($path,$mode) = @_; |
1218
|
|
|
|
|
|
|
my $inode = $self->path2inode($path) ; |
1219
|
|
|
|
|
|
|
$self->check_perm($inode,F_OK); |
1220
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1221
|
|
|
|
|
|
|
my $f000 = 0xf000; |
1222
|
|
|
|
|
|
|
my $now = $self->_now_sql; |
1223
|
|
|
|
|
|
|
return $dbh->do("update metadata set mode=(($f000&mode)|$mode),ctime=$now where inode=$inode"); |
1224
|
|
|
|
|
|
|
} |
1225
|
|
|
|
|
|
|
|
1226
|
|
|
|
|
|
|
=head2 @stat = $fs->fgetattr($path,$inode) |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
Return the 13-element file attribute list returned by Perl's stat() |
1229
|
|
|
|
|
|
|
function, describing an existing file or directory. You may pass the |
1230
|
|
|
|
|
|
|
path, and/or the inode of the file/directory. If both are passed, then |
1231
|
|
|
|
|
|
|
the inode takes precedence. |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
The returned list will contain: |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
0 dev device number of filesystem |
1236
|
|
|
|
|
|
|
1 ino inode number |
1237
|
|
|
|
|
|
|
2 mode file mode (type and permissions) |
1238
|
|
|
|
|
|
|
3 nlink number of (hard) links to the file |
1239
|
|
|
|
|
|
|
4 uid numeric user ID of file's owner |
1240
|
|
|
|
|
|
|
5 gid numeric group ID of file's owner |
1241
|
|
|
|
|
|
|
6 rdev the device identifier (special files only) |
1242
|
|
|
|
|
|
|
7 size total size of file, in bytes |
1243
|
|
|
|
|
|
|
8 atime last access time in seconds since the epoch |
1244
|
|
|
|
|
|
|
9 mtime last modify time in seconds since the epoch |
1245
|
|
|
|
|
|
|
10 ctime inode change time in seconds since the epoch (*) |
1246
|
|
|
|
|
|
|
11 blksize preferred block size for file system I/O |
1247
|
|
|
|
|
|
|
12 blocks actual number of blocks allocated |
1248
|
|
|
|
|
|
|
|
1249
|
|
|
|
|
|
|
=cut |
1250
|
|
|
|
|
|
|
|
1251
|
|
|
|
|
|
|
sub fgetattr { |
1252
|
|
|
|
|
|
|
my $self = shift; |
1253
|
|
|
|
|
|
|
my ($path,$inode) = @_; |
1254
|
|
|
|
|
|
|
$inode ||= $self->path2inode($path); |
1255
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1256
|
|
|
|
|
|
|
my ($ino,$mode,$uid,$gid,$rdev,$nlinks,$ctime,$mtime,$atime,$size) = |
1257
|
|
|
|
|
|
|
$dbh->selectrow_array($self->_fgetattr_sql($inode)); |
1258
|
|
|
|
|
|
|
$ino or die 'not found'; |
1259
|
|
|
|
|
|
|
|
1260
|
|
|
|
|
|
|
# make sure write buffer contributes |
1261
|
|
|
|
|
|
|
if (my $blocks = $Blockbuff{$inode}) { |
1262
|
|
|
|
|
|
|
lock $blocks; |
1263
|
|
|
|
|
|
|
if (keys %$blocks) { |
1264
|
|
|
|
|
|
|
my ($biggest) = sort {$b<=>$a} keys %$blocks; |
1265
|
|
|
|
|
|
|
my $offset = $self->blocksize * $biggest + length $blocks->{$biggest}; |
1266
|
|
|
|
|
|
|
$size = $offset if $offset > $size; |
1267
|
|
|
|
|
|
|
} |
1268
|
|
|
|
|
|
|
} |
1269
|
|
|
|
|
|
|
|
1270
|
|
|
|
|
|
|
my $dev = 0; |
1271
|
|
|
|
|
|
|
my $blocks = 1; |
1272
|
|
|
|
|
|
|
my $blksize = $self->blocksize; |
1273
|
|
|
|
|
|
|
return ($dev,$ino,$mode,$nlinks,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks); |
1274
|
|
|
|
|
|
|
} |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=head2 @stat = $fs->getattr($path) |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
Similar to fgetattr() but only the path is accepted. |
1279
|
|
|
|
|
|
|
|
1280
|
|
|
|
|
|
|
=cut |
1281
|
|
|
|
|
|
|
|
1282
|
|
|
|
|
|
|
sub getattr { |
1283
|
|
|
|
|
|
|
my $self = shift; |
1284
|
|
|
|
|
|
|
my $path = shift; |
1285
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1286
|
|
|
|
|
|
|
return $self->fgetattr($path,$inode); |
1287
|
|
|
|
|
|
|
} |
1288
|
|
|
|
|
|
|
|
1289
|
|
|
|
|
|
|
=head2 $inode = $fs->open($path,$flags,$info) |
1290
|
|
|
|
|
|
|
|
1291
|
|
|
|
|
|
|
Open the file at $path and return its inode. $flags are a bitwise |
1292
|
|
|
|
|
|
|
OR-ing of the access mode constants including O_RDONLY, O_WRONLY, |
1293
|
|
|
|
|
|
|
O_RDWR, O_CREAT, and $info is a hash reference containing flags from |
1294
|
|
|
|
|
|
|
the Fuse module. The latter is currently ignored. |
1295
|
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
|
This method checks read/write permissions on the file and containing |
1297
|
|
|
|
|
|
|
directories, unless ignore_permissions is set to true. The open method |
1298
|
|
|
|
|
|
|
also increments the file's inuse counter, ensuring that even if it is |
1299
|
|
|
|
|
|
|
unlinked, its contents will not be removed until the last open |
1300
|
|
|
|
|
|
|
filehandle is closed. |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
The flag constants can be obtained from POSIX. |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
=cut |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
sub open { |
1307
|
|
|
|
|
|
|
my $self = shift; |
1308
|
|
|
|
|
|
|
my ($path,$flags,$info) = @_; |
1309
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1310
|
|
|
|
|
|
|
$self->check_open_perm($inode,$flags); |
1311
|
|
|
|
|
|
|
$self->dbh->do("update metadata set inuse=inuse+1 where inode=$inode"); |
1312
|
|
|
|
|
|
|
return $inode; |
1313
|
|
|
|
|
|
|
} |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
=head2 $fh->release($inode) |
1316
|
|
|
|
|
|
|
|
1317
|
|
|
|
|
|
|
Release a file previously opened with open(), decrementing its inuse |
1318
|
|
|
|
|
|
|
count. Be careful to balance calls to open() with release(), or the |
1319
|
|
|
|
|
|
|
file will have an inconsistent use count. |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
=cut |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
sub release { |
1324
|
|
|
|
|
|
|
my ($self,$inode) = @_; |
1325
|
|
|
|
|
|
|
$self->flush(undef,$inode); # write cached blocks |
1326
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1327
|
|
|
|
|
|
|
$dbh->do("update metadata set inuse=inuse-1 where inode=$inode"); |
1328
|
|
|
|
|
|
|
$self->unlink_inode($inode); |
1329
|
|
|
|
|
|
|
return 0; |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
=head2 $data = $fs->read($path,$length,$offset,$inode) |
1334
|
|
|
|
|
|
|
|
1335
|
|
|
|
|
|
|
Read $length bytes of data from the file at $path, starting at |
1336
|
|
|
|
|
|
|
position $offset. You may optionally pass an inode to the method to |
1337
|
|
|
|
|
|
|
read from a previously-opened file. |
1338
|
|
|
|
|
|
|
|
1339
|
|
|
|
|
|
|
On success, the requested data will be returned. Otherwise a fatal |
1340
|
|
|
|
|
|
|
exception will be raised (which can be trapped with an eval{}). |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
Note that you do not need to open the file before reading from |
1343
|
|
|
|
|
|
|
it. Permission checking is not performed in this call, but in the |
1344
|
|
|
|
|
|
|
(optional) open() call. |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
=cut |
1347
|
|
|
|
|
|
|
|
1348
|
|
|
|
|
|
|
sub read { |
1349
|
|
|
|
|
|
|
my $self = shift; |
1350
|
|
|
|
|
|
|
my ($path,$length,$offset,$inode) = @_; |
1351
|
|
|
|
|
|
|
|
1352
|
|
|
|
|
|
|
$inode || defined $path or croak "no path or inode provided"; |
1353
|
|
|
|
|
|
|
|
1354
|
|
|
|
|
|
|
unless ($inode) { |
1355
|
|
|
|
|
|
|
$inode = $self->path2inode($path); |
1356
|
|
|
|
|
|
|
$self->_isdir($inode) and croak "$path is a directory"; |
1357
|
|
|
|
|
|
|
} |
1358
|
|
|
|
|
|
|
$offset ||= 0; |
1359
|
|
|
|
|
|
|
|
1360
|
|
|
|
|
|
|
my $blksize = $self->blocksize; |
1361
|
|
|
|
|
|
|
my $first_block = int($offset / $blksize); |
1362
|
|
|
|
|
|
|
my $last_block = int(($offset+$length) / $blksize); |
1363
|
|
|
|
|
|
|
my $start = $offset % $blksize; |
1364
|
|
|
|
|
|
|
|
1365
|
|
|
|
|
|
|
$self->flush(undef,$inode); |
1366
|
|
|
|
|
|
|
my $get_atime = $self->_get_unix_timestamp_sql('atime'); |
1367
|
|
|
|
|
|
|
my $get_mtime = $self->_get_unix_timestamp_sql('mtime'); |
1368
|
|
|
|
|
|
|
my ($current_length,$atime,$mtime) = |
1369
|
|
|
|
|
|
|
$self->dbh->selectrow_array("select size,$get_atime,$get_mtime from metadata where inode=$inode"); |
1370
|
|
|
|
|
|
|
if ($length+$offset > $current_length) { |
1371
|
|
|
|
|
|
|
$length = $current_length - $offset; |
1372
|
|
|
|
|
|
|
} |
1373
|
|
|
|
|
|
|
my $data = $self->_read_direct($inode,$start,$length,$first_block,$last_block); |
1374
|
|
|
|
|
|
|
$self->touch($inode,'atime') if length $data && $atime < $mtime; |
1375
|
|
|
|
|
|
|
return $data; |
1376
|
|
|
|
|
|
|
} |
1377
|
|
|
|
|
|
|
|
1378
|
|
|
|
|
|
|
=head2 $bytes = $fs->write($path,$data,$offset,$inode) |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
Write the data provided in $data into the file at $path, starting at |
1381
|
|
|
|
|
|
|
position $offset. You may optionally pass an inode to the method to |
1382
|
|
|
|
|
|
|
read from a previously-opened file. |
1383
|
|
|
|
|
|
|
|
1384
|
|
|
|
|
|
|
On success, the number of bytes written will be returned. Otherwise a fatal |
1385
|
|
|
|
|
|
|
exception will be raised (which can be trapped with an eval{}). |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
Note that the file does not previously need to have been opened in |
1388
|
|
|
|
|
|
|
order to write to it, and permission checking is not performed at this |
1389
|
|
|
|
|
|
|
level. This checking is performed in the (optional) open() call. |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
=cut |
1392
|
|
|
|
|
|
|
|
1393
|
|
|
|
|
|
|
sub write { |
1394
|
|
|
|
|
|
|
my $self = shift; |
1395
|
|
|
|
|
|
|
my ($path,$data,$offset,$inode) = @_; |
1396
|
|
|
|
|
|
|
$inode || defined $path or croak "no path or inode provided"; |
1397
|
|
|
|
|
|
|
|
1398
|
|
|
|
|
|
|
unless ($inode) { |
1399
|
|
|
|
|
|
|
$inode = $self->path2inode($path); |
1400
|
|
|
|
|
|
|
$self->_isdir($inode) and croak "$path is a directory"; |
1401
|
|
|
|
|
|
|
} |
1402
|
|
|
|
|
|
|
$offset ||= 0; |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
my $blksize = $self->blocksize; |
1405
|
|
|
|
|
|
|
my $first_block = int($offset / $blksize); |
1406
|
|
|
|
|
|
|
my $start = $offset % $blksize; |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
my $block = $first_block; |
1409
|
|
|
|
|
|
|
my $bytes_to_write = length $data; |
1410
|
|
|
|
|
|
|
my $bytes_written = 0; |
1411
|
|
|
|
|
|
|
unless ($Blockbuff{$inode}) { |
1412
|
|
|
|
|
|
|
my %hash; |
1413
|
|
|
|
|
|
|
$Blockbuff{$inode}=share(%hash); |
1414
|
|
|
|
|
|
|
} |
1415
|
|
|
|
|
|
|
my $blocks = $Blockbuff{$inode}; # blockno=>data |
1416
|
|
|
|
|
|
|
lock $blocks; |
1417
|
|
|
|
|
|
|
|
1418
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1419
|
|
|
|
|
|
|
while ($bytes_to_write > 0) { |
1420
|
|
|
|
|
|
|
my $bytes = $blksize > ($bytes_to_write+$start) ? $bytes_to_write : ($blksize-$start); |
1421
|
|
|
|
|
|
|
my $current_length = length($blocks->{$block}||''); |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
if ($bytes < $blksize && !$current_length) { # partial block replacement, and not currently cached |
1424
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('select contents,length(contents) from extents where inode=? and block=?'); |
1425
|
|
|
|
|
|
|
$sth->execute($inode,$block); |
1426
|
|
|
|
|
|
|
($blocks->{$block},$current_length) = $sth->fetchrow_array(); |
1427
|
|
|
|
|
|
|
$current_length ||= 0; |
1428
|
|
|
|
|
|
|
$sth->finish; |
1429
|
|
|
|
|
|
|
} |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
if ($start > $current_length) { # hole in current block |
1432
|
|
|
|
|
|
|
my $padding = "\0" x ($start-$current_length); |
1433
|
|
|
|
|
|
|
$padding ||= ''; |
1434
|
|
|
|
|
|
|
$blocks->{$block} .= $padding; |
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
if ($blocks->{$block}) { |
1438
|
|
|
|
|
|
|
substr($blocks->{$block},$start,$bytes,substr($data,$bytes_written,$bytes)); |
1439
|
|
|
|
|
|
|
} else { |
1440
|
|
|
|
|
|
|
$blocks->{$block} = substr($data,$bytes_written,$bytes); |
1441
|
|
|
|
|
|
|
} |
1442
|
|
|
|
|
|
|
|
1443
|
|
|
|
|
|
|
$start = 0; # no more offsets |
1444
|
|
|
|
|
|
|
$block++; |
1445
|
|
|
|
|
|
|
$bytes_written += $bytes; |
1446
|
|
|
|
|
|
|
$bytes_to_write -= $bytes; |
1447
|
|
|
|
|
|
|
} |
1448
|
|
|
|
|
|
|
$self->flush(undef,$inode) if keys %$blocks > $self->flushblocks; |
1449
|
|
|
|
|
|
|
return $bytes_written; |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
sub _write_blocks { |
1453
|
|
|
|
|
|
|
my $self = shift; |
1454
|
|
|
|
|
|
|
my ($inode,$blocks,$blksize) = @_; |
1455
|
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1457
|
|
|
|
|
|
|
my ($length) = $dbh->selectrow_array("select size from metadata where inode=$inode"); |
1458
|
|
|
|
|
|
|
my $hwm = $length; # high water mark ;-) |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
eval { |
1461
|
|
|
|
|
|
|
$dbh->begin_work; |
1462
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached(<errstr; |
1463
|
|
|
|
|
|
|
replace into extents (inode,block,contents) values (?,?,?) |
1464
|
|
|
|
|
|
|
END |
1465
|
|
|
|
|
|
|
; |
1466
|
|
|
|
|
|
|
for my $block (keys %$blocks) { |
1467
|
|
|
|
|
|
|
my $data = $blocks->{$block}; |
1468
|
|
|
|
|
|
|
$sth->execute($inode,$block,$data); |
1469
|
|
|
|
|
|
|
my $a = $block * $blksize + length($data); |
1470
|
|
|
|
|
|
|
$hwm = $a if $a > $hwm; |
1471
|
|
|
|
|
|
|
} |
1472
|
|
|
|
|
|
|
$sth->finish; |
1473
|
|
|
|
|
|
|
my $now = $self->_now_sql; |
1474
|
|
|
|
|
|
|
$dbh->do("update metadata set size=$hwm,mtime=$now where inode=$inode"); |
1475
|
|
|
|
|
|
|
$dbh->commit(); |
1476
|
|
|
|
|
|
|
}; |
1477
|
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
|
if ($@) { |
1479
|
|
|
|
|
|
|
my $msg = $@; |
1480
|
|
|
|
|
|
|
eval{$dbh->rollback()}; |
1481
|
|
|
|
|
|
|
warn $msg; |
1482
|
|
|
|
|
|
|
die "write failed with $msg"; |
1483
|
|
|
|
|
|
|
return; |
1484
|
|
|
|
|
|
|
} |
1485
|
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
1; |
1487
|
|
|
|
|
|
|
} |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
=head2 $fs->flush( [$path,[$inode]] ) |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
Before data is written to the database, it is cached for a while in |
1492
|
|
|
|
|
|
|
memory. flush() will force data to be written to the database. You may |
1493
|
|
|
|
|
|
|
pass no arguments, in which case all cached data will be written, or |
1494
|
|
|
|
|
|
|
you may provide the path and/or inode to an existing file to flush |
1495
|
|
|
|
|
|
|
just the unwritten data associated with that file. |
1496
|
|
|
|
|
|
|
|
1497
|
|
|
|
|
|
|
=cut |
1498
|
|
|
|
|
|
|
|
1499
|
|
|
|
|
|
|
sub flush { |
1500
|
|
|
|
|
|
|
my $self = shift; |
1501
|
|
|
|
|
|
|
my ($path,$inode) = @_; |
1502
|
|
|
|
|
|
|
|
1503
|
|
|
|
|
|
|
$inode ||= $self->path2inode($path) if $path; |
1504
|
|
|
|
|
|
|
|
1505
|
|
|
|
|
|
|
# if called with no inode, then recursively call ourselves |
1506
|
|
|
|
|
|
|
# to flush all cached inodes |
1507
|
|
|
|
|
|
|
unless ($inode) { |
1508
|
|
|
|
|
|
|
for my $i (keys %Blockbuff) { |
1509
|
|
|
|
|
|
|
$self->flush(undef,$i); |
1510
|
|
|
|
|
|
|
} |
1511
|
|
|
|
|
|
|
return; |
1512
|
|
|
|
|
|
|
} |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
my $blocks = $Blockbuff{$inode} or return; |
1515
|
|
|
|
|
|
|
my $blksize = $self->blocksize; |
1516
|
|
|
|
|
|
|
|
1517
|
|
|
|
|
|
|
lock $blocks; |
1518
|
|
|
|
|
|
|
my $result = $self->_write_blocks($inode,$blocks,$blksize) or die "flush failed"; |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
delete $Blockbuff{$inode}; |
1521
|
|
|
|
|
|
|
} |
1522
|
|
|
|
|
|
|
|
1523
|
|
|
|
|
|
|
# This type of read is invoked when there is no write buffer for |
1524
|
|
|
|
|
|
|
# the file. It executes a single SQL query across the data table. |
1525
|
|
|
|
|
|
|
sub _read_direct { |
1526
|
|
|
|
|
|
|
my $self = shift; |
1527
|
|
|
|
|
|
|
my ($inode,$start,$length,$first_block,$last_block) = @_; |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1530
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached(<
|
1531
|
|
|
|
|
|
|
select block,contents |
1532
|
|
|
|
|
|
|
from extents where inode=? |
1533
|
|
|
|
|
|
|
and block between ? and ? |
1534
|
|
|
|
|
|
|
order by block |
1535
|
|
|
|
|
|
|
END |
1536
|
|
|
|
|
|
|
; |
1537
|
|
|
|
|
|
|
$sth->execute($inode,$first_block,$last_block); |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
my $blksize = $self->blocksize; |
1540
|
|
|
|
|
|
|
my $previous_block; |
1541
|
|
|
|
|
|
|
my $data = ''; |
1542
|
|
|
|
|
|
|
while (my ($block,$contents) = $sth->fetchrow_array) { |
1543
|
|
|
|
|
|
|
$previous_block = $block unless defined $previous_block; |
1544
|
|
|
|
|
|
|
# a hole spanning an entire block |
1545
|
|
|
|
|
|
|
if ($block - $previous_block > 1) { |
1546
|
|
|
|
|
|
|
$data .= "\0"x($blksize*($block-$previous_block-1)); |
1547
|
|
|
|
|
|
|
} |
1548
|
|
|
|
|
|
|
$previous_block = $block; |
1549
|
|
|
|
|
|
|
|
1550
|
|
|
|
|
|
|
# a hole spanning a portion of a block |
1551
|
|
|
|
|
|
|
if (length $contents < $blksize && $block < $last_block) { |
1552
|
|
|
|
|
|
|
$contents .= "\0"x($blksize-length($contents)); # this is a hole! |
1553
|
|
|
|
|
|
|
} |
1554
|
|
|
|
|
|
|
$data .= substr($contents,$start,$length); |
1555
|
|
|
|
|
|
|
$length -= $blksize; |
1556
|
|
|
|
|
|
|
$start = 0; |
1557
|
|
|
|
|
|
|
} |
1558
|
|
|
|
|
|
|
$sth->finish(); |
1559
|
|
|
|
|
|
|
return $data; |
1560
|
|
|
|
|
|
|
} |
1561
|
|
|
|
|
|
|
|
1562
|
|
|
|
|
|
|
=head2 $fs->truncate($path,$length) |
1563
|
|
|
|
|
|
|
|
1564
|
|
|
|
|
|
|
Shorten the contents of the file located at $path to the length |
1565
|
|
|
|
|
|
|
indicated by $length. |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
=cut |
1568
|
|
|
|
|
|
|
|
1569
|
|
|
|
|
|
|
sub truncate { |
1570
|
|
|
|
|
|
|
my $self = shift; |
1571
|
|
|
|
|
|
|
my ($path,$length) = @_; |
1572
|
|
|
|
|
|
|
$self->ftruncate($path,$length); |
1573
|
|
|
|
|
|
|
} |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
=head2 $fs->ftruncate($path,$length,$inode) |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
Like truncate() but you may provide the inode instead of the path. |
1578
|
|
|
|
|
|
|
This is called by Fuse to truncate an open file. |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
=cut |
1581
|
|
|
|
|
|
|
|
1582
|
|
|
|
|
|
|
sub ftruncate { |
1583
|
|
|
|
|
|
|
my $self = shift; |
1584
|
|
|
|
|
|
|
my ($path,$length,$inode) = @_; |
1585
|
|
|
|
|
|
|
|
1586
|
|
|
|
|
|
|
$inode ||= $self->path2inode($path); |
1587
|
|
|
|
|
|
|
$self->_isdir($inode) and croak "$path is a directory"; |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1590
|
|
|
|
|
|
|
$length ||= 0; |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
# check that length isn't greater than current position |
1593
|
|
|
|
|
|
|
my @stat = $self->getattr($path); |
1594
|
|
|
|
|
|
|
$stat[7] >= $length or croak "length beyond end of file"; |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
my $last_block = int($length/$self->blocksize); |
1597
|
|
|
|
|
|
|
my $trunc = $length % $self->blocksize; |
1598
|
|
|
|
|
|
|
eval { |
1599
|
|
|
|
|
|
|
$dbh->begin_work; |
1600
|
|
|
|
|
|
|
$dbh->do("delete from extents where inode=$inode and block>$last_block"); |
1601
|
|
|
|
|
|
|
$dbh->do("update extents set contents=substr(contents,1,$trunc) where inode=$inode and block=$last_block"); |
1602
|
|
|
|
|
|
|
$dbh->do("update metadata set size=$length where inode=$inode"); |
1603
|
|
|
|
|
|
|
$self->touch($inode,'mtime'); |
1604
|
|
|
|
|
|
|
$dbh->commit; |
1605
|
|
|
|
|
|
|
}; |
1606
|
|
|
|
|
|
|
if ($@) { |
1607
|
|
|
|
|
|
|
eval {$dbh->rollback()}; |
1608
|
|
|
|
|
|
|
die "Couldn't update because $@"; |
1609
|
|
|
|
|
|
|
} |
1610
|
|
|
|
|
|
|
1; |
1611
|
|
|
|
|
|
|
} |
1612
|
|
|
|
|
|
|
|
1613
|
|
|
|
|
|
|
=head2 $fs->utime($path,$atime,$mtime) |
1614
|
|
|
|
|
|
|
|
1615
|
|
|
|
|
|
|
Update the atime and mtime of the indicated file or directory to the |
1616
|
|
|
|
|
|
|
values provided. You must have write permissions to the file in order |
1617
|
|
|
|
|
|
|
to do this. |
1618
|
|
|
|
|
|
|
|
1619
|
|
|
|
|
|
|
=cut |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
sub utime { |
1622
|
|
|
|
|
|
|
my $self = shift; |
1623
|
|
|
|
|
|
|
my ($path,$atime,$mtime) = @_; |
1624
|
|
|
|
|
|
|
my $inode = $self->path2inode($path) ; |
1625
|
|
|
|
|
|
|
$self->check_perm($inode,W_OK); |
1626
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1627
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($self->_update_utime_sql); |
1628
|
|
|
|
|
|
|
my $result = $sth->execute($atime,$mtime,$inode); |
1629
|
|
|
|
|
|
|
$sth->finish(); |
1630
|
|
|
|
|
|
|
return $result; |
1631
|
|
|
|
|
|
|
} |
1632
|
|
|
|
|
|
|
|
1633
|
|
|
|
|
|
|
=head2 $fs->access($path,$access_mode) |
1634
|
|
|
|
|
|
|
|
1635
|
|
|
|
|
|
|
This method checks the current user's permissions for a file or |
1636
|
|
|
|
|
|
|
directory. The arguments are the path to the item of interest, and the |
1637
|
|
|
|
|
|
|
mode is one of the following constants: |
1638
|
|
|
|
|
|
|
|
1639
|
|
|
|
|
|
|
F_OK check for existence of file |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
or a bitwise OR of one or more of: |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
R_OK check that the file can be read |
1644
|
|
|
|
|
|
|
W_OK check that the file can be written to |
1645
|
|
|
|
|
|
|
X_OK check that the file is executable |
1646
|
|
|
|
|
|
|
|
1647
|
|
|
|
|
|
|
These constants can be obtained from the POSIX module. |
1648
|
|
|
|
|
|
|
|
1649
|
|
|
|
|
|
|
=cut |
1650
|
|
|
|
|
|
|
|
1651
|
|
|
|
|
|
|
sub access { |
1652
|
|
|
|
|
|
|
my $self = shift; |
1653
|
|
|
|
|
|
|
my ($path,$access_mode) = @_; |
1654
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1655
|
|
|
|
|
|
|
return $self->check_perm($inode,$access_mode); |
1656
|
|
|
|
|
|
|
} |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
sub check_open_perm { |
1659
|
|
|
|
|
|
|
my $self = shift; |
1660
|
|
|
|
|
|
|
my ($inode,$flags) = @_; |
1661
|
|
|
|
|
|
|
$flags &= 0x3; |
1662
|
|
|
|
|
|
|
my $wants_read = $flags==O_RDONLY || $flags==O_RDWR; |
1663
|
|
|
|
|
|
|
my $wants_write = $flags==O_WRONLY || $flags==O_RDWR; |
1664
|
|
|
|
|
|
|
my $mask = 0000; |
1665
|
|
|
|
|
|
|
$mask |= R_OK if $wants_read; |
1666
|
|
|
|
|
|
|
$mask |= W_OK if $wants_write; |
1667
|
|
|
|
|
|
|
return $self->check_perm($inode,$mask); |
1668
|
|
|
|
|
|
|
} |
1669
|
|
|
|
|
|
|
|
1670
|
|
|
|
|
|
|
=head2 $errno = $fs->errno($message) |
1671
|
|
|
|
|
|
|
|
1672
|
|
|
|
|
|
|
Most methods defined by this module are called within an eval{} to |
1673
|
|
|
|
|
|
|
trap errors. On an error, the message contained in $@ is passed to |
1674
|
|
|
|
|
|
|
errno() to turn it into a UNIX error code. The error code is then |
1675
|
|
|
|
|
|
|
returned to the Fuse module. |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
The following is the limited set of mappings performed: |
1678
|
|
|
|
|
|
|
|
1679
|
|
|
|
|
|
|
Eval{} error message Unix Errno Context |
1680
|
|
|
|
|
|
|
-------------------- ---------- ------- |
1681
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
not found ENOENT Path lookups |
1683
|
|
|
|
|
|
|
file exists EEXIST Path creation |
1684
|
|
|
|
|
|
|
is a directory EISDIR Attempt to open/read/write a directory |
1685
|
|
|
|
|
|
|
not a directory ENOTDIR Attempt to list entries from a file |
1686
|
|
|
|
|
|
|
length beyond end of file EINVAL Truncate file to longer than current length |
1687
|
|
|
|
|
|
|
not empty ENOTEMPTY Attempt to remove a directory that is in use |
1688
|
|
|
|
|
|
|
permission denied EACCESS Access modes don't allow requested operation |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
The full error message usually has further detailed information. For |
1691
|
|
|
|
|
|
|
example the full error message for "not found" is "$path not found" |
1692
|
|
|
|
|
|
|
where $path contains the requested path. |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
All other errors, including problems in the underlying DBI database |
1695
|
|
|
|
|
|
|
layer, result in an error code of EIO ("I/O error"). These constants |
1696
|
|
|
|
|
|
|
can be obtained from POSIX. |
1697
|
|
|
|
|
|
|
|
1698
|
|
|
|
|
|
|
=cut |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
sub errno { |
1702
|
|
|
|
|
|
|
my $self = shift; |
1703
|
|
|
|
|
|
|
my $message = shift; |
1704
|
|
|
|
|
|
|
return -ENOENT() if $message =~ /not found/; |
1705
|
|
|
|
|
|
|
return -EEXIST() if $message =~ /file exists/; |
1706
|
|
|
|
|
|
|
return -EISDIR() if $message =~ /is a directory/; |
1707
|
|
|
|
|
|
|
return -EPERM() if $message =~ /hard links of directories not allowed/; |
1708
|
|
|
|
|
|
|
return -ENOTDIR() if $message =~ /not a directory/; |
1709
|
|
|
|
|
|
|
return -EINVAL() if $message =~ /length beyond end of file/; |
1710
|
|
|
|
|
|
|
return -ENOTEMPTY() if $message =~ /not empty/; |
1711
|
|
|
|
|
|
|
return -EACCES() if $message =~ /permission denied/; |
1712
|
|
|
|
|
|
|
return -ENOATTR() if $message =~ /no such attribute/; |
1713
|
|
|
|
|
|
|
return -EEXIST() if $message =~ /attribute exists/; |
1714
|
|
|
|
|
|
|
warn $message; # something unexpected happened! |
1715
|
|
|
|
|
|
|
return -EIO(); |
1716
|
|
|
|
|
|
|
} |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
=head2 $result = $fs->setxattr($path,$name,$val,$flags) |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
This method sets the extended attribute named $name to the value |
1721
|
|
|
|
|
|
|
indicated by $val for the file or directory in $path. The Fuse |
1722
|
|
|
|
|
|
|
documentation states that $flags will be one of XATTR_REPLACE or |
1723
|
|
|
|
|
|
|
XATTR_CREATE, but in my testing I have only seen the value 0 passed. |
1724
|
|
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
On success, the method returns 0. |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
=cut |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
sub setxattr { |
1730
|
|
|
|
|
|
|
my $self = shift; |
1731
|
|
|
|
|
|
|
my ($path,$xname,$xval,$xflags) = @_; |
1732
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1733
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1734
|
|
|
|
|
|
|
if (!$xflags) { |
1735
|
|
|
|
|
|
|
my $sql = 'replace into xattr (inode,name,value) values (?,?,?)'; |
1736
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($sql); |
1737
|
|
|
|
|
|
|
$sth->execute($inode,$xname,$xval); |
1738
|
|
|
|
|
|
|
$sth->finish; |
1739
|
|
|
|
|
|
|
} |
1740
|
|
|
|
|
|
|
elsif ($xflags&XATTR_REPLACE) { |
1741
|
|
|
|
|
|
|
my $sql = 'update xattr set value=? where inode=? and name=?'; |
1742
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($sql); |
1743
|
|
|
|
|
|
|
my $rows = eval {$sth->execute($xval,$inode,$xname)}; |
1744
|
|
|
|
|
|
|
$sth->finish; |
1745
|
|
|
|
|
|
|
die "no such attribute" unless $rows>0; |
1746
|
|
|
|
|
|
|
} |
1747
|
|
|
|
|
|
|
elsif ($xflags&XATTR_CREATE) { |
1748
|
|
|
|
|
|
|
my $sql = 'insert into xattr (inode,name,value) values (?,?,?)'; |
1749
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($sql); |
1750
|
|
|
|
|
|
|
eval {$sth->execute($inode,$xname,$xval)}; |
1751
|
|
|
|
|
|
|
die "attribute exists" if $@ =~ /not unique|duplicate/i; |
1752
|
|
|
|
|
|
|
$sth->finish; |
1753
|
|
|
|
|
|
|
} else { |
1754
|
|
|
|
|
|
|
die "Can't interpret value of setxattr flags=$xflags"; |
1755
|
|
|
|
|
|
|
} |
1756
|
|
|
|
|
|
|
return 0; |
1757
|
|
|
|
|
|
|
} |
1758
|
|
|
|
|
|
|
|
1759
|
|
|
|
|
|
|
=head2 $val = $fs->getxattr($path,$name) |
1760
|
|
|
|
|
|
|
|
1761
|
|
|
|
|
|
|
Reads the extended attribute named $name from the file or directory at |
1762
|
|
|
|
|
|
|
$path and returns the value. Will return undef if the attribute not |
1763
|
|
|
|
|
|
|
found. |
1764
|
|
|
|
|
|
|
|
1765
|
|
|
|
|
|
|
Note that when the filesystem is mounted, the Fuse interface provides |
1766
|
|
|
|
|
|
|
no way to distinguish between an attribute that does not exist versus |
1767
|
|
|
|
|
|
|
one that does exist but has value "0". The only workaround for this is |
1768
|
|
|
|
|
|
|
to use "attr -l" to list the attributes and look for the existence of |
1769
|
|
|
|
|
|
|
the desired attribute. |
1770
|
|
|
|
|
|
|
|
1771
|
|
|
|
|
|
|
|
1772
|
|
|
|
|
|
|
=cut |
1773
|
|
|
|
|
|
|
|
1774
|
|
|
|
|
|
|
sub getxattr { |
1775
|
|
|
|
|
|
|
my $self = shift; |
1776
|
|
|
|
|
|
|
my ($path,$xname) = @_; |
1777
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1778
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1779
|
|
|
|
|
|
|
my $name = $dbh->quote($xname); |
1780
|
|
|
|
|
|
|
my ($value) = $dbh->selectrow_array("select value from xattr where inode=$inode and name=$name"); |
1781
|
|
|
|
|
|
|
return $value; |
1782
|
|
|
|
|
|
|
} |
1783
|
|
|
|
|
|
|
|
1784
|
|
|
|
|
|
|
=head2 @attribute_names = $fs->listxattr($path) |
1785
|
|
|
|
|
|
|
|
1786
|
|
|
|
|
|
|
List all xattributes for the file or directory at the indicated path |
1787
|
|
|
|
|
|
|
and return them as a list. |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
=cut |
1790
|
|
|
|
|
|
|
|
1791
|
|
|
|
|
|
|
sub listxattr { |
1792
|
|
|
|
|
|
|
my $self = shift; |
1793
|
|
|
|
|
|
|
my $path = shift; |
1794
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1795
|
|
|
|
|
|
|
my $names = $self->dbh->selectcol_arrayref("select name from xattr where inode=$inode"); |
1796
|
|
|
|
|
|
|
$names ||= []; |
1797
|
|
|
|
|
|
|
return @$names; |
1798
|
|
|
|
|
|
|
} |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
=head2 $fs->removexattr($path,$name) |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
Remove the attribute named $name for path $path. Will raise a "no such |
1803
|
|
|
|
|
|
|
attribute" error if then if the attribute does not exist. |
1804
|
|
|
|
|
|
|
|
1805
|
|
|
|
|
|
|
=cut |
1806
|
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
|
sub removexattr { |
1808
|
|
|
|
|
|
|
my $self = shift; |
1809
|
|
|
|
|
|
|
my ($path,$xname) = @_; |
1810
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
1811
|
|
|
|
|
|
|
my $inode = $self->path2inode($path); |
1812
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached("delete from xattr where inode=? and name=?"); |
1813
|
|
|
|
|
|
|
$sth->execute($inode,$xname); |
1814
|
|
|
|
|
|
|
$sth->rows > 0 or die "no such attribute named $xname"; |
1815
|
|
|
|
|
|
|
$sth->finish; |
1816
|
|
|
|
|
|
|
return 0; |
1817
|
|
|
|
|
|
|
} |
1818
|
|
|
|
|
|
|
|
1819
|
|
|
|
|
|
|
=head1 LOW LEVEL METHODS |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
The following methods may be of interest for those who wish to |
1822
|
|
|
|
|
|
|
understand how this module works, or want to subclass and extend this |
1823
|
|
|
|
|
|
|
module. |
1824
|
|
|
|
|
|
|
|
1825
|
|
|
|
|
|
|
=cut |
1826
|
|
|
|
|
|
|
|
1827
|
|
|
|
|
|
|
=head2 $fs->initialize_schema |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
This method is called to initialize the database schema. The database |
1830
|
|
|
|
|
|
|
must already exist and be writable by the current user. All previous |
1831
|
|
|
|
|
|
|
data will be deleted from the database. |
1832
|
|
|
|
|
|
|
|
1833
|
|
|
|
|
|
|
The default schema contains three tables: |
1834
|
|
|
|
|
|
|
|
1835
|
|
|
|
|
|
|
metadata -- Information about the inode used for the stat() call. This |
1836
|
|
|
|
|
|
|
includes its length, modification and access times, |
1837
|
|
|
|
|
|
|
permissions, and ownership. There is one row per inode, |
1838
|
|
|
|
|
|
|
and the inode is the table's primary key. |
1839
|
|
|
|
|
|
|
|
1840
|
|
|
|
|
|
|
path -- Maps paths to inodes. Each row is a distinct component |
1841
|
|
|
|
|
|
|
of a path and contains the name of the component, the |
1842
|
|
|
|
|
|
|
inode of the parent component, and the inode corresponding |
1843
|
|
|
|
|
|
|
to the component. This is illustrated below. |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
extents -- Maps inodes to the contents of the file. Each row consists |
1846
|
|
|
|
|
|
|
of the inode of the file, the block number of the data, and |
1847
|
|
|
|
|
|
|
a blob containing the data in that block. |
1848
|
|
|
|
|
|
|
|
1849
|
|
|
|
|
|
|
For the mysql adapter, here is the current schema: |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
metadata: |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
+--------+------------+------+-----+---------------------+----------------+ |
1854
|
|
|
|
|
|
|
| Field | Type | Null | Key | Default | Extra | |
1855
|
|
|
|
|
|
|
+--------+------------+------+-----+---------------------+----------------+ |
1856
|
|
|
|
|
|
|
| inode | int(10) | NO | PRI | NULL | auto_increment | |
1857
|
|
|
|
|
|
|
| mode | int(10) | NO | | NULL | | |
1858
|
|
|
|
|
|
|
| uid | int(10) | NO | | NULL | | |
1859
|
|
|
|
|
|
|
| gid | int(10) | NO | | NULL | | |
1860
|
|
|
|
|
|
|
| rdev | int(10) | YES | | 0 | | |
1861
|
|
|
|
|
|
|
| links | int(10) | YES | | 0 | | |
1862
|
|
|
|
|
|
|
| inuse | int(10) | YES | | 0 | | |
1863
|
|
|
|
|
|
|
| size | bigint(20) | YES | | 0 | | |
1864
|
|
|
|
|
|
|
| mtime | timestamp | NO | | 0000-00-00 00:00:00 | | |
1865
|
|
|
|
|
|
|
| ctime | timestamp | NO | | 0000-00-00 00:00:00 | | |
1866
|
|
|
|
|
|
|
| atime | timestamp | NO | | 0000-00-00 00:00:00 | | |
1867
|
|
|
|
|
|
|
+--------+------------+------+-----+---------------------+----------------+ |
1868
|
|
|
|
|
|
|
|
1869
|
|
|
|
|
|
|
path: |
1870
|
|
|
|
|
|
|
|
1871
|
|
|
|
|
|
|
+--------+--------------+------+-----+---------+-------+ |
1872
|
|
|
|
|
|
|
| Field | Type | Null | Key | Default | Extra | |
1873
|
|
|
|
|
|
|
+--------+--------------+------+-----+---------+-------+ |
1874
|
|
|
|
|
|
|
| inode | int(10) | NO | | NULL | | |
1875
|
|
|
|
|
|
|
| name | varchar(255) | NO | | NULL | | |
1876
|
|
|
|
|
|
|
| parent | int(10) | YES | MUL | NULL | | |
1877
|
|
|
|
|
|
|
+--------+--------------+------+-----+---------+-------+ |
1878
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
extents: |
1880
|
|
|
|
|
|
|
|
1881
|
|
|
|
|
|
|
+----------+---------+------+-----+---------+-------+ |
1882
|
|
|
|
|
|
|
| Field | Type | Null | Key | Default | Extra | |
1883
|
|
|
|
|
|
|
+----------+---------+------+-----+---------+-------+ |
1884
|
|
|
|
|
|
|
| inode | int(10) | YES | MUL | NULL | | |
1885
|
|
|
|
|
|
|
| block | int(10) | YES | | NULL | | |
1886
|
|
|
|
|
|
|
| contents | blob | YES | | NULL | | |
1887
|
|
|
|
|
|
|
+----------+---------+------+-----+---------+-------+ |
1888
|
|
|
|
|
|
|
|
1889
|
|
|
|
|
|
|
The B is straightforward. The meaning of most columns |
1890
|
|
|
|
|
|
|
can be inferred from the stat(2) manual page. The only columns that |
1891
|
|
|
|
|
|
|
may be mysterious are "links" and "inuse". "links" describes the |
1892
|
|
|
|
|
|
|
number of distinct paths involving a file or directory. Files start |
1893
|
|
|
|
|
|
|
out with one link and are incremented by one every time a hardlink is |
1894
|
|
|
|
|
|
|
created (symlinks don't count). Directories start out with two links |
1895
|
|
|
|
|
|
|
(one for '..' and the other for '.') and are incremented by one every |
1896
|
|
|
|
|
|
|
time a file or subdirectory is added to the directory. The "inuse" |
1897
|
|
|
|
|
|
|
column is incremented every time a file is opened for reading or |
1898
|
|
|
|
|
|
|
writing, and decremented when the file is closed. It is used to |
1899
|
|
|
|
|
|
|
prevent the content from being deleted if the file is still in use. |
1900
|
|
|
|
|
|
|
|
1901
|
|
|
|
|
|
|
The B is organized to allow rapid translation from a pathname |
1902
|
|
|
|
|
|
|
to an inode. Each entry in the tree is identified by its inode, its |
1903
|
|
|
|
|
|
|
name, and the inode of its parent directory. The inode of the root "/" |
1904
|
|
|
|
|
|
|
node is hard-coded to 1. The following steps show the effect of |
1905
|
|
|
|
|
|
|
creating subdirectories and files on the path table: |
1906
|
|
|
|
|
|
|
|
1907
|
|
|
|
|
|
|
After initial filesystem initialization there is only one entry |
1908
|
|
|
|
|
|
|
in paths corresponding to the root directory. The root has no parent: |
1909
|
|
|
|
|
|
|
|
1910
|
|
|
|
|
|
|
+-------+------+--------+ |
1911
|
|
|
|
|
|
|
| inode | name | parent | |
1912
|
|
|
|
|
|
|
+-------+------+--------+ |
1913
|
|
|
|
|
|
|
| 1 | / | NULL | |
1914
|
|
|
|
|
|
|
+-------+------+--------+ |
1915
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
$ mkdir directory1 |
1917
|
|
|
|
|
|
|
+-------+------------+--------+ |
1918
|
|
|
|
|
|
|
| inode | name | parent | |
1919
|
|
|
|
|
|
|
+-------+------------+--------+ |
1920
|
|
|
|
|
|
|
| 1 | / | NULL | |
1921
|
|
|
|
|
|
|
| 2 | directory1 | 1 | |
1922
|
|
|
|
|
|
|
+-------+------------+--------+ |
1923
|
|
|
|
|
|
|
|
1924
|
|
|
|
|
|
|
$ mkdir directory1/subdir_1_1 |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
+-------+------------+--------+ |
1927
|
|
|
|
|
|
|
| inode | name | parent | |
1928
|
|
|
|
|
|
|
+-------+------------+--------+ |
1929
|
|
|
|
|
|
|
| 1 | / | NULL | |
1930
|
|
|
|
|
|
|
| 2 | directory1 | 1 | |
1931
|
|
|
|
|
|
|
| 3 | subdir_1_1 | 2 | |
1932
|
|
|
|
|
|
|
+-------+------------+--------+ |
1933
|
|
|
|
|
|
|
|
1934
|
|
|
|
|
|
|
$ mkdir directory2 |
1935
|
|
|
|
|
|
|
|
1936
|
|
|
|
|
|
|
+-------+------------+--------+ |
1937
|
|
|
|
|
|
|
| inode | name | parent | |
1938
|
|
|
|
|
|
|
+-------+------------+--------+ |
1939
|
|
|
|
|
|
|
| 1 | / | NULL | |
1940
|
|
|
|
|
|
|
| 2 | directory1 | 1 | |
1941
|
|
|
|
|
|
|
| 3 | subdir_1_1 | 2 | |
1942
|
|
|
|
|
|
|
| 4 | directory2 | 1 | |
1943
|
|
|
|
|
|
|
+-------+------------+--------+ |
1944
|
|
|
|
|
|
|
|
1945
|
|
|
|
|
|
|
$ touch directory2/file1.txt |
1946
|
|
|
|
|
|
|
|
1947
|
|
|
|
|
|
|
+-------+------------+--------+ |
1948
|
|
|
|
|
|
|
| inode | name | parent | |
1949
|
|
|
|
|
|
|
+-------+------------+--------+ |
1950
|
|
|
|
|
|
|
| 1 | / | NULL | |
1951
|
|
|
|
|
|
|
| 2 | directory1 | 1 | |
1952
|
|
|
|
|
|
|
| 3 | subdir_1_1 | 2 | |
1953
|
|
|
|
|
|
|
| 4 | directory2 | 1 | |
1954
|
|
|
|
|
|
|
| 5 | file1.txt | 4 | |
1955
|
|
|
|
|
|
|
+-------+------------+--------+ |
1956
|
|
|
|
|
|
|
|
1957
|
|
|
|
|
|
|
$ ln directory2/file1.txt link_to_file1.txt |
1958
|
|
|
|
|
|
|
|
1959
|
|
|
|
|
|
|
+-------+-------------------+--------+ |
1960
|
|
|
|
|
|
|
| inode | name | parent | |
1961
|
|
|
|
|
|
|
+-------+-------------------+--------+ |
1962
|
|
|
|
|
|
|
| 1 | / | NULL | |
1963
|
|
|
|
|
|
|
| 2 | directory1 | 1 | |
1964
|
|
|
|
|
|
|
| 3 | subdir_1_1 | 2 | |
1965
|
|
|
|
|
|
|
| 4 | directory2 | 1 | |
1966
|
|
|
|
|
|
|
| 5 | file1.txt | 4 | |
1967
|
|
|
|
|
|
|
| 5 | link_to_file1.txt | 1 | |
1968
|
|
|
|
|
|
|
+-------+-------------------+--------+ |
1969
|
|
|
|
|
|
|
|
1970
|
|
|
|
|
|
|
Notice in the last step how creating a hard link establishes a second |
1971
|
|
|
|
|
|
|
entry with the same inode as the original file, but with a different |
1972
|
|
|
|
|
|
|
name and parent. |
1973
|
|
|
|
|
|
|
|
1974
|
|
|
|
|
|
|
The inode for path /directory2/file1.txt can be found with this |
1975
|
|
|
|
|
|
|
recursive-in-spirit SQL fragment: |
1976
|
|
|
|
|
|
|
|
1977
|
|
|
|
|
|
|
select inode from path where name="file1.txt" |
1978
|
|
|
|
|
|
|
and parent in |
1979
|
|
|
|
|
|
|
(select inode from path where name="directory2" |
1980
|
|
|
|
|
|
|
and parent in |
1981
|
|
|
|
|
|
|
(select 1) |
1982
|
|
|
|
|
|
|
) |
1983
|
|
|
|
|
|
|
|
1984
|
|
|
|
|
|
|
The B provides storage of file (and symlink) |
1985
|
|
|
|
|
|
|
contents. During testing, it turned out that storing the entire |
1986
|
|
|
|
|
|
|
contents of a file into a single BLOB column provided very poor random |
1987
|
|
|
|
|
|
|
access performance. So instead the contents are now broken into blocks |
1988
|
|
|
|
|
|
|
of constant size 4096 bytes. Each row of the table corresponds to the |
1989
|
|
|
|
|
|
|
inode of the file, the block number (starting at 0), and the data |
1990
|
|
|
|
|
|
|
contained within the block. In addition to dramatically better |
1991
|
|
|
|
|
|
|
read/write performance, this scheme allows sparse files (files |
1992
|
|
|
|
|
|
|
containing "holes") to be stored efficiently: Blocks that fall within |
1993
|
|
|
|
|
|
|
holes are completely absent from the table, while those that lead into |
1994
|
|
|
|
|
|
|
a hole are shorter than the full block length. |
1995
|
|
|
|
|
|
|
|
1996
|
|
|
|
|
|
|
The logical length of the file is stored in the metadata size |
1997
|
|
|
|
|
|
|
column. |
1998
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
If you have subclassed DBI::Filesystem and wish to adjust the default |
2000
|
|
|
|
|
|
|
schema (such as adding indexes), this is the place to do it. Simply |
2001
|
|
|
|
|
|
|
call the inherited initialize_schema(), and then alter the tables as |
2002
|
|
|
|
|
|
|
you please. |
2003
|
|
|
|
|
|
|
|
2004
|
|
|
|
|
|
|
=cut |
2005
|
|
|
|
|
|
|
|
2006
|
|
|
|
|
|
|
sub initialize_schema { |
2007
|
|
|
|
|
|
|
my $self = shift; |
2008
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2009
|
|
|
|
|
|
|
$dbh->do('drop table if exists metadata') or croak $dbh->errstr; |
2010
|
|
|
|
|
|
|
$dbh->do('drop table if exists path') or croak $dbh->errstr; |
2011
|
|
|
|
|
|
|
$dbh->do('drop table if exists extents') or croak $dbh->errstr; |
2012
|
|
|
|
|
|
|
$dbh->do('drop table if exists sqlfs_vars') or croak $dbh->errstr; |
2013
|
|
|
|
|
|
|
$dbh->do('drop table if exists xattr') or croak $dbh->errstr; |
2014
|
|
|
|
|
|
|
eval{$dbh->do('drop index if exists iblock')}; |
2015
|
|
|
|
|
|
|
eval{$dbh->do('drop index if exists ipath')}; |
2016
|
|
|
|
|
|
|
|
2017
|
|
|
|
|
|
|
|
2018
|
|
|
|
|
|
|
$dbh->do($_) foreach split ';',$self->_metadata_table_def; |
2019
|
|
|
|
|
|
|
$dbh->do($_) foreach split ';',$self->_path_table_def; |
2020
|
|
|
|
|
|
|
$dbh->do($_) foreach split ';',$self->_extents_table_def; |
2021
|
|
|
|
|
|
|
$dbh->do($_) foreach split ';',$self->_variables_table_def; |
2022
|
|
|
|
|
|
|
$dbh->do($_) foreach split ';',$self->_xattr_table_def; |
2023
|
|
|
|
|
|
|
|
2024
|
|
|
|
|
|
|
# create the root node |
2025
|
|
|
|
|
|
|
# should update this to use fuse_get_context to get proper uid, gid and masked permissions |
2026
|
|
|
|
|
|
|
my $ctx = $self->get_context; |
2027
|
|
|
|
|
|
|
my $mode = (0040000|0777)&~$ctx->{umask}; |
2028
|
|
|
|
|
|
|
my $uid = $ctx->{uid}; |
2029
|
|
|
|
|
|
|
my $gid = $ctx->{gid}; |
2030
|
|
|
|
|
|
|
my $timestamp = $self->_now_sql(); |
2031
|
|
|
|
|
|
|
# bug: we assume that sequence begins with 1 |
2032
|
|
|
|
|
|
|
$dbh->do("insert into metadata (mode,uid,gid,links,mtime,ctime,atime) values ($mode,$uid,$gid,2,$timestamp,$timestamp,$timestamp)") |
2033
|
|
|
|
|
|
|
or croak $dbh->errstr; |
2034
|
|
|
|
|
|
|
$dbh->do("insert into path (inode,name,parent) values (1,'/',null)") |
2035
|
|
|
|
|
|
|
or croak $dbh->errstr; |
2036
|
|
|
|
|
|
|
$self->set_schema_version($self->schema_version); |
2037
|
|
|
|
|
|
|
} |
2038
|
|
|
|
|
|
|
|
2039
|
|
|
|
|
|
|
=head2 $ok = $fs->check_schema |
2040
|
|
|
|
|
|
|
|
2041
|
|
|
|
|
|
|
This method is called when opening a preexisting database. It checks |
2042
|
|
|
|
|
|
|
that the metadata, path and extents tables exist in the database and |
2043
|
|
|
|
|
|
|
have the expected relationships. Returns true if the check passes. |
2044
|
|
|
|
|
|
|
|
2045
|
|
|
|
|
|
|
=cut |
2046
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
sub check_schema { |
2048
|
|
|
|
|
|
|
my $self = shift; |
2049
|
|
|
|
|
|
|
local $self->{dbh}; # to avoid cloning database handle into child threads |
2050
|
|
|
|
|
|
|
my ($result) = eval { |
2051
|
|
|
|
|
|
|
$self->dbh->selectrow_array('select 1 from metadata as m,path as p left join extents as e on e.inode=p.inode where m.inode=1 and p.parent=1'); |
2052
|
|
|
|
|
|
|
}; |
2053
|
|
|
|
|
|
|
return !$@; |
2054
|
|
|
|
|
|
|
} |
2055
|
|
|
|
|
|
|
|
2056
|
|
|
|
|
|
|
=head2 $version = $fs->schema_version |
2057
|
|
|
|
|
|
|
|
2058
|
|
|
|
|
|
|
This method returns the schema version understood by this module. It |
2059
|
|
|
|
|
|
|
is used when opening up a sqlfs databse to check whether database was |
2060
|
|
|
|
|
|
|
created by an earlier or later version of the software. The schema |
2061
|
|
|
|
|
|
|
version is distinct from the library version since updates to the library |
2062
|
|
|
|
|
|
|
do not always necessitate updates to the schema. |
2063
|
|
|
|
|
|
|
|
2064
|
|
|
|
|
|
|
Versions are small integers beginning at 1. |
2065
|
|
|
|
|
|
|
|
2066
|
|
|
|
|
|
|
=cut |
2067
|
|
|
|
|
|
|
|
2068
|
|
|
|
|
|
|
sub schema_version { |
2069
|
|
|
|
|
|
|
return SCHEMA_VERSION; |
2070
|
|
|
|
|
|
|
} |
2071
|
|
|
|
|
|
|
|
2072
|
|
|
|
|
|
|
=head2 $version = $fs->get_schema_version |
2073
|
|
|
|
|
|
|
|
2074
|
|
|
|
|
|
|
This returns the schema version known to a preexisting database. |
2075
|
|
|
|
|
|
|
|
2076
|
|
|
|
|
|
|
=cut |
2077
|
|
|
|
|
|
|
|
2078
|
|
|
|
|
|
|
sub get_schema_version { |
2079
|
|
|
|
|
|
|
my $self = shift; |
2080
|
|
|
|
|
|
|
my ($result) = eval { $self->dbh->selectrow_array("select value from sqlfs_vars where name='schema_version'") }; |
2081
|
|
|
|
|
|
|
return $result || 1; |
2082
|
|
|
|
|
|
|
} |
2083
|
|
|
|
|
|
|
|
2084
|
|
|
|
|
|
|
=head2 $fs->set_schema_version($version) |
2085
|
|
|
|
|
|
|
|
2086
|
|
|
|
|
|
|
This sets the databases's schema version to the indicated value. |
2087
|
|
|
|
|
|
|
|
2088
|
|
|
|
|
|
|
=cut |
2089
|
|
|
|
|
|
|
|
2090
|
|
|
|
|
|
|
sub set_schema_version { |
2091
|
|
|
|
|
|
|
my $self = shift; |
2092
|
|
|
|
|
|
|
my $version = shift; |
2093
|
|
|
|
|
|
|
$self->dbh->do("replace into sqlfs_vars (name,value) values ('schema_version','$version')"); |
2094
|
|
|
|
|
|
|
} |
2095
|
|
|
|
|
|
|
|
2096
|
|
|
|
|
|
|
=head2 $fs->check_schema_version |
2097
|
|
|
|
|
|
|
|
2098
|
|
|
|
|
|
|
This checks whether the schema version in a preexisting database is |
2099
|
|
|
|
|
|
|
compatible with the version known to the library. If the version is |
2100
|
|
|
|
|
|
|
from an earlier version of the library, then schema updating will be |
2101
|
|
|
|
|
|
|
attempted. If the database was created by a newer version of the |
2102
|
|
|
|
|
|
|
software, the method will raise a fatal exception. |
2103
|
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
|
=cut |
2105
|
|
|
|
|
|
|
|
2106
|
|
|
|
|
|
|
sub check_schema_version { |
2107
|
|
|
|
|
|
|
my $self = shift; |
2108
|
|
|
|
|
|
|
my $current_version = $self->schema_version; |
2109
|
|
|
|
|
|
|
my $db_version = $self->get_schema_version; |
2110
|
|
|
|
|
|
|
return if $current_version == $db_version; |
2111
|
|
|
|
|
|
|
die "This module understands schema version $current_version, but database was created with schema version $db_version" |
2112
|
|
|
|
|
|
|
if $db_version > $current_version; |
2113
|
|
|
|
|
|
|
# otherwise we evolve... |
2114
|
|
|
|
|
|
|
my $ok = 1; |
2115
|
|
|
|
|
|
|
for (my $i=$db_version;$i<$current_version;$i++) { |
2116
|
|
|
|
|
|
|
print STDERR "Updating database schema from version $i to version ",$i+1,"...\n"; |
2117
|
|
|
|
|
|
|
my $method = "_update_schema_from_${i}_to_".($i+1); |
2118
|
|
|
|
|
|
|
$ok &&= eval{$self->$method}; |
2119
|
|
|
|
|
|
|
warn $@ if $@; |
2120
|
|
|
|
|
|
|
} |
2121
|
|
|
|
|
|
|
die "Update failed" unless $ok; |
2122
|
|
|
|
|
|
|
eval {$self->dbh->do($_)} foreach split ';',$self->_variables_table_def; |
2123
|
|
|
|
|
|
|
$self->set_schema_version($self->schema_version); |
2124
|
|
|
|
|
|
|
} |
2125
|
|
|
|
|
|
|
|
2126
|
|
|
|
|
|
|
###### schema update statements ###### |
2127
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
=head2 $fs->_update_schema_from_A_to_B |
2129
|
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
|
Every update to this library that defines a new schema version has a |
2131
|
|
|
|
|
|
|
series of methods named _update_schema_from_A_to_B(), where A and B are |
2132
|
|
|
|
|
|
|
sequential version numbers. For example, if the current schema version |
2133
|
|
|
|
|
|
|
is 3, then the library will define the following methods: |
2134
|
|
|
|
|
|
|
|
2135
|
|
|
|
|
|
|
$fs->_update_schema_from_1_to_2 |
2136
|
|
|
|
|
|
|
$fs->_update_schema_from_2_to_3 |
2137
|
|
|
|
|
|
|
|
2138
|
|
|
|
|
|
|
These methods are only of interests to people who want to write |
2139
|
|
|
|
|
|
|
adapters for DBMS engines that are not currently supported, such as |
2140
|
|
|
|
|
|
|
Oracle. |
2141
|
|
|
|
|
|
|
|
2142
|
|
|
|
|
|
|
=cut |
2143
|
|
|
|
|
|
|
|
2144
|
|
|
|
|
|
|
sub _update_schema_from_1_to_2 { |
2145
|
|
|
|
|
|
|
my $self = shift; |
2146
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2147
|
|
|
|
|
|
|
$dbh->do('alter table metadata change column length size bigint default 0'); |
2148
|
|
|
|
|
|
|
$dbh->do($self->_variables_table_def); |
2149
|
|
|
|
|
|
|
1; |
2150
|
|
|
|
|
|
|
} |
2151
|
|
|
|
|
|
|
|
2152
|
|
|
|
|
|
|
sub _update_schema_from_2_to_3 { |
2153
|
|
|
|
|
|
|
my $self = shift; |
2154
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2155
|
|
|
|
|
|
|
$dbh->do($_) foreach split ';',$self->_xattr_table_def; |
2156
|
|
|
|
|
|
|
1; |
2157
|
|
|
|
|
|
|
} |
2158
|
|
|
|
|
|
|
|
2159
|
|
|
|
|
|
|
sub _variables_table_def { |
2160
|
|
|
|
|
|
|
return <
|
2161
|
|
|
|
|
|
|
create table sqlfs_vars ( |
2162
|
|
|
|
|
|
|
name varchar(255) primary key, |
2163
|
|
|
|
|
|
|
value varchar(255) |
2164
|
|
|
|
|
|
|
) |
2165
|
|
|
|
|
|
|
END |
2166
|
|
|
|
|
|
|
} |
2167
|
|
|
|
|
|
|
|
2168
|
|
|
|
|
|
|
=Head2 $size = $fs->blocksize |
2169
|
|
|
|
|
|
|
|
2170
|
|
|
|
|
|
|
This method returns the blocksize (currently 4096 bytes) used for |
2171
|
|
|
|
|
|
|
writing and retrieving file contents to the extents table. Because |
2172
|
|
|
|
|
|
|
4096 is a typical value used by libc, altering the value in subclasses |
2173
|
|
|
|
|
|
|
will probably degrade performance. Also be aware that altering the |
2174
|
|
|
|
|
|
|
blocksize will render filesystems created with other blocksize values |
2175
|
|
|
|
|
|
|
unreadable. |
2176
|
|
|
|
|
|
|
|
2177
|
|
|
|
|
|
|
=cut |
2178
|
|
|
|
|
|
|
|
2179
|
|
|
|
|
|
|
sub blocksize { return 4096 } |
2180
|
|
|
|
|
|
|
|
2181
|
|
|
|
|
|
|
=head2 $count = $fs->flushblocks |
2182
|
|
|
|
|
|
|
|
2183
|
|
|
|
|
|
|
This method returns the maximum number of blocks of file contents data |
2184
|
|
|
|
|
|
|
that can be stored in memory before it is written to disk. Because all |
2185
|
|
|
|
|
|
|
blocks are written to the database in a single transaction, this can |
2186
|
|
|
|
|
|
|
have a dramatic performance effect and it is worth trying different |
2187
|
|
|
|
|
|
|
values when tuning the module for new DBMSs. |
2188
|
|
|
|
|
|
|
|
2189
|
|
|
|
|
|
|
The default is 64. |
2190
|
|
|
|
|
|
|
|
2191
|
|
|
|
|
|
|
=cut |
2192
|
|
|
|
|
|
|
|
2193
|
|
|
|
|
|
|
sub flushblocks { return 64 } |
2194
|
|
|
|
|
|
|
|
2195
|
|
|
|
|
|
|
|
2196
|
|
|
|
|
|
|
=head2 $fixed_path = fixup($path) |
2197
|
|
|
|
|
|
|
|
2198
|
|
|
|
|
|
|
This is an ordinary function (not a method!) that removes the initial |
2199
|
|
|
|
|
|
|
slash from paths passed to this module from Fuse. The root directory |
2200
|
|
|
|
|
|
|
(/) is not changed: |
2201
|
|
|
|
|
|
|
|
2202
|
|
|
|
|
|
|
Before After fixup() |
2203
|
|
|
|
|
|
|
------ ------------- |
2204
|
|
|
|
|
|
|
/foo foo |
2205
|
|
|
|
|
|
|
/foo/bar foo/bar |
2206
|
|
|
|
|
|
|
/ / |
2207
|
|
|
|
|
|
|
|
2208
|
|
|
|
|
|
|
To call this method from subclasses, invoke it as DBI::Filesystem::fixup(). |
2209
|
|
|
|
|
|
|
|
2210
|
|
|
|
|
|
|
=cut |
2211
|
|
|
|
|
|
|
|
2212
|
|
|
|
|
|
|
sub fixup { |
2213
|
|
|
|
|
|
|
my $path = shift; |
2214
|
|
|
|
|
|
|
no warnings; |
2215
|
|
|
|
|
|
|
$path =~ s!^/!!; |
2216
|
|
|
|
|
|
|
$path || '/'; |
2217
|
|
|
|
|
|
|
} |
2218
|
|
|
|
|
|
|
|
2219
|
|
|
|
|
|
|
=head2 $dsn = $fs->dsn |
2220
|
|
|
|
|
|
|
|
2221
|
|
|
|
|
|
|
This method returns the DBI data source passed to new(). It cannot be |
2222
|
|
|
|
|
|
|
changed. |
2223
|
|
|
|
|
|
|
|
2224
|
|
|
|
|
|
|
=cut |
2225
|
|
|
|
|
|
|
|
2226
|
|
|
|
|
|
|
sub dsn { shift->{dsn} } |
2227
|
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
|
=head2 $dbh = $fs->dbh |
2229
|
|
|
|
|
|
|
|
2230
|
|
|
|
|
|
|
This method opens a connection to the database defined by dsn() and |
2231
|
|
|
|
|
|
|
returns the database handle (or raises a fatal exception). The |
2232
|
|
|
|
|
|
|
database handle will have its RaiseError and AutoCommit flags set to |
2233
|
|
|
|
|
|
|
true. Since the mount function is multithreaded, there will be one |
2234
|
|
|
|
|
|
|
database handle created per thread. |
2235
|
|
|
|
|
|
|
|
2236
|
|
|
|
|
|
|
=cut |
2237
|
|
|
|
|
|
|
|
2238
|
|
|
|
|
|
|
sub dbh { |
2239
|
|
|
|
|
|
|
my $self = shift; |
2240
|
|
|
|
|
|
|
my $dsn = $self->dsn; |
2241
|
|
|
|
|
|
|
return $self->{dbh} if $self->{dbh}; |
2242
|
|
|
|
|
|
|
my $dbh = DBI->connect($dsn, |
2243
|
|
|
|
|
|
|
undef,undef, |
2244
|
|
|
|
|
|
|
{RaiseError=>1, |
2245
|
|
|
|
|
|
|
PrintError=>0, |
2246
|
|
|
|
|
|
|
AutoCommit=>1}) or die DBI->errstr; |
2247
|
|
|
|
|
|
|
$self->_dbh_init($dbh) if $self->can('_dbh_init'); |
2248
|
|
|
|
|
|
|
return $self->{dbh}=$dbh; |
2249
|
|
|
|
|
|
|
} |
2250
|
|
|
|
|
|
|
|
2251
|
|
|
|
|
|
|
=head2 $inode = $fs->create_inode($type,$mode,$rdev,$uid,$gid) |
2252
|
|
|
|
|
|
|
|
2253
|
|
|
|
|
|
|
This method creates a new inode in the database. An inode corresponds |
2254
|
|
|
|
|
|
|
to a file, directory, symlink, pipe or block special device, and has a |
2255
|
|
|
|
|
|
|
unique integer ID defining it as its primary key. Arguments are the |
2256
|
|
|
|
|
|
|
type of inode to create, which is used to check that the passed mode |
2257
|
|
|
|
|
|
|
is correct ('f'=file, 'd'=directory,'l'=symlink; anything else is |
2258
|
|
|
|
|
|
|
ignored), the mode of the inode, which is a combination of type and |
2259
|
|
|
|
|
|
|
access permissions as described in stat(2), the device ID if a special |
2260
|
|
|
|
|
|
|
file, and the desired UID and GID. |
2261
|
|
|
|
|
|
|
|
2262
|
|
|
|
|
|
|
The return value is the newly-created inode ID. |
2263
|
|
|
|
|
|
|
|
2264
|
|
|
|
|
|
|
You will ordinarily use the mknod() and mkdir() methods to create |
2265
|
|
|
|
|
|
|
files, directories and special files. |
2266
|
|
|
|
|
|
|
|
2267
|
|
|
|
|
|
|
=cut |
2268
|
|
|
|
|
|
|
|
2269
|
|
|
|
|
|
|
sub create_inode { |
2270
|
|
|
|
|
|
|
my $self = shift; |
2271
|
|
|
|
|
|
|
my ($type,$mode,$rdev,$uid,$gid) = @_; |
2272
|
|
|
|
|
|
|
|
2273
|
|
|
|
|
|
|
$mode ||= 0777; # set filetype unless already set |
2274
|
|
|
|
|
|
|
$mode |= $type eq 'f' ? 0100000 |
2275
|
|
|
|
|
|
|
:$type eq 'd' ? 0040000 |
2276
|
|
|
|
|
|
|
:$type eq 'l' ? 0120000 |
2277
|
|
|
|
|
|
|
:0000000 unless $mode&0777000; |
2278
|
|
|
|
|
|
|
|
2279
|
|
|
|
|
|
|
$uid ||= 0; |
2280
|
|
|
|
|
|
|
$gid ||= 0; |
2281
|
|
|
|
|
|
|
$rdev ||= 0; |
2282
|
|
|
|
|
|
|
|
2283
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2284
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($self->_create_inode_sql); |
2285
|
|
|
|
|
|
|
$sth->execute($mode,$uid,$gid,$rdev,$type eq 'd' ? 1 : 0) or die $sth->errstr; |
2286
|
|
|
|
|
|
|
$sth->finish; |
2287
|
|
|
|
|
|
|
return $self->last_inserted_inode($dbh); |
2288
|
|
|
|
|
|
|
} |
2289
|
|
|
|
|
|
|
|
2290
|
|
|
|
|
|
|
=head2 $id = $fs->last_inserted_inode($dbh) |
2291
|
|
|
|
|
|
|
|
2292
|
|
|
|
|
|
|
After a new inode is inserted into the database, this method returns |
2293
|
|
|
|
|
|
|
its ID. Unique inode IDs are generated using various combinations of |
2294
|
|
|
|
|
|
|
database autoincrement and sequence semantics, which vary from DBMS to |
2295
|
|
|
|
|
|
|
DBMS, so you may need to override this method in subclasses. |
2296
|
|
|
|
|
|
|
|
2297
|
|
|
|
|
|
|
The default is simply to call DBI's last_insert_id method: |
2298
|
|
|
|
|
|
|
|
2299
|
|
|
|
|
|
|
$dbh->last_insert_id(undef,undef,undef,undef) |
2300
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
=cut |
2302
|
|
|
|
|
|
|
|
2303
|
|
|
|
|
|
|
sub last_inserted_inode { |
2304
|
|
|
|
|
|
|
my $self = shift; |
2305
|
|
|
|
|
|
|
my $dbh = shift; |
2306
|
|
|
|
|
|
|
return $dbh->last_insert_id(undef,undef,undef,undef); |
2307
|
|
|
|
|
|
|
} |
2308
|
|
|
|
|
|
|
|
2309
|
|
|
|
|
|
|
=head2 $self->create_path($inode,$path) |
2310
|
|
|
|
|
|
|
|
2311
|
|
|
|
|
|
|
After creating an inode, you can associate it with a path in the |
2312
|
|
|
|
|
|
|
filesystem using this method. It will raise an error if unsuccessful. |
2313
|
|
|
|
|
|
|
|
2314
|
|
|
|
|
|
|
=cut |
2315
|
|
|
|
|
|
|
|
2316
|
|
|
|
|
|
|
# this links an inode to a path |
2317
|
|
|
|
|
|
|
sub create_path { |
2318
|
|
|
|
|
|
|
my $self = shift; |
2319
|
|
|
|
|
|
|
my ($inode,$path) = @_; |
2320
|
|
|
|
|
|
|
|
2321
|
|
|
|
|
|
|
my $parent = $self->path2inode($self->_dirname($path)); |
2322
|
|
|
|
|
|
|
my $base = basename($path); |
2323
|
|
|
|
|
|
|
$base =~ s!/!_!g; |
2324
|
|
|
|
|
|
|
|
2325
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2326
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('insert into path (inode,name,parent) values (?,?,?)'); |
2327
|
|
|
|
|
|
|
$sth->execute($inode,$base,$parent); |
2328
|
|
|
|
|
|
|
$sth->finish; |
2329
|
|
|
|
|
|
|
|
2330
|
|
|
|
|
|
|
$dbh->do("update metadata set links=links+1 where inode=$inode"); |
2331
|
|
|
|
|
|
|
$dbh->do("update metadata set links=links+1 where inode=$parent"); |
2332
|
|
|
|
|
|
|
$self->touch($parent,'ctime'); |
2333
|
|
|
|
|
|
|
$self->touch($parent,'mtime'); |
2334
|
|
|
|
|
|
|
} |
2335
|
|
|
|
|
|
|
|
2336
|
|
|
|
|
|
|
=head2 $inode=$self->create_inode_and_path($path,$type,$mode,$rdev) |
2337
|
|
|
|
|
|
|
|
2338
|
|
|
|
|
|
|
Create an inode and associate it with the indicated path, returning |
2339
|
|
|
|
|
|
|
the inode ID. Arguments are the path, the file type (one of 'd', 'f', |
2340
|
|
|
|
|
|
|
or 'l' for directory, file or symbolic link). As usual, this may exit |
2341
|
|
|
|
|
|
|
with a fatal error. |
2342
|
|
|
|
|
|
|
|
2343
|
|
|
|
|
|
|
=cut |
2344
|
|
|
|
|
|
|
|
2345
|
|
|
|
|
|
|
sub create_inode_and_path { |
2346
|
|
|
|
|
|
|
my $self = shift; |
2347
|
|
|
|
|
|
|
my ($path,$type,$mode,$rdev) = @_; |
2348
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2349
|
|
|
|
|
|
|
my $inode; |
2350
|
|
|
|
|
|
|
|
2351
|
|
|
|
|
|
|
my $parent = $self->path2inode($self->_dirname($path)); |
2352
|
|
|
|
|
|
|
$self->check_perm($parent,W_OK); |
2353
|
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
|
my $ctx = $self->get_context; |
2355
|
|
|
|
|
|
|
|
2356
|
|
|
|
|
|
|
eval { |
2357
|
|
|
|
|
|
|
$dbh->begin_work; |
2358
|
|
|
|
|
|
|
$inode = $self->create_inode($type,$mode,$rdev,@{$ctx}{'uid','gid'}); |
2359
|
|
|
|
|
|
|
$self->create_path($inode,$path); |
2360
|
|
|
|
|
|
|
$dbh->commit; |
2361
|
|
|
|
|
|
|
}; |
2362
|
|
|
|
|
|
|
if ($@) { |
2363
|
|
|
|
|
|
|
my $message = $@; |
2364
|
|
|
|
|
|
|
eval{$dbh->rollback()}; |
2365
|
|
|
|
|
|
|
die "commit failed due to $message"; |
2366
|
|
|
|
|
|
|
} |
2367
|
|
|
|
|
|
|
return $inode; |
2368
|
|
|
|
|
|
|
} |
2369
|
|
|
|
|
|
|
|
2370
|
|
|
|
|
|
|
=head2 $fs->unlink_inode($inode) |
2371
|
|
|
|
|
|
|
|
2372
|
|
|
|
|
|
|
Given an inode, this deletes it and its contents, but only if the file |
2373
|
|
|
|
|
|
|
is no longer in use. It will die with an exception if the changes |
2374
|
|
|
|
|
|
|
cannot be committed to the database. |
2375
|
|
|
|
|
|
|
|
2376
|
|
|
|
|
|
|
=cut |
2377
|
|
|
|
|
|
|
|
2378
|
|
|
|
|
|
|
|
2379
|
|
|
|
|
|
|
sub unlink_inode { |
2380
|
|
|
|
|
|
|
my $self = shift; |
2381
|
|
|
|
|
|
|
my $inode = shift; |
2382
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2383
|
|
|
|
|
|
|
my ($references) = $dbh->selectrow_array("select links+inuse from metadata where inode=$inode"); |
2384
|
|
|
|
|
|
|
return if $references > 0; |
2385
|
|
|
|
|
|
|
eval { |
2386
|
|
|
|
|
|
|
$dbh->begin_work; |
2387
|
|
|
|
|
|
|
$dbh->do("delete from metadata where inode=$inode") or die $dbh->errstr; |
2388
|
|
|
|
|
|
|
$dbh->do("delete from extents where inode=$inode") or die $dbh->errstr; |
2389
|
|
|
|
|
|
|
$dbh->commit; |
2390
|
|
|
|
|
|
|
}; |
2391
|
|
|
|
|
|
|
if ($@) { |
2392
|
|
|
|
|
|
|
eval {$dbh->rollback}; |
2393
|
|
|
|
|
|
|
die "commit aborted due to $@"; |
2394
|
|
|
|
|
|
|
} |
2395
|
|
|
|
|
|
|
} |
2396
|
|
|
|
|
|
|
|
2397
|
|
|
|
|
|
|
=head2 $boolean = $fs->check_path($name,$inode,$uid,$gid) |
2398
|
|
|
|
|
|
|
|
2399
|
|
|
|
|
|
|
Given a directory's name, inode, and the UID and GID of the current |
2400
|
|
|
|
|
|
|
user, this will traverse all containing directories checking that |
2401
|
|
|
|
|
|
|
their execute permissions are set. If the directory and all of its |
2402
|
|
|
|
|
|
|
parents are executable by the current user, then returns true. |
2403
|
|
|
|
|
|
|
|
2404
|
|
|
|
|
|
|
=cut |
2405
|
|
|
|
|
|
|
|
2406
|
|
|
|
|
|
|
# traverse path recursively, checking for X permission |
2407
|
|
|
|
|
|
|
sub check_path { |
2408
|
|
|
|
|
|
|
my $self = shift; |
2409
|
|
|
|
|
|
|
my ($dir,$inode,$uid,$gid) = @_; |
2410
|
|
|
|
|
|
|
|
2411
|
|
|
|
|
|
|
return 1 if $self->ignore_permissions; |
2412
|
|
|
|
|
|
|
|
2413
|
|
|
|
|
|
|
my $groups = $self->get_groups($uid,$gid); |
2414
|
|
|
|
|
|
|
|
2415
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2416
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached(<
|
2417
|
|
|
|
|
|
|
select p.parent,m.mode,m.uid,m.gid |
2418
|
|
|
|
|
|
|
from path as p,metadata as m |
2419
|
|
|
|
|
|
|
where p.inode=m.inode |
2420
|
|
|
|
|
|
|
and p.inode=? and p.name=? |
2421
|
|
|
|
|
|
|
END |
2422
|
|
|
|
|
|
|
; |
2423
|
|
|
|
|
|
|
my $name = basename($dir); |
2424
|
|
|
|
|
|
|
my $ok = 1; |
2425
|
|
|
|
|
|
|
while ($ok) { |
2426
|
|
|
|
|
|
|
$sth->execute($inode,$name); |
2427
|
|
|
|
|
|
|
my ($node,$mode,$owner,$group) = $sth->fetchrow_array() or last; |
2428
|
|
|
|
|
|
|
my $mask = $uid==$owner ? S_IXUSR |
2429
|
|
|
|
|
|
|
:$groups->{$group} ? S_IXGRP |
2430
|
|
|
|
|
|
|
:S_IXOTH; |
2431
|
|
|
|
|
|
|
my $allowed = $mask & $mode; |
2432
|
|
|
|
|
|
|
$ok &&= $allowed; |
2433
|
|
|
|
|
|
|
$inode = $node; |
2434
|
|
|
|
|
|
|
$dir = $self->_dirname($dir); |
2435
|
|
|
|
|
|
|
$name = basename($dir); |
2436
|
|
|
|
|
|
|
} |
2437
|
|
|
|
|
|
|
$sth->finish; |
2438
|
|
|
|
|
|
|
return $ok; |
2439
|
|
|
|
|
|
|
} |
2440
|
|
|
|
|
|
|
|
2441
|
|
|
|
|
|
|
=head2 $fs->check_perm($inode,$access_mode) |
2442
|
|
|
|
|
|
|
|
2443
|
|
|
|
|
|
|
Given a file or directory's inode and the access mode (a bitwise OR of |
2444
|
|
|
|
|
|
|
R_OK, W_OK, X_OK), checks whether the current user is allowed |
2445
|
|
|
|
|
|
|
access. This will return if access is allowed, or raise a fatal error |
2446
|
|
|
|
|
|
|
potherwise. |
2447
|
|
|
|
|
|
|
|
2448
|
|
|
|
|
|
|
=cut |
2449
|
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
|
sub check_perm { |
2451
|
|
|
|
|
|
|
my $self = shift; |
2452
|
|
|
|
|
|
|
my ($inode,$access_mode) = @_; |
2453
|
|
|
|
|
|
|
|
2454
|
|
|
|
|
|
|
return 1 if $self->ignore_permissions; |
2455
|
|
|
|
|
|
|
|
2456
|
|
|
|
|
|
|
my $ctx = $self->get_context; |
2457
|
|
|
|
|
|
|
my ($uid,$gid) = @{$ctx}{'uid','gid'}; |
2458
|
|
|
|
|
|
|
|
2459
|
|
|
|
|
|
|
return 0 if $uid==0; # root can do anything |
2460
|
|
|
|
|
|
|
|
2461
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2462
|
|
|
|
|
|
|
|
2463
|
|
|
|
|
|
|
my $fff = 0xfff; |
2464
|
|
|
|
|
|
|
my ($mode,$owner,$group) |
2465
|
|
|
|
|
|
|
= $dbh->selectrow_array("select $fff&mode,uid,gid from metadata where inode=$inode"); |
2466
|
|
|
|
|
|
|
|
2467
|
|
|
|
|
|
|
my $groups = $self->get_groups($uid,$gid); |
2468
|
|
|
|
|
|
|
if ($access_mode == F_OK) { |
2469
|
|
|
|
|
|
|
die "permission denied" unless $uid==$owner || $groups->{$group}; |
2470
|
|
|
|
|
|
|
return 1; |
2471
|
|
|
|
|
|
|
} |
2472
|
|
|
|
|
|
|
|
2473
|
|
|
|
|
|
|
my $perm_word = $uid==$owner ? $mode >> 6 |
2474
|
|
|
|
|
|
|
:$groups->{$group} ? $mode >> 3 |
2475
|
|
|
|
|
|
|
:$mode; |
2476
|
|
|
|
|
|
|
$perm_word &= 07; |
2477
|
|
|
|
|
|
|
|
2478
|
|
|
|
|
|
|
$access_mode==($perm_word & $access_mode) or die "permission denied"; |
2479
|
|
|
|
|
|
|
return 1; |
2480
|
|
|
|
|
|
|
} |
2481
|
|
|
|
|
|
|
|
2482
|
|
|
|
|
|
|
=head2 $fs->touch($inode,$field) |
2483
|
|
|
|
|
|
|
|
2484
|
|
|
|
|
|
|
This updates the file/directory indicated by $inode to the current |
2485
|
|
|
|
|
|
|
time. $field is one of 'atime', 'ctime' or 'mtime'. |
2486
|
|
|
|
|
|
|
|
2487
|
|
|
|
|
|
|
=cut |
2488
|
|
|
|
|
|
|
|
2489
|
|
|
|
|
|
|
sub touch { |
2490
|
|
|
|
|
|
|
my $self = shift; |
2491
|
|
|
|
|
|
|
my ($inode,$field) = @_; |
2492
|
|
|
|
|
|
|
my $now = $self->_now_sql; |
2493
|
|
|
|
|
|
|
$self->dbh->do("update metadata set $field=$now where inode=$inode"); |
2494
|
|
|
|
|
|
|
} |
2495
|
|
|
|
|
|
|
|
2496
|
|
|
|
|
|
|
=head2 $inode = $fs->path2inode($path) |
2497
|
|
|
|
|
|
|
|
2498
|
|
|
|
|
|
|
=head2 ($inode,$parent_inode,$name) = $self->path2inode($path) |
2499
|
|
|
|
|
|
|
|
2500
|
|
|
|
|
|
|
This method takes a filesystem path and transforms it into an inode if |
2501
|
|
|
|
|
|
|
the path is valid. In a scalar context this method return just the |
2502
|
|
|
|
|
|
|
inode. In a list context, it returns a three element list consisting |
2503
|
|
|
|
|
|
|
of the inode, the inode of the containing directory, and the basename |
2504
|
|
|
|
|
|
|
of the file. |
2505
|
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
|
This method does permission and access path checking, and will die |
2507
|
|
|
|
|
|
|
with a "permission denied" error if either check fails. In addition, |
2508
|
|
|
|
|
|
|
passing an invalid path will return a "path not found" error. |
2509
|
|
|
|
|
|
|
|
2510
|
|
|
|
|
|
|
=cut |
2511
|
|
|
|
|
|
|
|
2512
|
|
|
|
|
|
|
# in scalar context return inode |
2513
|
|
|
|
|
|
|
# in list context return (inode,parent_inode,name) |
2514
|
|
|
|
|
|
|
sub path2inode { |
2515
|
|
|
|
|
|
|
my $self = shift; |
2516
|
|
|
|
|
|
|
my $path = shift; |
2517
|
|
|
|
|
|
|
|
2518
|
|
|
|
|
|
|
my $dynamic; |
2519
|
|
|
|
|
|
|
my ($inode,$p_inode,$name) = eval { $self->_path2inode($path)}; |
2520
|
|
|
|
|
|
|
unless ($inode) { |
2521
|
|
|
|
|
|
|
($inode,$p_inode,$name) = $self->_dynamic_path2inode($path); |
2522
|
|
|
|
|
|
|
$dynamic++ if $inode; |
2523
|
|
|
|
|
|
|
} |
2524
|
|
|
|
|
|
|
croak "$path not found" unless $inode; |
2525
|
|
|
|
|
|
|
|
2526
|
|
|
|
|
|
|
my $ctx = $self->get_context; |
2527
|
|
|
|
|
|
|
$self->check_path($self->_dirname($path),$p_inode,@{$ctx}{'uid','gid'}) or die "permission denied"; |
2528
|
|
|
|
|
|
|
return wantarray ? ($inode,$p_inode,$name,$dynamic) : $inode; |
2529
|
|
|
|
|
|
|
} |
2530
|
|
|
|
|
|
|
|
2531
|
|
|
|
|
|
|
sub _dynamic_path2inode { |
2532
|
|
|
|
|
|
|
my $self = shift; |
2533
|
|
|
|
|
|
|
my $path = shift; |
2534
|
|
|
|
|
|
|
return unless $self->allow_magic_dirs; |
2535
|
|
|
|
|
|
|
my $dirname = $self->_dirname($path); |
2536
|
|
|
|
|
|
|
my $basename = basename($path); |
2537
|
|
|
|
|
|
|
my ($dir_inode) = $self->_path2inode($dirname) or return; |
2538
|
|
|
|
|
|
|
$self->_is_dynamic_dir($dir_inode,$dirname) or return; |
2539
|
|
|
|
|
|
|
my $entries = $self->get_dynamic_entries($dir_inode,$dirname); |
2540
|
|
|
|
|
|
|
$entries->{$basename} or return; |
2541
|
|
|
|
|
|
|
my ($inode,$parent) = @{$entries->{$basename}}; |
2542
|
|
|
|
|
|
|
return ($inode,$parent,$basename); |
2543
|
|
|
|
|
|
|
} |
2544
|
|
|
|
|
|
|
|
2545
|
|
|
|
|
|
|
sub _path2inode { |
2546
|
|
|
|
|
|
|
my $self = shift; |
2547
|
|
|
|
|
|
|
my $path = shift; |
2548
|
|
|
|
|
|
|
if ($path eq '/') { |
2549
|
|
|
|
|
|
|
return wantarray ? (1,undef,'/') : 1; |
2550
|
|
|
|
|
|
|
} |
2551
|
|
|
|
|
|
|
$path =~ s!/$!!; |
2552
|
|
|
|
|
|
|
my ($sql,@bind) = $self->_path2inode_sql($path); |
2553
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2554
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached($sql) or croak $dbh->errstr; |
2555
|
|
|
|
|
|
|
$sth->execute(@bind); |
2556
|
|
|
|
|
|
|
my @v = $sth->fetchrow_array() or croak "$path not found"; |
2557
|
|
|
|
|
|
|
$sth->finish; |
2558
|
|
|
|
|
|
|
return @v; |
2559
|
|
|
|
|
|
|
} |
2560
|
|
|
|
|
|
|
|
2561
|
|
|
|
|
|
|
=head2 @paths = $fs->inode2paths($inode) |
2562
|
|
|
|
|
|
|
|
2563
|
|
|
|
|
|
|
Given an inode, this method returns the path(s) that correspond to |
2564
|
|
|
|
|
|
|
it. There may be multiple paths since file inodes can have hard |
2565
|
|
|
|
|
|
|
links. In addition, there may be NO path corresponding to an inode, if |
2566
|
|
|
|
|
|
|
the file is open but all externally accessible links have been |
2567
|
|
|
|
|
|
|
unlinked. |
2568
|
|
|
|
|
|
|
|
2569
|
|
|
|
|
|
|
Be aware that the B is indexed to make path to inode |
2570
|
|
|
|
|
|
|
searches fast, not the other way around. If you build a content search |
2571
|
|
|
|
|
|
|
engine on top of DBI::Filesystem and rely on this method, you may wish |
2572
|
|
|
|
|
|
|
to add an index to the path table's "inode" field. |
2573
|
|
|
|
|
|
|
|
2574
|
|
|
|
|
|
|
=cut |
2575
|
|
|
|
|
|
|
|
2576
|
|
|
|
|
|
|
# returns a list of paths that correspond to an inode |
2577
|
|
|
|
|
|
|
# because files can be hardlinked, there may be multiple paths! |
2578
|
|
|
|
|
|
|
sub inode2paths { |
2579
|
|
|
|
|
|
|
my $self = shift; |
2580
|
|
|
|
|
|
|
my $inode = shift; |
2581
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2582
|
|
|
|
|
|
|
#BUG: inode is not indexed in this table, so this may be slow! |
2583
|
|
|
|
|
|
|
# consider adding an index |
2584
|
|
|
|
|
|
|
my $sth = $dbh->prepare_cached('select name,parent from path where inode=?'); |
2585
|
|
|
|
|
|
|
$sth->execute($inode); |
2586
|
|
|
|
|
|
|
my @results; |
2587
|
|
|
|
|
|
|
while (my ($name,$parent) = $sth->fetchrow_array) { |
2588
|
|
|
|
|
|
|
my $directory = $self->_inode2path($parent); |
2589
|
|
|
|
|
|
|
push @results,"$directory/$name"; |
2590
|
|
|
|
|
|
|
} |
2591
|
|
|
|
|
|
|
$sth->finish; |
2592
|
|
|
|
|
|
|
return @results; |
2593
|
|
|
|
|
|
|
} |
2594
|
|
|
|
|
|
|
|
2595
|
|
|
|
|
|
|
# recursive walk up the file tree |
2596
|
|
|
|
|
|
|
# this should only be called on directories, as we know |
2597
|
|
|
|
|
|
|
# they do not have hard links |
2598
|
|
|
|
|
|
|
sub _inode2path { |
2599
|
|
|
|
|
|
|
my $self = shift; |
2600
|
|
|
|
|
|
|
my $inode = shift; |
2601
|
|
|
|
|
|
|
return '' if $inode == 1; |
2602
|
|
|
|
|
|
|
my $dbh = $self->dbh; |
2603
|
|
|
|
|
|
|
my ($name,$parent) = $dbh->selectrow_array("select name,parent from path where inode=$inode"); |
2604
|
|
|
|
|
|
|
return $self->_inode2path($parent)."/".$name; |
2605
|
|
|
|
|
|
|
} |
2606
|
|
|
|
|
|
|
|
2607
|
|
|
|
|
|
|
sub _dirname { |
2608
|
|
|
|
|
|
|
my $self = shift; |
2609
|
|
|
|
|
|
|
my $path = shift; |
2610
|
|
|
|
|
|
|
my $dir = dirname($path); |
2611
|
|
|
|
|
|
|
$dir = '/' if $dir eq '.'; # work around funniness in dirname() |
2612
|
|
|
|
|
|
|
return $dir; |
2613
|
|
|
|
|
|
|
} |
2614
|
|
|
|
|
|
|
|
2615
|
|
|
|
|
|
|
sub _path2inode_sql { |
2616
|
|
|
|
|
|
|
my $self = shift; |
2617
|
|
|
|
|
|
|
my $path = shift; |
2618
|
|
|
|
|
|
|
my (undef,$dir,$name) = File::Spec->splitpath($path); |
2619
|
|
|
|
|
|
|
my ($parent,@base) = $self->_path2inode_subselect($dir); # something nicely recursive |
2620
|
|
|
|
|
|
|
my $sql = <
|
2621
|
|
|
|
|
|
|
select p.inode,p.parent,p.name from metadata as m,path as p |
2622
|
|
|
|
|
|
|
where p.name=? and p.parent in ($parent) |
2623
|
|
|
|
|
|
|
and m.inode=p.inode |
2624
|
|
|
|
|
|
|
END |
2625
|
|
|
|
|
|
|
; |
2626
|
|
|
|
|
|
|
return ($sql,$name,@base); |
2627
|
|
|
|
|
|
|
} |
2628
|
|
|
|
|
|
|
|
2629
|
|
|
|
|
|
|
sub _path2inode_subselect { |
2630
|
|
|
|
|
|
|
my $self = shift; |
2631
|
|
|
|
|
|
|
my $path = shift; |
2632
|
|
|
|
|
|
|
return 'select 1' if $path eq '/' or !length($path); |
2633
|
|
|
|
|
|
|
$path =~ s!/$!!; |
2634
|
|
|
|
|
|
|
my (undef,$dir,$name) = File::Spec->splitpath($path); |
2635
|
|
|
|
|
|
|
my ($parent,@base) = $self->_path2inode_subselect($dir); # something nicely recursive |
2636
|
|
|
|
|
|
|
return (<
|
2637
|
|
|
|
|
|
|
select p.inode from metadata as m,path as p |
2638
|
|
|
|
|
|
|
where p.name=? and p.parent in ($parent) |
2639
|
|
|
|
|
|
|
and m.inode=p.inode |
2640
|
|
|
|
|
|
|
END |
2641
|
|
|
|
|
|
|
; |
2642
|
|
|
|
|
|
|
} |
2643
|
|
|
|
|
|
|
|
2644
|
|
|
|
|
|
|
=head2 $groups = $fs->get_groups($uid,$gid) |
2645
|
|
|
|
|
|
|
|
2646
|
|
|
|
|
|
|
This method takes a UID and GID, and returns the primary and |
2647
|
|
|
|
|
|
|
supplemental groups to which the user is assigned, and is used during |
2648
|
|
|
|
|
|
|
permission checking. The result is a hashref in which the keys are the |
2649
|
|
|
|
|
|
|
groups to which the user belongs. |
2650
|
|
|
|
|
|
|
|
2651
|
|
|
|
|
|
|
=cut |
2652
|
|
|
|
|
|
|
|
2653
|
|
|
|
|
|
|
sub get_groups { |
2654
|
|
|
|
|
|
|
my $self = shift; |
2655
|
|
|
|
|
|
|
my ($uid,$gid) = @_; |
2656
|
|
|
|
|
|
|
return $self->{_group_cache}{$uid} ||= $self->_get_groups($uid,$gid); |
2657
|
|
|
|
|
|
|
} |
2658
|
|
|
|
|
|
|
|
2659
|
|
|
|
|
|
|
sub _get_groups { |
2660
|
|
|
|
|
|
|
my $self = shift; |
2661
|
|
|
|
|
|
|
my ($uid,$gid) = @_; |
2662
|
|
|
|
|
|
|
my %result; |
2663
|
|
|
|
|
|
|
$result{$gid}++; |
2664
|
|
|
|
|
|
|
my $username = getpwuid($uid) or return \%result; |
2665
|
|
|
|
|
|
|
while (my($name,undef,$id,$members) = getgrent) { |
2666
|
|
|
|
|
|
|
next unless $members =~ /\b$username\b/; |
2667
|
|
|
|
|
|
|
$result{$id}++; |
2668
|
|
|
|
|
|
|
} |
2669
|
|
|
|
|
|
|
endgrent; |
2670
|
|
|
|
|
|
|
return \%result; |
2671
|
|
|
|
|
|
|
} |
2672
|
|
|
|
|
|
|
|
2673
|
|
|
|
|
|
|
=head2 $ctx = $fs->get_context |
2674
|
|
|
|
|
|
|
|
2675
|
|
|
|
|
|
|
This method is a wrapper around the fuse_get_context() function |
2676
|
|
|
|
|
|
|
described in L. If called before the filesystem is mounted, then |
2677
|
|
|
|
|
|
|
it fakes the call, returning a context object based on the information |
2678
|
|
|
|
|
|
|
in the current process. |
2679
|
|
|
|
|
|
|
|
2680
|
|
|
|
|
|
|
=cut |
2681
|
|
|
|
|
|
|
|
2682
|
|
|
|
|
|
|
sub get_context { |
2683
|
|
|
|
|
|
|
my $self = shift; |
2684
|
|
|
|
|
|
|
return fuse_get_context() if $self->mounted; |
2685
|
|
|
|
|
|
|
my ($gid) = $( =~ /^(\d+)/; |
2686
|
|
|
|
|
|
|
return { |
2687
|
|
|
|
|
|
|
uid => $<, |
2688
|
|
|
|
|
|
|
gid => $gid, |
2689
|
|
|
|
|
|
|
pid => $$, |
2690
|
|
|
|
|
|
|
umask => umask() |
2691
|
|
|
|
|
|
|
} |
2692
|
|
|
|
|
|
|
} |
2693
|
|
|
|
|
|
|
|
2694
|
|
|
|
|
|
|
################# a few SQL fragments; most are inline or in the DBD-specific descendents ###### |
2695
|
|
|
|
|
|
|
sub _fgetattr_sql { |
2696
|
|
|
|
|
|
|
my $self = shift; |
2697
|
|
|
|
|
|
|
my $inode = shift; |
2698
|
|
|
|
|
|
|
my $times = join ',',map{$self->_get_unix_timestamp_sql($_)} 'ctime','mtime','atime'; |
2699
|
|
|
|
|
|
|
return <
|
2700
|
|
|
|
|
|
|
select inode,mode,uid,gid,rdev,links, |
2701
|
|
|
|
|
|
|
$times,size |
2702
|
|
|
|
|
|
|
from metadata |
2703
|
|
|
|
|
|
|
where inode=$inode |
2704
|
|
|
|
|
|
|
END |
2705
|
|
|
|
|
|
|
} |
2706
|
|
|
|
|
|
|
|
2707
|
|
|
|
|
|
|
sub _create_inode_sql { |
2708
|
|
|
|
|
|
|
my $self = shift; |
2709
|
|
|
|
|
|
|
my $now = $self->_now_sql; |
2710
|
|
|
|
|
|
|
return "insert into metadata (mode,uid,gid,rdev,links,mtime,ctime,atime) values(?,?,?,?,?,$now,$now,$now)"; |
2711
|
|
|
|
|
|
|
} |
2712
|
|
|
|
|
|
|
|
2713
|
|
|
|
|
|
|
|
2714
|
|
|
|
|
|
|
1; |
2715
|
|
|
|
|
|
|
|
2716
|
|
|
|
|
|
|
=head1 SUBCLASSING |
2717
|
|
|
|
|
|
|
|
2718
|
|
|
|
|
|
|
Subclass this module as you ordinarily would by creating a new package |
2719
|
|
|
|
|
|
|
that has a "use base DBI::Filesystem". You can then tell the |
2720
|
|
|
|
|
|
|
command-line sqlfs.pl tool to load your subclass rather than the |
2721
|
|
|
|
|
|
|
original by providing a --module (or -M) option, as in: |
2722
|
|
|
|
|
|
|
|
2723
|
|
|
|
|
|
|
$ sqlfs.pl -MDBI::Filesystem::MyClass |
2724
|
|
|
|
|
|
|
|
2725
|
|
|
|
|
|
|
=head1 AUTHOR |
2726
|
|
|
|
|
|
|
|
2727
|
|
|
|
|
|
|
Copyright 2013, Lincoln D. Stein |
2728
|
|
|
|
|
|
|
|
2729
|
|
|
|
|
|
|
=head1 LICENSE |
2730
|
|
|
|
|
|
|
|
2731
|
|
|
|
|
|
|
This package is distributed under the terms of the Perl Artistic |
2732
|
|
|
|
|
|
|
License 2.0. See http://www.perlfoundation.org/artistic_license_2_0. |
2733
|
|
|
|
|
|
|
|
2734
|
|
|
|
|
|
|
=cut |
2735
|
|
|
|
|
|
|
|
2736
|
|
|
|
|
|
|
__END__ |