perl-llin/examples/loopback.pl

#!/usr/bin/perl -w
use strict;

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