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);
require 'syscall.ph'; # for SYS_mknod and SYS_lchown

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