--- /dev/null
+Fuse.bs Fuse.c Makefile blib pm_to_blib
--- /dev/null
+Perl bindings
+-------------
+
+Mark Glines <mark@glines.org>
--- /dev/null
+Revision history for Perl extension Fuse.
+
+0.01 Wed Nov 28 21:45:20 2001
+ - original version; created by h2xs 1.21 with options
+ include/fuse.h
+
+0.02 Sun Dec 2 18:59:56 2001
+ - works well enough to release, but still needs testing
+
+0.03 Wed Dec 5 02:17:52 2001
+ - changed getattr() to smell like perl's stat()
+ - fleshed out the documentation a bit
--- /dev/null
+package Fuse;
+
+use 5.006;
+use strict;
+use warnings;
+use Errno;
+use Carp;
+
+require Exporter;
+require DynaLoader;
+use AutoLoader;
+use Data::Dumper;
+our @ISA = qw(Exporter DynaLoader);
+
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+
+# This allows declaration use Fuse ':all';
+# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
+# will save memory.
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ FUSE_DEBUG
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+ FUSE_DEBUG
+);
+our $VERSION = '0.01';
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function. If a constant is not found then control is passed
+ # to the AUTOLOAD in AutoLoader.
+
+ my $constname;
+ our $AUTOLOAD;
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ croak "& not defined" if $constname eq 'constant';
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! != 0) {
+ if ($!{EINVAL}) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ }
+ else {
+ croak "Your vendor has not defined Fuse macro $constname";
+ }
+ }
+ {
+ no strict 'refs';
+ # Fixed between 5.005_53 and 5.005_61
+ if ($] >= 5.00561) {
+ *$AUTOLOAD = sub () { $val };
+ }
+ else {
+ *$AUTOLOAD = sub { $val };
+ }
+ }
+ goto &$AUTOLOAD;
+}
+
+bootstrap Fuse $VERSION;
+
+sub main {
+ my (@subs) = (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
+ my (@names) = qw(getattr readlink getdir mknod mkdir unlink rmdir symlink
+ rename link chmod chown truncate utime open read write statfs);
+ my ($tmp) = 0;
+ my (%mapping) = map { $_ => $tmp++ } (@names);
+ my (%otherargs) = (debug=>0, mountpoint=>"");
+ while(my $name = shift) {
+ my ($subref) = shift;
+ if(exists($otherargs{$name})) {
+ $otherargs{$name} = $subref;
+ } else {
+ croak "There is no function $name" unless exists($mapping{$name});
+ croak "Usage: Fuse::main(getattr => &my_getattr, ...)" unless $subref;
+ croak "Usage: Fuse::main(getattr => &my_getattr, ...)" unless ref($subref);
+ croak "Usage: Fuse::main(getattr => &my_getattr, ...)" unless ref($subref) eq "CODE";
+ $subs[$mapping{$name}] = $subref;
+ }
+ }
+ perl_fuse_main($otherargs{debug},$otherargs{mountpoint},@subs);
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+
+=head1 NAME
+
+Fuse - write filesystems in Perl using FUSE
+
+=head1 SYNOPSIS
+
+ use Fuse;
+ my ($mountpoint) = "";
+ $mountpoint = shift(@ARGV) if @ARGV;
+ Fuse::main(mountpoint=>$mountpoint, getattr=>\&my_getattr, getdir=>\&my_getdir, ...);
+
+=head1 DESCRIPTION
+
+This lets you implement filesystems in perl, through the FUSE
+(Filesystem in USErspace) kernel/lib interface.
+
+FUSE expects you to implement callbacks for the various functions.
+
+NOTE: I have only tested the things implemented in example.pl!
+It should work, but some things may not.
+
+In the following definitions, "errno" can be 0 (for a success),
+-EINVAL, -ENOENT, -EONFIRE, any integer less than 1 really.
+
+You can import standard error constants by saying something like
+"use POSIX qw(EDOTDOT ENOANO);".
+
+Every constant you need (file types, open() flags, error values,
+etc) can be imported either from POSIX or from Fcntl, often both.
+See their respective documentations, for more information.
+
+=head2 EXPORT
+
+None by default.
+
+=head2 EXPORTABLE CONSTANTS
+
+None.
+
+=head2 FUNCTIONS
+
+=head3 Fuse::main
+
+Takes arguments in the form of hash key=>value pairs. There are
+many valid keys. Most of them correspond with names of callback
+functions, as described in section 'FUNCTIONS YOUR FILESYSTEM MAY IMPLEMENT'.
+A few special keys also exist:
+
+
+debug => boolean
+
+=over 1
+
+This turns FUSE call tracing on and off. Default is 0 (which means off).
+
+=back
+
+mountpoint => string
+
+=over 1
+
+The point at which to mount this filesystem. There is no default, you must
+specify this. An example would be '/mnt'.
+
+=back
+
+unthreaded => boolean
+
+=over 1
+
+This turns FUSE multithreading off and on. NOTE: This perlmodule does not
+currently work properly in multithreaded mode! The author is unfortunately
+not familiar enough with perl-threads internals, and according to the
+documentation available at time of writing (2002-03-08), those internals are
+subject to changing anyway. Note that singlethreaded mode also means that
+you will not have to worry about reentrancy, though you will have to worry
+about recursive lookups (since the kernel holds a global lock on your
+filesystem and blocks waiting for one callback to complete before calling
+another).
+
+I hope to add full multithreading functionality later, but for now, I
+recommend you leave this option at the default, 1 (which means
+unthreaded, no threads will be used and no reentrancy is needed).
+
+=back
+
+=head2 FUNCTIONS YOUR FILESYSTEM MAY IMPLEMENT
+
+=head3 getattr
+
+Arguments: filename.
+Returns a list, very similar to the 'stat' function (see
+perlfunc). On error, simply return a single numeric scalar
+value (e.g. "return -ENOENT();").
+
+FIXME: the "ino" field is currently ignored. I tried setting it to 0
+in an example script, which consistently caused segfaults.
+
+Fields (the following was stolen from perlfunc(1) with apologies):
+
+($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
+ $atime,$mtime,$ctime,$blksize,$blocks)
+ = getattr($filename);
+
+Here are the meaning of the fields:
+
+ 0 dev device number of filesystem
+ 1 ino inode number
+ 2 mode file mode (type and permissions)
+ 3 nlink number of (hard) links to the file
+ 4 uid numeric user ID of file's owner
+ 5 gid numeric group ID of file's owner
+ 6 rdev the device identifier (special files only)
+ 7 size total size of file, in bytes
+ 8 atime last access time in seconds since the epoch
+ 9 mtime last modify time in seconds since the epoch
+10 ctime inode change time (NOT creation time!) in seconds
+ since the epoch
+11 blksize preferred block size for file system I/O
+12 blocks actual number of blocks allocated
+
+(The epoch was at 00:00 January 1, 1970 GMT.)
+
+=head3 readlink
+
+Arguments: link pathname.
+Returns a scalar: either a numeric constant, or a text string.
+
+This is called when dereferencing symbolic links, to learn the target.
+
+example rv: return "/proc/self/fd/stdin";
+
+=head3 getdir
+
+Arguments: Containing directory name.
+Returns a list: 0 or more text strings (the filenames), followed by a numeric errno (usually 0).
+
+This is used to obtain directory listings. Its opendir(), readdir(), filldir() and closedir() all in one call.
+
+example rv: return ('.', 'a', 'b', 0);
+
+=head3 mknod
+
+Arguments: Filename, numeric modes, numeric device
+Returns an errno (0 upon success, as usual).
+
+This function is called for all non-directory, non-symlink nodes,
+not just devices.
+
+=head3 mkdir
+
+Arguments: New directory pathname, numeric modes.
+Returns an errno.
+
+Called to create a directory.
+
+=head3 unlink
+
+Arguments: Filename.
+Returns an errno.
+
+Called to remove a file, device, or symlink.
+
+=head3 rmdir
+
+Arguments: Pathname.
+Returns an errno.
+
+Called to remove a directory.
+
+=head3 symlink
+
+Arguments: Existing filename, symlink name.
+Returns an errno.
+
+Called to create a symbolic link.
+
+=head3 rename
+
+Arguments: old filename, new filename.
+Returns an errno.
+
+Called to rename a file, and/or move a file from one directory to another.
+
+=head3 link
+
+Arguments: Existing filename, hardlink name.
+Returns an errno.
+
+Called to create hard links.
+
+=head3 chmod
+
+Arguments: Pathname, numeric modes.
+Returns an errno.
+
+Called to change permissions on a file/directory/device/symlink.
+
+=head3 chown
+
+Arguments: Pathname, numeric uid, numeric gid.
+Returns an errno.
+
+Called to change ownership of a file/directory/device/symlink.
+
+=head3 truncate
+
+Arguments: Pathname, numeric offset.
+Returns an errno.
+
+Called to truncate a file, at the given offset.
+
+=head3 utime
+
+Arguments: Pathname, numeric actime, numeric modtime.
+Returns an errno.
+
+Called to change access/modification times for a file/directory/device/symlink.
+
+=head3 open
+
+Arguments: Pathname, numeric flags (which is an OR-ing of stuff like O_RDONLY
+and O_SYNC, constants you can import from POSIX).
+Returns an errno.
+
+No creation, or trunctation flags (O_CREAT, O_EXCL, O_TRUNC) will be passed to open().
+Your open() method needs only check if the operation is permitted for the given flags, and return 0 for success.
+
+=head3 read
+
+Arguments: Pathname, numeric requestedsize, numeric offset.
+Returns a numeric errno, or a string scalar with up to $requestedsize bytes of data.
+
+Called in an attempt to fetch a portion of the file.
+
+=head3 write
+
+Arguments: Pathname, scalar buffer, numeric offset. You can use length($buffer) to
+find the buffersize.
+Returns an errno.
+
+Called in an attempt to write (or overwrite) a portion of the file. Be prepared because $buffer could contain random binary data with NULLs and all sorts of other wonderful stuff.
+
+=head3 statfs
+
+Arguments: none
+Returns any of the following:
+
+-ENOANO()
+
+or
+
+$namelen, $files, $files_free, $blocks, $blocks_avail, $blocksize
+
+or
+
+-ENOANO(), $namelen, $files, $files_free, $blocks, $blocks_avail, $blocksize
+
+=head1 AUTHOR
+
+Mark Glines, E<lt>mark@glines.orgE<gt>
+
+=head1 SEE ALSO
+
+L<perl>, the FUSE documentation.
+
+=cut
--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#include <fuse.h>
+
+#undef DEBUGf
+#if 0
+#define DEBUGf(f, a...) fprintf(stderr, "%s:%d (%i): " f,__BASE_FILE__,__LINE__,PL_stack_sp-PL_stack_base ,##a )
+#else
+#define DEBUGf(a...)
+#endif
+
+SV *_PLfuse_callbacks[18];
+
+int _PLfuse_getattr(const char *file, struct stat *result) {
+ dSP;
+ int rv, statcount;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,strlen(file))));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[0],G_ARRAY);
+ SPAGAIN;
+ if(rv != 13) {
+ if(rv > 1) {
+ fprintf(stderr,"inappropriate number of returned values from getattr\n");
+ rv = -ENOSYS;
+ } else if(rv)
+ rv = POPi;
+ else
+ rv = -ENOENT;
+ } else {
+ result->st_blksize = POPi;
+ result->st_ctime = POPi;
+ result->st_mtime = POPi;
+ result->st_atime = POPi;
+ /* What the HELL? Perl says the blockcount is the last argument.
+ * Everything else says the blockcount is the last argument. So why
+ * was it folded into the middle of the list? */
+ result->st_blocks = POPi;
+ result->st_size = POPi;
+ result->st_rdev = POPi;
+ result->st_gid = POPi;
+ result->st_uid = POPi;
+ result->st_nlink = POPi;
+ result->st_mode = POPi;
+ /*result->st_ino =*/ POPi;
+ result->st_dev = POPi;
+ rv = 0;
+ }
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ return rv;
+}
+
+int _PLfuse_readlink(const char *file,char *buf,size_t buflen) {
+ int rv;
+ char *rvstr;
+ dSP;
+ I32 ax;
+ if(buflen < 1)
+ return EINVAL;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[1],G_SCALAR);
+ SPAGAIN;
+ if(!rv)
+ rv = -ENOENT;
+ else {
+ SV *mysv = POPs;
+ if(SvTYPE(mysv) == SVt_IV || SvTYPE(mysv) == SVt_NV)
+ rv = SvIV(mysv);
+ else {
+ strncpy(buf,SvPV_nolen(mysv),buflen);
+ rv = 0;
+ }
+ }
+ FREETMPS;
+ LEAVE;
+ buf[buflen-1] = 0;
+ PUTBACK;
+ return rv;
+}
+
+int _PLfuse_getdir(const char *file, fuse_dirh_t dirh, fuse_dirfil_t dirfil) {
+ int prv, rv;
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ PUTBACK;
+ prv = call_sv(_PLfuse_callbacks[2],G_ARRAY);
+ SPAGAIN;
+ if(prv) {
+ rv = POPi;
+ while(--prv)
+ dirfil(dirh,POPp,0);
+ } else {
+ fprintf(stderr,"getdir() handler returned nothing!\n");
+ rv = -ENOSYS;
+ }
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ return rv;
+}
+
+int _PLfuse_mknod (const char *file, mode_t mode, dev_t dev) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(mode)));
+ XPUSHs(sv_2mortal(newSViv(dev)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[3],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ return rv;
+}
+
+int _PLfuse_mkdir (const char *file, mode_t mode) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("mkdir begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(mode)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[4],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("mkdir end: %i %i\n",sp-PL_stack_base,rv);
+ return rv;
+}
+
+
+int _PLfuse_unlink (const char *file) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("unlink begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[5],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("unlink end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_rmdir (const char *file) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("rmdir begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[6],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("rmdir end: %i %i\n",sp-PL_stack_base,rv);
+ return rv;
+}
+
+int _PLfuse_symlink (const char *file, const char *new) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("symlink begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSVpv(new,0)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[7],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("symlink end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_rename (const char *file, const char *new) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("rename begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSVpv(new,0)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[8],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("rename end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_link (const char *file, const char *new) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("link begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSVpv(new,0)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[9],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("link end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_chmod (const char *file, mode_t mode) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("chmod begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(mode)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[10],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("chmod end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_chown (const char *file, uid_t uid, gid_t gid) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("chown begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(uid)));
+ XPUSHs(sv_2mortal(newSViv(gid)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[11],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("chown end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_truncate (const char *file, off_t off) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("truncate begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(off)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[12],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("truncate end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_utime (const char *file, struct utimbuf *uti) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("utime begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(uti->actime)));
+ XPUSHs(sv_2mortal(newSViv(uti->modtime)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[13],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("utime end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_open (const char *file, int flags) {
+ int rv;
+ SV *rvsv;
+ char *rvstr;
+ dSP;
+ DEBUGf("open begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(flags)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[14],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("open end: %i %i\n",sp-PL_stack_base,rv);
+ return rv;
+}
+
+int _PLfuse_read (const char *file, char *buf, size_t buflen, off_t off) {
+ int rv;
+ char *rvstr;
+ dSP;
+ DEBUGf("read begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSViv(buflen)));
+ XPUSHs(sv_2mortal(newSViv(off)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[15],G_SCALAR);
+ SPAGAIN;
+ if(!rv)
+ rv = -ENOENT;
+ else {
+ SV *mysv = POPs;
+ if(SvTYPE(mysv) == SVt_NV || SvTYPE(mysv) == SVt_IV)
+ rv = SvIV(mysv);
+ else {
+ if(SvPOK(mysv)) {
+ rv = SvCUR(mysv);
+ } else {
+ rv = 0;
+ }
+ if(rv > buflen)
+ croak("read() handler returned more than buflen! (%i > %i)",rv,buflen);
+ if(rv)
+ memcpy(buf,SvPV_nolen(mysv),rv);
+ }
+ }
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("read end: %i %i\n",sp-PL_stack_base,rv);
+ return rv;
+}
+
+int _PLfuse_write (const char *file, const char *buf, size_t buflen, off_t off) {
+ int rv;
+ char *rvstr;
+ dSP;
+ DEBUGf("write begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSVpv(file,0)));
+ XPUSHs(sv_2mortal(newSVpvn(buf,buflen)));
+ XPUSHs(sv_2mortal(newSViv(off)));
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[16],G_SCALAR);
+ SPAGAIN;
+ if(rv)
+ rv = POPi;
+ else
+ rv = 0;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("write end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+int _PLfuse_statfs (const char *file, struct statfs *st) {
+ int rv;
+ char *rvstr;
+ dSP;
+ DEBUGf("statfs begin: %i\n",sp-PL_stack_base);
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ PUTBACK;
+ rv = call_sv(_PLfuse_callbacks[17],G_ARRAY);
+ SPAGAIN;
+ if(rv > 5) {
+ st->f_bsize = POPi;
+ st->f_bfree = POPi;
+ st->f_blocks = POPi;
+ st->f_ffree = POPi;
+ st->f_files = POPi;
+ st->f_namelen = POPi;
+ if(rv > 6)
+ rv = POPi;
+ else
+ rv = 0;
+ } else
+ if(rv > 1)
+ croak("inappropriate number of returned values from statfs");
+ else
+ if(rv)
+ rv = POPi;
+ else
+ rv = -ENOSYS;
+ FREETMPS;
+ LEAVE;
+ PUTBACK;
+ DEBUGf("statfs end: %i\n",sp-PL_stack_base);
+ return rv;
+}
+
+struct fuse_operations _available_ops = {
+getattr: _PLfuse_getattr,
+ _PLfuse_readlink,
+ _PLfuse_getdir,
+ _PLfuse_mknod,
+ _PLfuse_mkdir,
+ _PLfuse_unlink,
+ _PLfuse_rmdir,
+ _PLfuse_symlink,
+ _PLfuse_rename,
+ _PLfuse_link,
+ _PLfuse_chmod,
+ _PLfuse_chown,
+ _PLfuse_truncate,
+ _PLfuse_utime,
+ _PLfuse_open,
+ _PLfuse_read,
+ _PLfuse_write,
+ _PLfuse_statfs
+};
+
+MODULE = Fuse PACKAGE = Fuse
+PROTOTYPES: DISABLE
+
+void
+perl_fuse_main(...)
+ PREINIT:
+ struct fuse_operations fops = {NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL};
+ int i, fd, varnum = 0, debug, have_mnt;
+ char *mountpoint;
+ STRLEN n_a;
+ STRLEN l;
+ INIT:
+ if(items != 20) {
+ fprintf(stderr,"Perl<->C inconsistency or internal error\n");
+ XSRETURN_UNDEF;
+ }
+ CODE:
+ debug = SvIV(ST(0));
+ mountpoint = SvPV_nolen(ST(1));
+ /* FIXME: reevaluate multithreading support when perl6 arrives */
+ for(i=0;i<18;i++) {
+ SV *var = ST(i+2);
+ if((var != &PL_sv_undef) && SvROK(var)) {
+ if(SvTYPE(SvRV(var)) == SVt_PVCV) {
+ void **tmp1 = (void**)&_available_ops, **tmp2 = (void**)&fops;
+ tmp2[i] = tmp1[i];
+ _PLfuse_callbacks[i] = var;
+ } else
+ croak("arg is not a code reference!");
+ }
+ }
+ /* FIXME: need to pass fusermount arguments */
+ fd = fuse_mount(mountpoint,NULL);
+ if(fd < 0)
+ croak("could not mount fuse filesystem!");
+ fuse_loop(fuse_new(fd,debug ? "debug" : NULL,&fops));
--- /dev/null
+Changes
+Fuse.pm
+Fuse.xs
+Makefile.PL
+MANIFEST
+README
+test.pl
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'Fuse',
+ 'VERSION_FROM' => 'Fuse.pm', # finds $VERSION
+ 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'Fuse.pm', # retrieve abstract from module
+ AUTHOR => 'Mark Glines <mark@glines.org>') : ()),
+ 'LIBS' => [''], # e.g., '-lm'
+ 'DEFINE' => '-g -ggdb', # e.g., '-DHAVE_SOMETHING'
+ # Insert -I. if you add *.h files later:
+ 'INC' => '-I../include', # e.g., '-I/usr/include/other'
+ # Un-comment this if you add C files to link with later:
+ 'OBJECT' => 'Fuse.o ../lib/.libs/libfuse.a -lpthread', # link all the C files too
+);
--- /dev/null
+Fuse version 0.03
+=================
+
+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 standard commands as root:
+
+ perl Makefile.PL
+ make
+ 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>,
+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
+and unmount loopback.pl, and all of the base-level functions have test
+scripts. These need to be fleshed out as problems are noticed.
+
+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:
+* "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
+
--- /dev/null
+#!/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
+);
--- /dev/null
+#!/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,
+);
--- /dev/null
+#!/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);
--- /dev/null
+#!/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;
+}
--- /dev/null
+#!/usr/bin/perl
+BEGIN { $ENV{HARNESS_IGNORE_EXITCODE} = 1; }
+
+use Test::Harness qw(&runtests $verbose);
+$verbose=0;
+die "cannot find test directory!" unless -d "test";
+my (@files) = <test/*.t>;
+runtests("test/s/mount.t",sort(@files),"test/s/umount.t");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 4;
+chdir($_point);
+system("echo frog >file");
+ok(chmod(0644,"file"),"set unexecutable");
+ok(!-x "file","unexecutable");
+ok(chmod(0755,"file"),"set executable");
+ok(-x "file","executable");
+unlink("file");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 4;
+my (@stat);
+chdir($_point);
+system("echo frog >file");
+ok(chown(0,0,"file"),"set 0,0");
+@stat = stat("file");
+ok($stat[4] == 0 && $stat[5] == 0,"0,0");
+ok(chown(1,1,"file"),"set 1,1");
+@stat = stat("file");
+ok($stat[4] == 1 && $stat[5] == 1,"1,1");
+unlink("file");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+use Data::Dumper;
+plan tests => 28;
+my ($a, $b) = ("$_real/wibble","$_point/wibble");
+`touch $b`;
+is(-A "$a", -A "$b", '-A'); # 1
+is(-B "$a", -B "$b", '-B'); # 2
+is(-C "$a", -C "$b", '-C'); # 3
+is(-M "$a", -M "$b", '-M'); # 4
+is(-O "$a", -O "$b", '-O'); # 5
+is(-R "$a", -R "$b", '-R'); # 6
+is(-S "$a", -S "$b", '-S'); # 7
+is(-T "$a", -T "$b", '-T'); # 8
+is(-W "$a", -W "$b", '-W'); # 9
+is(-X "$a", -X "$b", '-X'); # 10
+is(-b "$a", -b "$b", '-b'); # 11
+is(-c "$a", -c "$b", '-c'); # 12
+is(-d "$a", -d "$b", '-d'); # 13
+is(-e "$a", -e "$b", '-e'); # 14
+is(-f "$a", -f "$b", '-f'); # 15
+is(-g "$a", -g "$b", '-g'); # 16
+is(-k "$a", -k "$b", '-k'); # 17
+is(-l "$a", -l "$b", '-l'); # 18
+is(-o "$a", -o "$b", '-o'); # 19
+is(-p "$a", -p "$b", '-p'); # 20
+is(-r "$a", -r "$b", '-r'); # 21
+is(-s "$a", -s "$b", '-s'); # 22
+is(-t "$a", -t "$b", '-t'); # 23
+is(-u "$a", -u "$b", '-u'); # 24
+is(-w "$a", -w "$b", '-w'); # 25
+is(-x "$a", -x "$b", '-x'); # 26
+is(-z "$a", -z "$b", '-z'); # 27
+my (@astat, @bstat);
+@astat = stat("$a");
+@bstat = stat("$b");
+# dev and inode can legally change
+shift(@astat); shift(@astat);
+shift(@bstat); shift(@bstat);
+is(join(" ",@astat),join(" ",@bstat),"stat()");
+`rm -f $a`;
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+my (@names) = qw(abc def ghi jkl mno pqr stu jlk sfdaljk sdfakjlsdfa kjldsf kjl;sdf akjl;asdf klj;asdf lkjsdflkjsdfkjlsdfakjsdfakjlsadfkjl;asdfklj;asdfkjl;asdfklj;asdfkjl;asdfkjlasdflkj;sadf);
+@names = sort(@names);
+plan tests => 2 * scalar @names;
+chdir($_real);
+
+# create entries
+map { system("touch \"$_\"") } @names;
+
+# make sure they exist in real dir
+opendir(REAL,$_real);
+my (@ents) = readdir(REAL);
+closedir(REAL);
+@ents = sort(@ents);
+map {
+ shift(@ents) while($ents[0] eq '.' || $ents[0] eq '..');
+ is(shift(@ents),$_,"ent $_")
+} @names;
+
+# make sure they exist in fuse dir
+opendir(POINT,$_point);
+@ents = readdir(POINT);
+closedir(POINT);
+@ents = sort(@ents);
+map {
+ shift(@ents) while($ents[0] eq '.' || $ents[0] eq '..');
+ is(shift(@ents),$_,"ent $_")
+} @names;
+
+# remove them
+map { unlink } @names;
--- /dev/null
+#!/usr/bin/perl
+package test::helper;
+use strict;
+use Exporter;
+our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+@ISA = "Exporter";
+@EXPORT_OK = qw($_loop $_point $_pidfile $_real);
+our($_loop, $_point, $_pidfile, $_real) = ("examples/loopback.pl","/mnt","test/s/mounted.pid","/tmp/fusetest");
+if($0 !~ qr|s/u?mount\.t$|) {
+ my ($reject) = 1;
+ if(-f $_pidfile) {
+ unless(system("ps `cat $_pidfile` | grep \"$_loop $_point\" >/dev/null")>>8) {
+ if(`mount | grep "on $_point"`) {
+ $reject = 0;
+ } else {
+ system("kill `cat $_pidfile`");
+ }
+ }
+ }
+ $reject = 1 if (system("ls $_point >&/dev/null") >> 8);
+ die "not properly mounted\n" if $reject;
+}
+1;
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 8;
+chdir($_point);
+system("echo hippity >womble");
+ok(-f "womble","exists");
+ok(!-f "rabbit","target file doesn't exist");
+is(-s "womble",8,"right size");
+ok(link("womble","rabbit"),"link");
+ok(-f "womble","old file exists");
+ok(-f "rabbit","target file exists");
+is(-s "womble",8,"right size");
+is(-s "rabbit",8,"right size");
+unlink("womble");
+unlink("rabbit");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 3;
+chdir($_point);
+ok(mkdir("dir"),"mkdir");
+ok(-d "dir","dir exists");
+chdir($_real);
+ok(-d "dir","dir really exists");
+chdir($_point);
+rmdir("dir");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 24;
+my (@stat);
+chdir($_point);
+ok(!(system("touch reg" )>>8),"create normal file");
+ok(!(system("mknod chr c 2 3")>>8),"create chrdev");
+ok(!(system("mknod blk b 2 3")>>8),"create blkdev");
+ok(!(system("mknod fifo p" )>>8),"create fifo");
+chdir($_real);
+ok(-e "reg" ,"normal file exists");
+ok(-e "chr" ,"chrdev exists");
+ok(-e "blk" ,"blkdev exists");
+ok(-e "fifo","fifo exists");
+ok(-f "reg" ,"normal file is normal file");
+ok(-c "chr" ,"chrdev is chrdev");
+ok(-b "blk" ,"blkdev is blkdev");
+ok(-p "fifo","fifo is fifo");
+@stat = stat("chr");
+is($stat[6],3+(2<<8),"chrdev has right major,minor");
+@stat = stat("blk");
+is($stat[6],3+(2<<8),"blkdev has right major,minor");
+chdir($_point);
+ok(-e "reg" ,"normal file exists");
+ok(-e "chr" ,"chrdev exists");
+ok(-e "blk" ,"blkdev exists");
+ok(-e "fifo","fifo exists");
+ok(-f "reg" ,"normal file is normal file");
+ok(-c "chr" ,"chrdev is chrdev");
+ok(-b "blk" ,"blkdev is blkdev");
+ok(-p "fifo","fifo is fifo");
+@stat = stat("chr");
+is($stat[6],3+(2<<8),"chrdev has right major,minor");
+@stat = stat("blk");
+is($stat[6],3+(2<<8),"blkdev has right major,minor");
+map { unlink } qw(reg chr blk fifo);
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 1;
+chdir($_real);
+system("echo frog >file");
+chdir($_point);
+ok(open(FILE,"file"),"open");
+close(FILE);
+unlink("file");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 3;
+chdir($_real);
+system("echo frog >file");
+chdir($_point);
+ok(open(FILE,"file"),"open");
+my ($data) = <FILE>;
+close(FILE);
+is(length($data),5,"right amount read");
+is($data,"frog\n","right data read");
+unlink("file");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_point $_real);
+use Test::More;
+plan tests => 4;
+chdir($_real);
+ok(symlink("abc","def"),"OS supports symlinks");
+is(readlink("def"),"abc","OS supports symlinks");
+chdir($_point);
+ok(-l "def","symlink exists");
+is(readlink("def"),"abc","readlink");
+unlink("def");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 5;
+chdir($_point);
+system("echo hippity >frog");
+ok(-f "frog","exists");
+ok(!-f "toad","target file doesn't exist");
+ok(rename("frog","toad"),"rename");
+ok(!-f "frog","old file doesn't exist");
+ok(-f "toad","target file exists");
+unlink("toad");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 5;
+chdir($_real);
+ok(mkdir("dir"),"mkdir");
+ok(-d "dir","dir really exists");
+chdir($_point);
+ok(-d "dir","dir exists");
+rmdir("dir");
+ok(! -d "dir","dir removed");
+chdir($_real);
+ok(! -d "dir","dir really removed");
--- /dev/null
+#!/usr/bin/perl -w
+use test::helper qw($_point $_loop $_real $_pidfile);
+use strict;
+use Test::More tests => 3;
+ok(!(scalar grep(/ on $_point /,`cat /proc/mounts`)),"already mounted");
+ok(-f $_loop,"loopback exists");
+
+if(!fork()) {
+ #close(STDIN);
+ close(STDOUT);
+ close(STDERR);
+ `echo $$ >test/s/mounted.pid`;
+ exec("perl $_loop $_point");
+ exit(1);
+}
+select(undef, undef, undef, 0.5);
+my ($success) = `cat /proc/mounts` =~ / $_point /;
+ok($success,"mount succeeded");
+system("rm -rf $_real");
+unless($success) {
+ kill('INT',`cat $_pidfile`);
+ unlink($_pidfile);
+} else {
+ mkdir($_real);
+}
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_point $_real $_pidfile);
+use strict;
+use Test::More tests => 1;
+system("umount $_point");
+ok(1,"unmount");
+system("rm -rf $_real $_pidfile");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+require 'syscall.ph'; # for SYS_statfs
+plan tests => 7;
+my ($statfs_data) = " " x 10;
+my ($tmp) = $_point;
+ok(!syscall(&SYS_statfs,$tmp,$statfs_data),"statfs");
+# FIXME: this is soooooo linux-centric. perhaps parse the output of /bin/df?
+my @list = unpack("LSSL8",$statfs_data);
+shift(@list);
+is(shift(@list),4096,"block size");
+shift(@list);
+is(shift(@list),1000000,"blocks");
+is(shift(@list),500000,"blocks free");
+shift(@list);
+is(shift(@list),1000000,"files");
+is(shift(@list),500000,"files free");
+shift(@list);
+shift(@list);
+is(shift(@list),255,"namelen");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_point $_real);
+use Test::More;
+plan tests => 6;
+chdir($_point);
+ok(symlink("abc","def"),"symlink created");
+ok(-l "def","symlink exists");
+is(readlink("def"),"abc","it worked");
+chdir($_real);
+ok(-l "def","symlink really exists");
+is(readlink("def"),"abc","really worked");
+unlink("def");
+
+# bug: doing a 'cp -a' on a directory which contains a symlink
+# reports an error
+mkdir("dira");
+system("cd dira; touch filea; ln -s filea fileb");
+is(system("cp -a dira dirb")>>8,0,"cp -a");
+system("rm -rf dira dirb");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 1;
+ok(1);
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 5;
+chdir($_point);
+system("echo hippity >womble");
+ok(-f "womble","exists");
+is(-s "womble",8,"right size");
+ok(truncate("womble",4),"truncate");
+ok(-f "womble","file exists");
+is(-s "womble",4,"right size");
+unlink("womble");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 4;
+chdir($_point);
+system("touch file");
+ok(-f "file","file exists");
+chdir($_real);
+ok(-f "file","file really exists");
+chdir($_point);
+unlink("file");
+ok(! -f "file","file unlinked");
+chdir($_real);
+ok(! -f "file","file really unlinked");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 3;
+my (@stat);
+chdir($_real);
+system("echo frog >file");
+chdir($_point);
+ok(utime(1,2,"file"),"set utime");
+@stat = stat("file");
+is($stat[8],1,"atime");
+is($stat[9],2,"mtime");
+unlink("file");
--- /dev/null
+#!/usr/bin/perl
+use test::helper qw($_real $_point);
+use Test::More;
+plan tests => 15;
+my ($data);
+chdir($_point);
+undef $/; # slurp it all
+# create file
+system("echo frogbing >writefile");
+
+# fetch contents of file
+ok(open(FILE,"writefile"),"open");
+$data = <FILE>;
+close(FILE);
+is(length($data),9,"right amount read");
+is($data,"frogbing\n","right data read");
+
+# overwrite part
+ok(open(FILE,'+<',"writefile"),"open");
+ok(seek(FILE,2,0),"seek");
+ok(print(FILE "ib"),"print");
+close(FILE);
+
+# fetch contents of file
+ok(open(FILE,"writefile"),"open");
+$data = <FILE>;
+close(FILE);
+is(length($data),9,"right amount read");
+is($data,"fribbing\n","right data read");
+
+# overwrite part, append some
+ok(open(FILE,'+<',"writefile"),"open");
+ok(seek(FILE,7,0),"seek");
+ok(print(FILE "gle"),"print");
+close(FILE);
+
+# fetch contents of file
+ok(open(FILE,"writefile"),"open");
+$data = <FILE>;
+close(FILE);
+is(length($data),10,"right amount read");
+is($data,"fribbingle","right data read");
+
+# kill file
+unlink("writefile");
projects / perl-fuse.git / commitdiff