diff options
Diffstat (limited to 'perl')
| -rw-r--r-- | perl/README | 41 | ||||
| -rwxr-xr-x | perl/examples/example.pl (renamed from perl/example.pl) | 0 | ||||
| -rwxr-xr-x[-rw-r--r--] | perl/examples/loopback.pl (renamed from perl/loopback.pl) | 0 | ||||
| -rwxr-xr-x | perl/examples/rmount.pl | 83 | ||||
| -rwxr-xr-x | perl/examples/rmount_remote.pl | 143 |
5 files changed, 260 insertions, 7 deletions
diff --git a/perl/README b/perl/README index 87d5a7d..fb49cd7 100644 --- a/perl/README +++ b/perl/README @@ -1,23 +1,25 @@ -Fuse version 0.02 +Fuse version 0.03 ================= -This is a test release. It seems to work thus far, but still has a few -iffy areas, as well as a few rough edges. There will be future -releases. +This is a test release. It seems to work quite well. In fact, I can't +find any problems with it whatsoever. If you do, I want to know. + INSTALLATION -To install this module type the following: +To install this module type the standard commands as root: perl Makefile.PL make - make test # currently this just makes sure the lib can link + make test make install + DEPENDENCIES This module requires the FUSE userspace library and the FUSE kernel module. + COPYRIGHT AND LICENCE This is contributed to the FUSE project by Mark Glines <mark@glines.org>, @@ -25,6 +27,31 @@ and is therefore subject to the same license and copyright as FUSE itself. Please see the AUTHORS and COPYING files from the FUSE distribution for more information. + +EXAMPLES + +There are a few example scripts. You can find them in the examples/ +subdirectory. These are: + +* example.pl, a simple "Hello world" type of script + +* loopback.pl, a filesystem loopback-device. like fusexmp from + the main FUSE dist, it simply recurses file operations + into the real filesystem. Unlike fusexmp, it only + re-shares files under the /tmp/test directory. + +* rmount.pl, an NFS-workalike which tunnels through SSH. It requires + an account on some ssh server (obviously), with public-key + authentication enabled. (if you have to type in a password, + you don't have this. man ssh_keygen.). Copy rmount_remote.pl + to your home directory on the remote machine, and create a + subdir somewhere, and then run it like: + ./rmount.pl host /remote/dir /local/dir + +* rmount_remote.pl, a ripoff of loopback.pl meant to be used as a backend + for rmount.pl. + + BUGS I've begun to build a formal testing framework. Currently it can mount @@ -35,8 +62,8 @@ The current test framework seems to work well, but the underlying mount/ unmount infrastructure is a crock. I am not pleased with that code. While most things work, I do still have a TODO list: -* while "ln -s" works as expected, "cp -a" kicks out an error on symlinks. * "du -sb" reports a couple orders of magnitude too large a size. * need to sort out cleaner mount semantics for the test framework * figure out how to un-linuxcentrify the statfs tests * test everything on other architectures and OS's + diff --git a/perl/example.pl b/perl/examples/example.pl index 9ba1117..9ba1117 100755 --- a/perl/example.pl +++ b/perl/examples/example.pl diff --git a/perl/loopback.pl b/perl/examples/loopback.pl index bdc8c22..bdc8c22 100644..100755 --- a/perl/loopback.pl +++ b/perl/examples/loopback.pl 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; +} |