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

# Reuben Thomas  29th November 2007, 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 = 1;

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


sub debug {
        print STDERR shift if $debug;
}

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);
        tag($file) if $! == 0;
        return -$!;
}

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

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	#!/usr/bin/perl -w
2	# filter_attr_t.pl
3	# Loopback fs that shows only files with a particular xattr
4
5	# Reuben Thomas 29th November 2007, based on example code from Fuse package
6
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	#my $debug = 1;
18
19	# Global settings
20	my ($tag, $real_root, $mountpoint);
21
22
23	sub debug {
24	print STDERR shift if $debug;
25	}
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	tag($file) if $! == 0;
101	return -$!;
102	}
103
104	sub x_mkdir {
105	debug("x_mkdir ");
106	my ($name, $perm) = @_;
107	$name = append_root($name);
108	return err(mkdir($name, $perm));
109	}
110
111	sub x_open {
112	my ($file) = append_root(shift);
113	my ($mode) = shift;
114	my $accmode = $mode & O_ACCMODE;
115	debug("x_open $accmode " . O_ACCMODE . " " . O_WRONLY . " " . O_RDWR . " ");
116	if ($accmode == O_WRONLY \|\| $accmode == O_RDWR) {
117	return -EEXIST() if -e $file && !tagged($file);
118	} else {
119	return -ENOENT() unless tagged($file);
120	}
121	return -$! unless sysopen(FILE, $file, $mode);
122	close(FILE);
123	return 0;
124	}
125
126	sub x_read {
127	debug("x_read ");
128	my ($file, $bufsize, $off) = @_;
129	my ($rv) = -ENOSYS();
130	my ($handle) = new IO::File;
131	$file = append_root($file);
132	return -ENOENT() unless tagged($file);
133	my ($fsize) = -s $file;
134	return -ENOSYS() unless open($handle, $file);
135	if(seek($handle, $off, SEEK_SET)) {
136	read($handle, $rv, $bufsize);
137	}
138	return $rv;
139	}
140
141	sub x_write {
142	debug("x_write ");
143	my ($file, $buf, $off) = @_;
144	my ($rv);
145	$file = append_root($file);
146	return -ENOENT() unless tagged($file);
147	my ($fsize) = -s $file;
148	return -ENOSYS() unless open(FILE, '+<', $file);
149	if ($rv = seek(FILE, $off, SEEK_SET)) {
150	$rv = print(FILE $buf);
151	}
152	$rv = -ENOSYS() unless $rv;
153	close(FILE);
154	return length($buf);
155	}
156
157	sub x_unlink {
158	debug("x_unlink ");
159	my ($file) = append_root(shift);
160	return -ENOENT() unless tagged($file);
161	return err(detag($file));
162	}
163
164	sub x_symlink {
165	debug("x_symlink ");
166	my ($old) = shift;
167	my ($new) = append_root(shift);
168	return -EEXIST() if -e $new && !tagged($new);
169	return err(symlink($old, $new));
170	}
171
172	sub x_rename {
173	debug("x_rename ");
174	my ($old) = append_root(shift);
175	my ($new) = append_root(shift);
176	return -ENOENT() unless tagged($old);
177	return -EEXIST() unless !-e $new \|\| tagged($new);
178	my ($err) = rename($old, $new) ? 0 : -ENOENT();
179	return $err;
180	}
181
182	sub x_link {
183	debug("x_link ");
184	my ($old) = append_root(shift);
185	my ($new) = append_root(shift);
186	return -ENOENT() unless tagged($old);
187	return -EEXIST() unless !-e $new \|\| tagged($new);
188	return err(link($old, $new));
189	}
190
191	sub x_chown {
192	return -ENOSYS() if !$can_syscall;
193	debug("x_chown ");
194	my ($fn) = append_root(shift);
195	return -ENOENT() unless tagged($fn);
196	my ($uid, $gid) = @_;
197	# perl's chown() does not chown symlinks, it chowns the symlink's
198	# target. it fails when the link's target doesn't exist, because
199	# the stat64() syscall fails.
200	# this causes error messages when unpacking symlinks in tarballs.
201	my ($err) = syscall(&SYS_lchown, $fn, $uid, $gid, $fn) ? -$! : 0;
202	return $err;
203	}
204
205	sub x_chmod {
206	debug("x_chmod ");
207	my ($fn) = append_root(shift);
208	return -ENOENT() unless tagged($fn);
209	my ($mode) = shift;
210	return err(chmod($mode, $fn));
211	}
212
213	sub x_truncate {
214	debug("x_truncate ");
215	my ($fn) = append_root(shift);
216	return -ENOENT() unless tagged($fn);
217	return err(truncate($fn, shift));
218	}
219
220	sub x_utime {
221	debug("x_utime ");
222	my ($fn) = append_root($_[0]);
223	return -ENOENT() unless tagged($fn);
224	return err(utime($_[1], $_[2], $fn));
225	}
226
227	sub x_rmdir {
228	debug("x_rmdir ");
229	my $dir = append_root(shift);
230	return -ENOENT() unless tagged($dir);
231	return err(detag($dir));
232	}
233
234	sub x_statfs {
235	debug("x_statfs\n");
236	my $name = append_root(shift);
237	my($bsize, $frsize, $blocks, $bfree, $bavail,
238	$files, $ffree, $favail, $fsid, $basetype, $flag,
239	$namemax, $fstr) = statvfs($real_root) \|\| return -$!;
240	return ($namemax, $files, $ffree, $blocks, $bavail, $bsize);
241	}
242
243	# If you run the script directly, it will run fusermount, which will in turn
244	# re-run this script. Hence the funky semantics.
245
246	# Parse command-line arguments
247	$mountpoint = "";
248	if (@ARGV) {
249	$tag = shift(@ARGV);
250	$real_root = shift(@ARGV);
251	$mountpoint = shift(@ARGV);
252	}
253
254	# Start up FUSE
255	Fuse::main(
256	mountpoint=>$mountpoint,
257	# debug => 1,
258	getattr =>"main::x_getattr",
259	readlink=>"main::x_readlink",
260	getdir =>"main::x_getdir",
261	mknod =>"main::x_mknod",
262	mkdir =>"main::x_mkdir",
263	unlink =>"main::x_unlink",
264	rmdir =>"main::x_rmdir",
265	symlink =>"main::x_symlink",
266	rename =>"main::x_rename",
267	link =>"main::x_link",
268	chmod =>"main::x_chmod",
269	chown =>"main::x_chown",
270	truncate=>"main::x_truncate",
271	utime =>"main::x_utime",
272	open =>"main::x_open",
273	read =>"main::x_read",
274	write =>"main::x_write",
275	statfs =>"main::x_statfs",
276	);