trunk/examples/loopback.pl

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

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

my $tmp_path = "/tmp/fusetest-" . $ENV{LOGNAME};
if (! -e $tmp_path) {
        mkdir($tmp_path) || die "can't create $tmp_path: $!";
}

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