2 |
# filter_attr_t.pl |
# filter_attr_t.pl |
3 |
# Loopback fs that shows only files with a particular xattr |
# Loopback fs that shows only files with a particular xattr |
4 |
|
|
5 |
# Reuben Thomas 29th November 2007, based on example code from Fuse package |
# (c) Reuben Thomas 29/11/2007-5/1/2008, based on example code from Fuse package |
6 |
|
|
7 |
use strict; |
use strict; |
8 |
#use blib; |
#use blib; |
14 |
use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET); |
use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET); |
15 |
|
|
16 |
# Debug flag |
# Debug flag |
17 |
#my $debug = 1; |
my $debug = 0; |
18 |
|
|
19 |
# Global settings |
# Global settings |
20 |
my ($tag, $real_root, $mountpoint); |
my ($tag, $real_root, $mountpoint); |
21 |
|
|
22 |
|
|
23 |
sub debug { |
sub debug { |
24 |
print STDERR shift if $debug; |
print STDERR shift if $debug ne 0; |
25 |
} |
} |
26 |
|
|
27 |
my $can_syscall = eval { |
my $can_syscall = eval { |
97 |
return -EEXIST() if -e $file && !tagged($file); |
return -EEXIST() if -e $file && !tagged($file); |
98 |
$! = 0; |
$! = 0; |
99 |
syscall(&SYS_mknod, $file, $modes, $dev); |
syscall(&SYS_mknod, $file, $modes, $dev); |
100 |
tag($file) if $! == 0; |
return -$! if $! != 0; |
101 |
return -$!; |
return err(tag($file)); |
102 |
} |
} |
103 |
|
|
104 |
sub x_mkdir { |
sub x_mkdir { |
105 |
debug("x_mkdir "); |
debug("x_mkdir "); |
106 |
my ($name, $perm) = @_; |
my ($name, $perm) = @_; |
107 |
$name = append_root($name); |
$name = append_root($name); |
108 |
return err(mkdir($name, $perm)); |
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 { |
sub x_open { |
168 |
debug("x_symlink "); |
debug("x_symlink "); |
169 |
my ($old) = shift; |
my ($old) = shift; |
170 |
my ($new) = append_root(shift); |
my ($new) = append_root(shift); |
171 |
return -EEXIST() if -e $new && !tagged($new); |
return -EEXIST() if -e $new && !tagged($new); |
172 |
return err(symlink($old, $new)); |
return err(symlink($old, $new)); |
173 |
} |
} |
174 |
|
|
177 |
my ($old) = append_root(shift); |
my ($old) = append_root(shift); |
178 |
my ($new) = append_root(shift); |
my ($new) = append_root(shift); |
179 |
return -ENOENT() unless tagged($old); |
return -ENOENT() unless tagged($old); |
180 |
return -EEXIST() unless !-e $new || tagged($new); |
return -EEXIST() unless !-e $new || tagged($new); |
181 |
my ($err) = rename($old, $new) ? 0 : -ENOENT(); |
my ($err) = rename($old, $new) ? 0 : -ENOENT(); |
182 |
return $err; |
return $err; |
183 |
} |
} |
187 |
my ($old) = append_root(shift); |
my ($old) = append_root(shift); |
188 |
my ($new) = append_root(shift); |
my ($new) = append_root(shift); |
189 |
return -ENOENT() unless tagged($old); |
return -ENOENT() unless tagged($old); |
190 |
return -EEXIST() unless !-e $new || tagged($new); |
return -EEXIST() unless !-e $new || tagged($new); |
191 |
return err(link($old, $new)); |
return err(link($old, $new)); |
192 |
} |
} |
193 |
|
|
198 |
return -ENOENT() unless tagged($fn); |
return -ENOENT() unless tagged($fn); |
199 |
my ($uid, $gid) = @_; |
my ($uid, $gid) = @_; |
200 |
# perl's chown() does not chown symlinks, it chowns the symlink's |
# 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 |
# target. It fails when the link's target doesn't exist, because |
202 |
# the stat64() syscall fails. |
# the stat64() syscall fails. |
203 |
# this causes error messages when unpacking symlinks in tarballs. |
# This causes error messages when unpacking symlinks in tarballs. |
204 |
my ($err) = syscall(&SYS_lchown, $fn, $uid, $gid, $fn) ? -$! : 0; |
my ($err) = syscall(&SYS_lchown, $fn, $uid, $gid, $fn) ? -$! : 0; |
205 |
return $err; |
return $err; |
206 |
} |
} |