4 files changed, 0 insertions, 451 deletions
diff --git a/perl/examples/example.pl b/perl/examples/example.pl
deleted file mode 100755
index 9ba1117..0000000
--- a/perl/examples/example.pl
+++ /dev/null
@@ -1,90 +0,0 @@
-#!/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
deleted file mode 100755
index bdc8c22..0000000
--- a/perl/examples/loopback.pl
+++ /dev/null
@@ -1,136 +0,0 @@
-#!/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
deleted file mode 100755
index 9ae1cc1..0000000
--- a/perl/examples/rmount.pl
+++ /dev/null
@@ -1,82 +0,0 @@
-#!/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";
-	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) = 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
deleted file mode 100755
index e9e0866..0000000
--- a/perl/examples/rmount_remote.pl
+++ /dev/null
@@ -1,143 +0,0 @@
-#!/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 = Dumper(\@args)."\n";
-	$cmd = sprintf("%08i\n%s",length($cmd),$cmd);
-	print $cmd;
-}