perl-llin/examples/filter_attr_fs.pl

#!/usr/bin/perl -w
# filter_attr_t.pl
# Loopback fs that shows only files with a particular xattr

# (c) Reuben Thomas  29/11/2007-5/1/2008, based on example code from Fuse package

use strict;
#use blib;

use Fuse;
use File::ExtAttr ':all';
use IO::File;
use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT O_ACCMODE);
use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);

# Debug flag
my $debug = 0;

# Global settings
my ($tag, $real_root, $mountpoint);


sub debug {
        print STDERR shift if $debug ne 0;
}

my $can_syscall = eval {
        require 'syscall.ph'; # for SYS_mknod and SYS_lchown
};

if (!$can_syscall && open my $fh, '<', '/usr/include/sys/syscall.h') {
        my %sys = do { local $/ = undef;
                        <$fh> =~ m/\#define \s+ (\w+) \s+ (\d+)/gxms;
                };
        close $fh;
        if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
                *SYS_mknod  = sub { $sys{SYS_mknod}  };
                *SYS_lchown = sub { $sys{SYS_lchown} };
                $can_syscall = 1;
        }
}

sub tagged {
        my ($file) = @_;
        $file =~ s|/$||;
        my $ret = getfattr($file, $tag);
        debug("tagged: $file $tag " . defined($ret) . "\n");
        return $ret;
}

sub tag {
        return setfattr(shift, $tag, "");
}

sub detag {
        return delfattr(shift, $tag);
}

sub append_root {
        return $real_root . shift;
}

sub err {
        my ($err) = @_;
        return $err ? 0 : -$!;
}

sub x_getattr {
        debug("x_getattr ");
        my ($file) = append_root(shift);
        return -ENOENT() unless tagged($file);
        my (@list) = lstat($file);
        return -$! unless @list;
        return @list;
}

sub x_readlink {
        debug("x_readlink ");
        return readlink(append_root(shift));
}

sub x_getdir {
        debug("x_getdir ");
        my ($dirname) = append_root(shift);
        return -ENOENT() unless tagged($dirname) && opendir(DIRHANDLE, $dirname);
        my (@files) = readdir(DIRHANDLE);
        closedir(DIRHANDLE);
        my @psifiles = grep {tagged("$dirname/$_")} @files;
        return (@psifiles, 0);
}

sub x_mknod {
        my ($file, $modes, $dev) = @_;
        return -ENOSYS() if !$can_syscall;
        debug("x_mknod ");
        $file = append_root($file);
        return -EEXIST() if -e $file && !tagged($file);
        $! = 0;
        syscall(&SYS_mknod, $file, $modes, $dev);
        return -$! if $! != 0;
        return err(tag($file));
}

sub x_mkdir {
        debug("x_mkdir ");
        my ($name, $perm) = @_;
        $name = append_root($name);
        debug("$name");
        my $ret = err(mkdir $name, $perm);
        return $ret if $ret != 0;
        return err(tag($name));
}

sub x_open {
        my ($file) = append_root(shift);
        my ($mode) = shift;
        my $accmode = $mode & O_ACCMODE;
        debug("x_open $accmode " . O_ACCMODE . " " . O_WRONLY . " " . O_RDWR . " ");
        if ($accmode == O_WRONLY || $accmode == O_RDWR) {
                return -EEXIST() if -e $file && !tagged($file);
        } else {
                return -ENOENT() unless tagged($file);
        }
        return -$! unless sysopen(FILE, $file, $mode);
        close(FILE);
        return 0;
}

sub x_read {
        debug("x_read ");
        my ($file, $bufsize, $off) = @_;
        my ($rv) = -ENOSYS();
        my ($handle) = new IO::File;
        $file = append_root($file);
        return -ENOENT() unless tagged($file);
        my ($fsize) = -s $file;
        return -ENOSYS() unless open($handle, $file);
        if(seek($handle, $off, SEEK_SET)) {
                read($handle, $rv, $bufsize);
        }
        return $rv;
}

sub x_write {
        debug("x_write ");
        my ($file, $buf, $off) = @_;
        my ($rv);
        $file = append_root($file);
        return -ENOENT() unless tagged($file);
        my ($fsize) = -s $file;
        return -ENOSYS() unless open(FILE, '+<', $file);
        if ($rv = seek(FILE, $off, SEEK_SET)) {
                $rv = print(FILE $buf);
        }
        $rv = -ENOSYS() unless $rv;
        close(FILE);
        return length($buf);
}

sub x_unlink {
        debug("x_unlink ");
        my ($file) = append_root(shift);
        return -ENOENT() unless tagged($file);
        return err(detag($file));
}

sub x_symlink {
        debug("x_symlink ");
        my ($old) = shift;
        my ($new) = append_root(shift);
        return -EEXIST() if -e $new && !tagged($new);
        return err(symlink($old, $new));
}

sub x_rename {
        debug("x_rename ");
        my ($old) = append_root(shift);
        my ($new) = append_root(shift);
        return -ENOENT() unless tagged($old);
        return -EEXIST() unless !-e $new || tagged($new);
        my ($err) = rename($old, $new) ? 0 : -ENOENT();
        return $err;
}

sub x_link {
        debug("x_link ");
        my ($old) = append_root(shift);
        my ($new) = append_root(shift);
        return -ENOENT() unless tagged($old);
        return -EEXIST() unless !-e $new || tagged($new);
        return err(link($old, $new));
}

sub x_chown {
        return -ENOSYS() if !$can_syscall;
        debug("x_chown ");
        my ($fn) = append_root(shift);
        return -ENOENT() unless tagged($fn);
        my ($uid, $gid) = @_;
        # perl's chown() does not chown symlinks, it chowns the symlink's
        # target. It fails when the link's target doesn't exist, because
        # the stat64() syscall fails.
        # This causes error messages when unpacking symlinks in tarballs.
        my ($err) = syscall(&SYS_lchown, $fn, $uid, $gid, $fn) ? -$! : 0;
        return $err;
}

sub x_chmod {
        debug("x_chmod ");
        my ($fn) = append_root(shift);
        return -ENOENT() unless tagged($fn);
        my ($mode) = shift;
        return err(chmod($mode, $fn));
}

sub x_truncate {
        debug("x_truncate ");
        my ($fn) = append_root(shift);
        return -ENOENT() unless tagged($fn);
        return err(truncate($fn, shift));
}

sub x_utime {
        debug("x_utime ");
        my ($fn) = append_root($_[0]);
        return -ENOENT() unless tagged($fn);
        return err(utime($_[1], $_[2], $fn));
}

sub x_rmdir {
        debug("x_rmdir ");
        my $dir = append_root(shift);
        return -ENOENT() unless tagged($dir);
        return err(detag($dir));
}

sub x_statfs {
        debug("x_statfs\n");
        my $name = append_root(shift);
        my($bsize, $frsize, $blocks, $bfree, $bavail,
                $files, $ffree, $favail, $fsid, $basetype, $flag,
                $namemax, $fstr) = statvfs($real_root) || return -$!;
        return ($namemax, $files, $ffree, $blocks, $bavail, $bsize);
}

# If you run the script directly, it will run fusermount, which will in turn
# re-run this script.  Hence the funky semantics.

# Parse command-line arguments
$mountpoint = "";
if (@ARGV) {
        $tag = shift(@ARGV);
        $real_root = shift(@ARGV);
        $mountpoint = shift(@ARGV);
}

# Start up FUSE
Fuse::main(
        mountpoint=>$mountpoint,
#       debug   => 1,
        getattr =>"main::x_getattr",
        readlink=>"main::x_readlink",
        getdir  =>"main::x_getdir",
        mknod   =>"main::x_mknod",
        mkdir   =>"main::x_mkdir",
        unlink  =>"main::x_unlink",
        rmdir   =>"main::x_rmdir",
        symlink =>"main::x_symlink",
        rename  =>"main::x_rename",
        link    =>"main::x_link",
        chmod   =>"main::x_chmod",
        chown   =>"main::x_chown",
        truncate=>"main::x_truncate",
        utime   =>"main::x_utime",
        open    =>"main::x_open",
        read    =>"main::x_read",
        write   =>"main::x_write",
        statfs  =>"main::x_statfs",
);
1	dpavlin	116	#!/usr/bin/perl -w
2			# filter_attr_t.pl
3			# Loopback fs that shows only files with a particular xattr
4
5	dpavlin	117	# (c) Reuben Thomas 29/11/2007-5/1/2008, based on example code from Fuse package
6	dpavlin	116
7			use strict;
8			#use blib;
9
10			use Fuse;
11			use File::ExtAttr ':all';
12			use IO::File;
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);
15
16			# Debug flag
17	dpavlin	117	my $debug = 0;
18	dpavlin	116
19			# Global settings
20			my ($tag, $real_root, $mountpoint);
21
22
23			sub debug {
24	dpavlin	117	print STDERR shift if $debug ne 0;
25	dpavlin	116	}
26
27			my $can_syscall = eval {
28			require 'syscall.ph'; # for SYS_mknod and SYS_lchown
29			};
30
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;
34			};
35			close $fh;
36			if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
37			*SYS_mknod = sub { $sys{SYS_mknod} };
38			*SYS_lchown = sub { $sys{SYS_lchown} };
39			$can_syscall = 1;
40			}
41			}
42
43			sub tagged {
44			my ($file) = @_;
45			$file =~ s\|/$\|\|;
46			my $ret = getfattr($file, $tag);
47			debug("tagged: $file $tag " . defined($ret) . "\n");
48			return $ret;
49			}
50
51			sub tag {
52			return setfattr(shift, $tag, "");
53			}
54
55			sub detag {
56			return delfattr(shift, $tag);
57			}
58
59			sub append_root {
60			return $real_root . shift;
61			}
62
63			sub err {
64			my ($err) = @_;
65			return $err ? 0 : -$!;
66			}
67
68			sub x_getattr {
69			debug("x_getattr ");
70			my ($file) = append_root(shift);
71			return -ENOENT() unless tagged($file);
72			my (@list) = lstat($file);
73			return -$! unless @list;
74			return @list;
75			}
76
77			sub x_readlink {
78			debug("x_readlink ");
79			return readlink(append_root(shift));
80			}
81
82			sub x_getdir {
83			debug("x_getdir ");
84			my ($dirname) = append_root(shift);
85			return -ENOENT() unless tagged($dirname) && opendir(DIRHANDLE, $dirname);
86			my (@files) = readdir(DIRHANDLE);
87			closedir(DIRHANDLE);
88			my @psifiles = grep {tagged("$dirname/$_")} @files;
89			return (@psifiles, 0);
90			}
91
92			sub x_mknod {
93			my ($file, $modes, $dev) = @_;
94			return -ENOSYS() if !$can_syscall;
95			debug("x_mknod ");
96			$file = append_root($file);
97			return -EEXIST() if -e $file && !tagged($file);
98			$! = 0;
99			syscall(&SYS_mknod, $file, $modes, $dev);
100	dpavlin	117	return -$! if $! != 0;
101			return err(tag($file));
102	dpavlin	116	}
103
104			sub x_mkdir {
105			debug("x_mkdir ");
106			my ($name, $perm) = @_;
107			$name = append_root($name);
108	dpavlin	117	debug("$name");
109			my $ret = err(mkdir $name, $perm);
110			return $ret if $ret != 0;
111			return err(tag($name));
112	dpavlin	116	}
113
114			sub x_open {
115			my ($file) = append_root(shift);
116			my ($mode) = 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);
121			} else {
122			return -ENOENT() unless tagged($file);
123			}
124			return -$! unless sysopen(FILE, $file, $mode);
125			close(FILE);
126			return 0;
127			}
128
129			sub x_read {
130			debug("x_read ");
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);
140			}
141			return $rv;
142			}
143
144			sub x_write {
145			debug("x_write ");
146			my ($file, $buf, $off) = @_;
147			my ($rv);
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);
154			}
155			$rv = -ENOSYS() unless $rv;
156			close(FILE);
157			return length($buf);
158			}
159
160			sub x_unlink {
161			debug("x_unlink ");
162			my ($file) = append_root(shift);
163			return -ENOENT() unless tagged($file);
164			return err(detag($file));
165			}
166
167			sub x_symlink {
168			debug("x_symlink ");
169			my ($old) = shift;
170			my ($new) = append_root(shift);
171	dpavlin	117	return -EEXIST() if -e $new && !tagged($new);
172	dpavlin	116	return err(symlink($old, $new));
173			}
174
175			sub x_rename {
176			debug("x_rename ");
177			my ($old) = append_root(shift);
178			my ($new) = append_root(shift);
179			return -ENOENT() unless tagged($old);
180	dpavlin	117	return -EEXIST() unless !-e $new \|\| tagged($new);
181	dpavlin	116	my ($err) = rename($old, $new) ? 0 : -ENOENT();
182			return $err;
183			}
184
185			sub x_link {
186			debug("x_link ");
187			my ($old) = append_root(shift);
188			my ($new) = append_root(shift);
189			return -ENOENT() unless tagged($old);
190	dpavlin	117	return -EEXIST() unless !-e $new \|\| tagged($new);
191	dpavlin	116	return err(link($old, $new));
192			}
193
194			sub x_chown {
195			return -ENOSYS() if !$can_syscall;
196			debug("x_chown ");
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	dpavlin	117	# target. It fails when the link's target doesn't exist, because
202	dpavlin	116	# the stat64() syscall fails.
203	dpavlin	117	# This causes error messages when unpacking symlinks in tarballs.
204	dpavlin	116	my ($err) = syscall(&SYS_lchown, $fn, $uid, $gid, $fn) ? -$! : 0;
205			return $err;
206			}
207
208			sub x_chmod {
209			debug("x_chmod ");
210			my ($fn) = append_root(shift);
211			return -ENOENT() unless tagged($fn);
212			my ($mode) = shift;
213			return err(chmod($mode, $fn));
214			}
215
216			sub x_truncate {
217			debug("x_truncate ");
218			my ($fn) = append_root(shift);
219			return -ENOENT() unless tagged($fn);
220			return err(truncate($fn, shift));
221			}
222
223			sub x_utime {
224			debug("x_utime ");
225			my ($fn) = append_root($_[0]);
226			return -ENOENT() unless tagged($fn);
227			return err(utime($_[1], $_[2], $fn));
228			}
229
230			sub x_rmdir {
231			debug("x_rmdir ");
232			my $dir = append_root(shift);
233			return -ENOENT() unless tagged($dir);
234			return err(detag($dir));
235			}
236
237			sub x_statfs {
238			debug("x_statfs\n");
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);
244			}
245
246			# If you run the script directly, it will run fusermount, which will in turn
247			# re-run this script. Hence the funky semantics.
248
249			# Parse command-line arguments
250			$mountpoint = "";
251			if (@ARGV) {
252			$tag = shift(@ARGV);
253			$real_root = shift(@ARGV);
254			$mountpoint = shift(@ARGV);
255			}
256
257			# Start up FUSE
258			Fuse::main(
259			mountpoint=>$mountpoint,
260			# debug => 1,
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",
279			);