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	#!/usr/bin/perl -w
2	# filter_attr_t.pl
3	# Loopback fs that shows only files with a particular xattr
4
5	# (c) Reuben Thomas 29/11/2007-5/1/2008, 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 = 0;
18
19	# Global settings
20	my ($tag, $real_root, $mountpoint);
21
22
23	sub debug {
24	print STDERR shift if $debug ne 0;
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	return -$! if $! != 0;
101	return err(tag($file));
102	}
103
104	sub x_mkdir {
105	debug("x_mkdir ");
106	my ($name, $perm) = @_;
107	$name = append_root($name);
108	debug("$name");
109	my $ret = err(mkdir $name, $perm);
110	return $ret if $ret != 0;
111	return err(tag($name));
112	}
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	return -EEXIST() if -e $new && !tagged($new);
172	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	return -EEXIST() unless !-e $new \|\| tagged($new);
181	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	return -EEXIST() unless !-e $new \|\| tagged($new);
191	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	# 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;
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	);