3 # Loopback fs that shows only files with a particular xattr
5 # (c) Reuben Thomas 29/11/2007-5/1/2008, based on example code from Fuse package
11 use File::ExtAttr ':all';
13 use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT O_ACCMODE);
14 use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
20 my ($tag, $real_root, $mountpoint);
24 print STDERR shift if $debug ne 0;
27 my $can_syscall = eval {
28 require 'syscall.ph'; # for SYS_mknod and SYS_lchown
31 if (!$can_syscall && open my $fh, '<', '/usr/include/sys/syscall.h') {
32 my %sys = do { local $/ = undef;
33 <$fh> =~ m/\#define \s+ (\w+) \s+ (\d+)/gxms;
36 if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
37 *SYS_mknod = sub { $sys{SYS_mknod} };
38 *SYS_lchown = sub { $sys{SYS_lchown} };
46 my $ret = getfattr($file, $tag);
47 debug("tagged: $file $tag " . defined($ret) . "\n");
52 return setfattr(shift, $tag, "");
56 return delfattr(shift, $tag);
60 return $real_root . shift;
65 return $err ? 0 : -$!;
70 my ($file) = append_root(shift);
71 return -ENOENT() unless tagged($file);
72 my (@list) = lstat($file);
73 return -$! unless @list;
79 return readlink(append_root(shift));
84 my ($dirname) = append_root(shift);
85 return -ENOENT() unless tagged($dirname) && opendir(DIRHANDLE, $dirname);
86 my (@files) = readdir(DIRHANDLE);
88 my @psifiles = grep {tagged("$dirname/$_")} @files;
89 return (@psifiles, 0);
93 my ($file, $modes, $dev) = @_;
94 return -ENOSYS() if !$can_syscall;
96 $file = append_root($file);
97 return -EEXIST() if -e $file && !tagged($file);
99 syscall(&SYS_mknod, $file, $modes, $dev);
100 return -$! if $! != 0;
101 return err(tag($file));
106 my ($name, $perm) = @_;
107 $name = append_root($name);
109 my $ret = err(mkdir $name, $perm);
110 return $ret if $ret != 0;
111 return err(tag($name));
115 my ($file) = append_root(shift);
117 my $accmode = $mode & O_ACCMODE;
118 debug("x_open $accmode " . O_ACCMODE . " " . O_WRONLY . " " . O_RDWR . " ");
119 if ($accmode == O_WRONLY || $accmode == O_RDWR) {
120 return -EEXIST() if -e $file && !tagged($file);
122 return -ENOENT() unless tagged($file);
124 return -$! unless sysopen(FILE, $file, $mode);
131 my ($file, $bufsize, $off) = @_;
132 my ($rv) = -ENOSYS();
133 my ($handle) = new IO::File;
134 $file = append_root($file);
135 return -ENOENT() unless tagged($file);
136 my ($fsize) = -s $file;
137 return -ENOSYS() unless open($handle, $file);
138 if(seek($handle, $off, SEEK_SET)) {
139 read($handle, $rv, $bufsize);
146 my ($file, $buf, $off) = @_;
148 $file = append_root($file);
149 return -ENOENT() unless tagged($file);
150 my ($fsize) = -s $file;
151 return -ENOSYS() unless open(FILE, '+<', $file);
152 if ($rv = seek(FILE, $off, SEEK_SET)) {
153 $rv = print(FILE $buf);
155 $rv = -ENOSYS() unless $rv;
162 my ($file) = append_root(shift);
163 return -ENOENT() unless tagged($file);
164 return err(detag($file));
170 my ($new) = append_root(shift);
171 return -EEXIST() if -e $new && !tagged($new);
172 return err(symlink($old, $new));
177 my ($old) = append_root(shift);
178 my ($new) = append_root(shift);
179 return -ENOENT() unless tagged($old);
180 return -EEXIST() unless !-e $new || tagged($new);
181 my ($err) = rename($old, $new) ? 0 : -ENOENT();
187 my ($old) = append_root(shift);
188 my ($new) = append_root(shift);
189 return -ENOENT() unless tagged($old);
190 return -EEXIST() unless !-e $new || tagged($new);
191 return err(link($old, $new));
195 return -ENOSYS() if !$can_syscall;
197 my ($fn) = append_root(shift);
198 return -ENOENT() unless tagged($fn);
199 my ($uid, $gid) = @_;
200 # perl's chown() does not chown symlinks, it chowns the symlink's
201 # target. It fails when the link's target doesn't exist, because
202 # the stat64() syscall fails.
203 # This causes error messages when unpacking symlinks in tarballs.
204 my ($err) = syscall(&SYS_lchown, $fn, $uid, $gid, $fn) ? -$! : 0;
210 my ($fn) = append_root(shift);
211 return -ENOENT() unless tagged($fn);
213 return err(chmod($mode, $fn));
217 debug("x_truncate ");
218 my ($fn) = append_root(shift);
219 return -ENOENT() unless tagged($fn);
220 return err(truncate($fn, shift));
225 my ($fn) = append_root($_[0]);
226 return -ENOENT() unless tagged($fn);
227 return err(utime($_[1], $_[2], $fn));
232 my $dir = append_root(shift);
233 return -ENOENT() unless tagged($dir);
234 return err(detag($dir));
239 my $name = append_root(shift);
240 my($bsize, $frsize, $blocks, $bfree, $bavail,
241 $files, $ffree, $favail, $fsid, $basetype, $flag,
242 $namemax, $fstr) = statvfs($real_root) || return -$!;
243 return ($namemax, $files, $ffree, $blocks, $bavail, $bsize);
246 # If you run the script directly, it will run fusermount, which will in turn
247 # re-run this script. Hence the funky semantics.
249 # Parse command-line arguments
253 $real_root = shift(@ARGV);
254 $mountpoint = shift(@ARGV);
259 mountpoint=>$mountpoint,
261 getattr =>"main::x_getattr",
262 readlink=>"main::x_readlink",
263 getdir =>"main::x_getdir",
264 mknod =>"main::x_mknod",
265 mkdir =>"main::x_mkdir",
266 unlink =>"main::x_unlink",
267 rmdir =>"main::x_rmdir",
268 symlink =>"main::x_symlink",
269 rename =>"main::x_rename",
270 link =>"main::x_link",
271 chmod =>"main::x_chmod",
272 chown =>"main::x_chown",
273 truncate=>"main::x_truncate",
274 utime =>"main::x_utime",
275 open =>"main::x_open",
276 read =>"main::x_read",
277 write =>"main::x_write",
278 statfs =>"main::x_statfs",