diff options
Diffstat (limited to 'perl')
35 files changed, 0 insertions, 1908 deletions
diff --git a/perl/.cvsignore b/perl/.cvsignore deleted file mode 100644 index 5d5c2dc..0000000 --- a/perl/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -Fuse.bs Fuse.c Makefile blib pm_to_blib diff --git a/perl/AUTHORS b/perl/AUTHORS deleted file mode 100644 index d0b568c..0000000 --- a/perl/AUTHORS +++ /dev/null @@ -1,4 +0,0 @@ -Perl bindings -------------- - -Mark Glines <mark@glines.org> diff --git a/perl/Changes b/perl/Changes deleted file mode 100644 index 56b4733..0000000 --- a/perl/Changes +++ /dev/null @@ -1,12 +0,0 @@ -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 diff --git a/perl/Fuse.pm b/perl/Fuse.pm deleted file mode 100644 index 6a01677..0000000 --- a/perl/Fuse.pm +++ /dev/null @@ -1,360 +0,0 @@ -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 diff --git a/perl/Fuse.xs b/perl/Fuse.xs deleted file mode 100644 index 233139a..0000000 --- a/perl/Fuse.xs +++ /dev/null @@ -1,572 +0,0 @@ -#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)); diff --git a/perl/MANIFEST b/perl/MANIFEST deleted file mode 100644 index 3012c02..0000000 --- a/perl/MANIFEST +++ /dev/null @@ -1,7 +0,0 @@ -Changes -Fuse.pm -Fuse.xs -Makefile.PL -MANIFEST -README -test.pl diff --git a/perl/Makefile.PL b/perl/Makefile.PL deleted file mode 100644 index 6e66f46..0000000 --- a/perl/Makefile.PL +++ /dev/null @@ -1,17 +0,0 @@ -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 -); diff --git a/perl/README b/perl/README deleted file mode 100644 index fb49cd7..0000000 --- a/perl/README +++ /dev/null @@ -1,69 +0,0 @@ -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 - 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; -} diff --git a/perl/test.pl b/perl/test.pl deleted file mode 100644 index e8152fd..0000000 --- a/perl/test.pl +++ /dev/null @@ -1,8 +0,0 @@ -#!/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"); diff --git a/perl/test/chmod.t b/perl/test/chmod.t deleted file mode 100644 index 366f89b..0000000 --- a/perl/test/chmod.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/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"); diff --git a/perl/test/chown.t b/perl/test/chown.t deleted file mode 100644 index 8ccbb88..0000000 --- a/perl/test/chown.t +++ /dev/null @@ -1,14 +0,0 @@ -#!/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"); diff --git a/perl/test/getattr.t b/perl/test/getattr.t deleted file mode 100644 index 4203275..0000000 --- a/perl/test/getattr.t +++ /dev/null @@ -1,42 +0,0 @@ -#!/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`; diff --git a/perl/test/getdir.t b/perl/test/getdir.t deleted file mode 100644 index 1d60561..0000000 --- a/perl/test/getdir.t +++ /dev/null @@ -1,33 +0,0 @@ -#!/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; diff --git a/perl/test/helper.pm b/perl/test/helper.pm deleted file mode 100644 index cd2bd55..0000000 --- a/perl/test/helper.pm +++ /dev/null @@ -1,23 +0,0 @@ -#!/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; diff --git a/perl/test/link.t b/perl/test/link.t deleted file mode 100644 index 391b2f0..0000000 --- a/perl/test/link.t +++ /dev/null @@ -1,16 +0,0 @@ -#!/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"); diff --git a/perl/test/mkdir.t b/perl/test/mkdir.t deleted file mode 100644 index 90ec6f3..0000000 --- a/perl/test/mkdir.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/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"); diff --git a/perl/test/mknod.t b/perl/test/mknod.t deleted file mode 100644 index 35c5c82..0000000 --- a/perl/test/mknod.t +++ /dev/null @@ -1,37 +0,0 @@ -#!/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); diff --git a/perl/test/open.t b/perl/test/open.t deleted file mode 100644 index 030dc1f..0000000 --- a/perl/test/open.t +++ /dev/null @@ -1,10 +0,0 @@ -#!/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"); diff --git a/perl/test/read.t b/perl/test/read.t deleted file mode 100644 index 5eca920..0000000 --- a/perl/test/read.t +++ /dev/null @@ -1,13 +0,0 @@ -#!/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"); diff --git a/perl/test/readlink.t b/perl/test/readlink.t deleted file mode 100644 index 85b9ffc..0000000 --- a/perl/test/readlink.t +++ /dev/null @@ -1,11 +0,0 @@ -#!/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"); diff --git a/perl/test/rename.t b/perl/test/rename.t deleted file mode 100644 index 9fbb330..0000000 --- a/perl/test/rename.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/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"); diff --git a/perl/test/rmdir.t b/perl/test/rmdir.t deleted file mode 100644 index 36f0378..0000000 --- a/perl/test/rmdir.t +++ /dev/null @@ -1,13 +0,0 @@ -#!/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"); diff --git a/perl/test/s/mount.t b/perl/test/s/mount.t deleted file mode 100644 index 26f6fc2..0000000 --- a/perl/test/s/mount.t +++ /dev/null @@ -1,25 +0,0 @@ -#!/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); -} diff --git a/perl/test/s/umount.t b/perl/test/s/umount.t deleted file mode 100644 index da60677..0000000 --- a/perl/test/s/umount.t +++ /dev/null @@ -1,7 +0,0 @@ -#!/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"); diff --git a/perl/test/statfs.t b/perl/test/statfs.t deleted file mode 100644 index fb94704..0000000 --- a/perl/test/statfs.t +++ /dev/null @@ -1,21 +0,0 @@ -#!/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"); diff --git a/perl/test/symlink.t b/perl/test/symlink.t deleted file mode 100644 index 19cc72d..0000000 --- a/perl/test/symlink.t +++ /dev/null @@ -1,19 +0,0 @@ -#!/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"); diff --git a/perl/test/test-template b/perl/test/test-template deleted file mode 100644 index ef57e08..0000000 --- a/perl/test/test-template +++ /dev/null @@ -1,5 +0,0 @@ -#!/usr/bin/perl -use test::helper qw($_real $_point); -use Test::More; -plan tests => 1; -ok(1); diff --git a/perl/test/truncate.t b/perl/test/truncate.t deleted file mode 100644 index 8607421..0000000 --- a/perl/test/truncate.t +++ /dev/null @@ -1,12 +0,0 @@ -#!/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"); diff --git a/perl/test/unlink.t b/perl/test/unlink.t deleted file mode 100644 index eef8c1a..0000000 --- a/perl/test/unlink.t +++ /dev/null @@ -1,14 +0,0 @@ -#!/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"); diff --git a/perl/test/utime.t b/perl/test/utime.t deleted file mode 100644 index 8ccefc6..0000000 --- a/perl/test/utime.t +++ /dev/null @@ -1,13 +0,0 @@ -#!/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"); diff --git a/perl/test/write.t b/perl/test/write.t deleted file mode 100644 index 58af2aa..0000000 --- a/perl/test/write.t +++ /dev/null @@ -1,45 +0,0 @@ -#!/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"); |