perl-llin/examples/loopback_t.pl

#!/usr/bin/perl -w
use strict;
use threads;
use threads::shared;

use blib;
use Fuse;
use IO::File;
use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
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 fixup { return "/tmp/fusetest-" . $ENV{LOGNAME} . shift }

sub x_getattr {
        my ($file) = fixup(shift);
        my (@list) = lstat($file);
        return -$! unless @list;
        return @list;
}

sub x_getdir {
        my ($dirname) = fixup(shift);
        unless(opendir(DIRHANDLE,$dirname)) {
                return -ENOENT();
        }
        my (@files) = readdir(DIRHANDLE);
        closedir(DIRHANDLE);
        return (@files, 0);
}

sub x_open {
        my ($file) = fixup(shift);
        my ($mode) = shift;
        return -$! unless sysopen(FILE,$file,$mode);
        close(FILE);
        return 0;
}

sub x_read {
        my ($file,$bufsize,$off) = @_;
        my ($rv) = -ENOSYS();
        my ($handle) = new IO::File;
        return -ENOENT() unless -e ($file = fixup($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 {
        my ($file,$buf,$off) = @_;
        my ($rv);
        return -ENOENT() unless -e ($file = fixup($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 err { return (-shift || -$!) }

sub x_readlink { return readlink(fixup(shift));         }
sub x_unlink   { return unlink(fixup(shift)) ? 0 : -$!; }

sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }

sub x_rename {
        my ($old) = fixup(shift);
        my ($new) = fixup(shift);
        my ($err) = rename($old,$new) ? 0 : -ENOENT();
        return $err;
}
sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
sub x_chown {
        return -ENOSYS() if ! $can_syscall;
        my ($fn) = fixup(shift);
        print "nonexistent $fn\n" unless -e $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 {
        my ($fn) = fixup(shift);
        my ($mode) = shift;
        my ($err) = chmod($mode,$fn) ? 0 : -$!;
        return $err;
}
sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }

sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }

sub x_mknod {
        return -ENOSYS() if ! $can_syscall;
        # since this is called for ALL files, not just devices, I'll do some checks
        # and possibly run the real mknod command.
        my ($file, $modes, $dev) = @_;
        $file = fixup($file);
        $! = 0;
        syscall(&SYS_mknod,$file,$modes,$dev);
        return -$!;
}

# kludge
sub x_statfs {return 255,1000000,500000,1000000,500000,4096}
my ($mountpoint) = "";
$mountpoint = shift(@ARGV) if @ARGV;
Fuse::main(
        mountpoint=>$mountpoint,
        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",
        threaded=>1,
);
1	dpavlin	20	#!/usr/bin/perl -w
2			use strict;
3			use threads;
4			use threads::shared;
5
6	dpavlin	25	use blib;
7	dpavlin	20	use Fuse;
8			use IO::File;
9			use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
10			use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
11	dpavlin	112	my $can_syscall = eval {
12			require 'syscall.ph'; # for SYS_mknod and SYS_lchown
13			};
14			if (!$can_syscall && open my $fh, '<', '/usr/include/sys/syscall.h') {
15			my %sys = do { local $/ = undef;
16			<$fh> =~ m/\#define \s+ (\w+) \s+ (\d+)/gxms;
17			};
18			close $fh;
19			if ($sys{SYS_mknod} && $sys{SYS_lchown}) {
20			*SYS_mknod = sub { $sys{SYS_mknod} };
21			*SYS_lchown = sub { $sys{SYS_lchown} };
22			$can_syscall = 1;
23			}
24			}
25	dpavlin	20
26			sub fixup { return "/tmp/fusetest-" . $ENV{LOGNAME} . shift }
27
28			sub x_getattr {
29			my ($file) = fixup(shift);
30			my (@list) = lstat($file);
31			return -$! unless @list;
32			return @list;
33			}
34
35			sub x_getdir {
36			my ($dirname) = fixup(shift);
37			unless(opendir(DIRHANDLE,$dirname)) {
38			return -ENOENT();
39			}
40			my (@files) = readdir(DIRHANDLE);
41			closedir(DIRHANDLE);
42			return (@files, 0);
43			}
44
45			sub x_open {
46			my ($file) = fixup(shift);
47			my ($mode) = shift;
48			return -$! unless sysopen(FILE,$file,$mode);
49			close(FILE);
50			return 0;
51			}
52
53			sub x_read {
54			my ($file,$bufsize,$off) = @_;
55			my ($rv) = -ENOSYS();
56			my ($handle) = new IO::File;
57			return -ENOENT() unless -e ($file = fixup($file));
58			my ($fsize) = -s $file;
59			return -ENOSYS() unless open($handle,$file);
60			if(seek($handle,$off,SEEK_SET)) {
61			read($handle,$rv,$bufsize);
62			}
63			return $rv;
64			}
65
66			sub x_write {
67			my ($file,$buf,$off) = @_;
68			my ($rv);
69			return -ENOENT() unless -e ($file = fixup($file));
70			my ($fsize) = -s $file;
71			return -ENOSYS() unless open(FILE,'+<',$file);
72			if($rv = seek(FILE,$off,SEEK_SET)) {
73			$rv = print(FILE $buf);
74			}
75			$rv = -ENOSYS() unless $rv;
76			close(FILE);
77			return length($buf);
78			}
79
80			sub err { return (-shift \|\| -$!) }
81
82			sub x_readlink { return readlink(fixup(shift)); }
83			sub x_unlink { return unlink(fixup(shift)) ? 0 : -$!; }
84
85			sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
86
87			sub x_rename {
88			my ($old) = fixup(shift);
89			my ($new) = fixup(shift);
90			my ($err) = rename($old,$new) ? 0 : -ENOENT();
91			return $err;
92			}
93			sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
94			sub x_chown {
95	dpavlin	112	return -ENOSYS() if ! $can_syscall;
96	dpavlin	20	my ($fn) = fixup(shift);
97			print "nonexistent $fn\n" unless -e $fn;
98			my ($uid,$gid) = @_;
99			# perl's chown() does not chown symlinks, it chowns the symlink's
100			# target. it fails when the link's target doesn't exist, because
101			# the stat64() syscall fails.
102			# this causes error messages when unpacking symlinks in tarballs.
103			my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
104			return $err;
105			}
106			sub x_chmod {
107			my ($fn) = fixup(shift);
108			my ($mode) = shift;
109			my ($err) = chmod($mode,$fn) ? 0 : -$!;
110			return $err;
111			}
112			sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
113			sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
114
115			sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
116			sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
117
118			sub x_mknod {
119	dpavlin	112	return -ENOSYS() if ! $can_syscall;
120	dpavlin	20	# since this is called for ALL files, not just devices, I'll do some checks
121			# and possibly run the real mknod command.
122			my ($file, $modes, $dev) = @_;
123			$file = fixup($file);
124			$! = 0;
125			syscall(&SYS_mknod,$file,$modes,$dev);
126			return -$!;
127			}
128
129			# kludge
130			sub x_statfs {return 255,1000000,500000,1000000,500000,4096}
131			my ($mountpoint) = "";
132			$mountpoint = shift(@ARGV) if @ARGV;
133			Fuse::main(
134			mountpoint=>$mountpoint,
135			getattr =>"main::x_getattr",
136			readlink=>"main::x_readlink",
137			getdir =>"main::x_getdir",
138			mknod =>"main::x_mknod",
139			mkdir =>"main::x_mkdir",
140			unlink =>"main::x_unlink",
141			rmdir =>"main::x_rmdir",
142			symlink =>"main::x_symlink",
143			rename =>"main::x_rename",
144			link =>"main::x_link",
145			chmod =>"main::x_chmod",
146			chown =>"main::x_chown",
147			truncate=>"main::x_truncate",
148			utime =>"main::x_utime",
149			open =>"main::x_open",
150			read =>"main::x_read",
151			write =>"main::x_write",
152			statfs =>"main::x_statfs",
153			threaded=>1,
154			);