moved examples into a subdirectory

updated the README

4 files changed, 452 insertions, 0 deletions

diff --git a/perl/examples/example.pl b/perl/examples/example.pl
new file mode 100755
index 0000000..9ba1117
--- /dev/null
+++ b/perl/examples/example.pl
@@ -0,0 +1,90 @@
+#!/usr/bin/perl
+
+use Fuse;
+use POSIX qw(ENOENT EISDIR EINVAL);
+
+my (%files) = (
+	'.' => {
+		type => 0040,
+		mode => 0755,
+		ctime => time()-1000
+	},
+	a => {
+		cont => "File 'a'.\n",
+		type => 0100,
+		mode => 0755,
+		ctime => time()-2000
+	},
+	b => {
+		cont => "This is file 'b'.\n",
+		type => 0100,
+		mode => 0644,
+		ctime => time()-1000
+	},
+);
+
+sub filename_fixup {
+	my ($file) = shift;
+	$file =~ s,^/,,;
+	$file = '.' unless length($file);
+	return $file;
+}
+
+sub e_getattr {
+	my ($file) = filename_fixup(shift);
+	$file =~ s,^/,,;
+	$file = '.' unless length($file);
+	return -ENOENT() unless exists($files{$file});
+	my ($size) = exists($files{$file}{cont}) ? length($files{$file}{cont}) : 0;
+	my ($modes) = ($files{$file}{type}<<9) + $files{$file}{mode};
+	my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
+	my ($atime, $ctime, $mtime);
+	$atime = $ctime = $mtime = $files{$file}{ctime};
+	# 2 possible types of return values:
+	#return -ENOENT(); # or any other error you care to
+	#print(join(",",($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks)),"\n");
+	return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
+}
+
+sub e_getdir {
+	# return as many text filenames as you like, followed by the retval.
+	print((scalar keys %files)."\n");
+	return (keys %files),0;
+}
+
+sub e_open {
+	# VFS sanity check; it keeps all the necessary state, not much to do here.
+	my ($file) = filename_fixup(shift);
+	print("open called\n");
+	return -ENOENT() unless exists($files{$file});
+	return -EISDIR() unless exists($files{$file}{cont});
+	print("open ok\n");
+	return 0;
+}
+
+sub e_read {
+	# return an error numeric, or binary/text string.  (note: 0 means EOF, "0" will
+	# give a byte (ascii "0") to the reading program)
+	my ($file) = filename_fixup(shift);
+	my ($buf,$off) = @_;
+	return -ENOENT() unless exists($files{$file});
+	return -EINVAL() if $off > length($files{$file}{cont});
+	return 0 if $off == length($files{$file}{cont});
+	return substr($files{$file}{cont},$off,$buf);
+}
+
+sub e_statfs { return 255, 1, 1, 1, 1, 2 }
+
+# If you run the script directly, it will run fusermount, which will in turn
+# re-run this script.  Hence the funky semantics.
+my ($mountpoint) = "";
+$mountpoint = shift(@ARGV) if @ARGV;
+Fuse::main(
+	mountpoint=>$mountpoint,
+	getattr=>\&e_getattr,
+	getdir=>\&e_getdir,
+	open=>\&e_open,
+	statfs=>\&e_statfs,
+	read=>\&e_read,
+	#debug=>1, threaded=>0
+);
diff --git a/perl/examples/loopback.pl b/perl/examples/loopback.pl
new file mode 100755
index 0000000..bdc8c22
--- /dev/null
+++ b/perl/examples/loopback.pl
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+
+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" . 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_rmdir { return err(rmdir(fixup(shift))               ); }
+
+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=>\&x_getattr,
+	readlink=>\&x_readlink,
+	getdir=>\&x_getdir,
+	mknod=>\&x_mknod,
+	mkdir=>\&x_mkdir,
+	unlink=>\&x_unlink,
+	rmdir=>\&x_rmdir,
+	symlink=>\&x_symlink,
+	rename=>\&x_rename,
+	link=>\&x_link,
+	chmod=>\&x_chmod,
+	chown=>\&x_chown,
+	truncate=>\&x_truncate,
+	utime=>\&x_utime,
+	open=>\&x_open,
+	read=>\&x_read,
+	write=>\&x_write,
+	statfs=>\&x_statfs,
+);
diff --git a/perl/examples/rmount.pl b/perl/examples/rmount.pl
new file mode 100755
index 0000000..eef8ed8
--- /dev/null
+++ b/perl/examples/rmount.pl
@@ -0,0 +1,83 @@
+#!/usr/bin/perl
+
+use strict;
+use Net::SSH 'sshopen2';
+use IPC::Open2;
+use Fuse;
+use Data::Dumper;
+
+my ($host, $dir, $mount) = @ARGV;
+if(!defined($mount)) {
+	$mount = $dir;
+	if($host =~ /^(.*):(.*)$/) {
+		($host,$dir) = ($1,$2);
+	} else {
+		die "usage: $0 user\@host remotedir mountpoint\n".
+		    "or   : $0 user\@host:remotedir mountpoint\n";
+	}
+}
+
+`umount $mount` unless -d $mount;
+die "mountpoint $mount isn't a directory!\n" unless -d $mount;
+
+my (%args) = (mountpoint => $mount);
+
+map { my ($str) = $_; $args{$str} = sub { netlink($str,@_) } }
+	qw(getattr getdir open read write readlink unlink rmdir
+	   symlink rename link chown chmod truncate utime mkdir
+	   rmdir mknod statfs);
+
+sub connect_remote {
+	sshopen2($host, *READER, *WRITER, "./rmount_remote.pl $dir")
+		or die "ssh: $!\n";
+#	open2(*READER,*WRITER,"./rmount_remote.pl $dir");
+	select WRITER;
+	$| = 1;
+	select STDOUT;
+}
+
+$SIG{CHLD} = sub {
+	use POSIX ":sys_wait_h";
+	my $kid;
+	do {
+		$kid = waitpid(-1,WNOHANG);
+	} until $kid < 1;
+};
+
+connect_remote;
+
+sub netlink {
+	my ($str) = join("\n",map {" $_"} (split("\n",Dumper(\@_))))."\n";
+	$str = sprintf("%08i\n%s",length($str),$str);
+	while(1) { # retry as necessary
+		my ($sig) = $SIG{ALRM};
+		my ($VAR1);
+		$VAR1 = undef;
+		eval {
+			$SIG{ALRM} = sub { die "timeout\n" };
+			alarm 10;
+			print WRITER $str;
+			my ($len, $data);
+			if(read(READER,$len,9) == 9) {
+				read(READER,$data,$len-length($data),length($data))
+					while(length($data) < $len);
+				eval $data;
+			}
+		};
+		alarm 0;
+		$SIG{ALRM} = $sig;
+		if(defined $VAR1) {
+			return wantarray ? @{$VAR1} : $$VAR1[0];
+		}
+		print STDERR "failed to send command; reconnecting ssh\n";
+		close(READER);
+		close(WRITER);
+		connect_remote();
+	}
+}
+
+Fuse::main(%args);
+
+netlink("bye");
+close(READER);
+close(WRITER);
diff --git a/perl/examples/rmount_remote.pl b/perl/examples/rmount_remote.pl
new file mode 100755
index 0000000..8a8be40
--- /dev/null
+++ b/perl/examples/rmount_remote.pl
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+
+use strict;
+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);
+use Data::Dumper;
+require 'syscall.ph'; # for SYS_mknod and SYS_lchown
+
+my ($rootdir) = @ARGV;
+
+# strip leading and trailing slashes
+$rootdir = $1 if($rootdir =~ /^\/?(.*)\/?$/);
+
+sub fixup { return "/$rootdir" . 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_rmdir { return err(rmdir(fixup(shift))               ); }
+
+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}
+
+$| = 1;
+my ($len);
+while(read(STDIN,$len,9) == 9) {
+	chomp $len;
+	my ($data,$VAR1,@args);
+	eval {
+		$SIG{ALRM} = sub { die "timeout\n"};
+		$data = "";
+		alarm 5;
+		read(STDIN,$data,$len-length($data),length($data))
+			while(length($data) < $len);
+		alarm 0;
+	};
+	die $@ if $@;
+	eval $data;
+	@args = @{$VAR1};
+	my $cmd = shift(@args);
+	exit 0 if $cmd eq "bye";
+	die "cannot find command $cmd\n" unless exists($main::{"x_$cmd"});
+	@args = $main::{"x_$cmd"}(@args);
+	$cmd = join("\n",map {" $_"} (split("\n",Dumper(\@args))))."\n";
+	$cmd = sprintf("%08i\n%s",length($cmd),$cmd);
+	print $cmd;
+}