#!/usr/bin/perl

use strict;
use Fuse;
use POSIX;
use Unix::Syslog qw/:macros :subs/;
use threads;
use threads::shared;
use Fcntl qw(:DEFAULT :flock);
require "syscall.ph";

#######################
### Parameters
#######################
my $max_tombstone_age = 60*60*24*3; # in seconds
my $rsync = "/usr/bin/rsync";
my $rsync_parameters = "-daHAXxv --no-r"; # Some non-standard options in there.

#######################
### Main function
#######################
my @mountopts;
my $debug = 0;
my $threaded = 0;
my $source;
my $mountpoint;
grep
{
  if($_ eq "-d") { $debug = 1; }
  if($_ eq "-n") { push @mountopts, "nonempty"; }
  if($_ eq "-t") { $threaded = 1; }
  if($_ =~ /^\//)
  {
    if(!$source) { $source = $_; }
    else { $mountpoint = $_; }
  }
} @ARGV;
if($> == 0) { push @mountopts, "allow_other"; }
#push @mountopts, "use_ino";
if(!$mountpoint || !$source)
{
  print
  "Usage:  lmfs.pl /source1[:/source2...] /mountpoint [-d] [-n] [-t]\n".
  "    Source directories are a colon-separated list of absolute paths.\n".
  "    The mountpoint must also be absolute.\n".
  "    -d     Debug mode.  Way more data than you'd like will be spit\n".
  "           to the console.\n".
  "    -n     Non-Empty.  Will allow you to mount on a non-empty directory.\n".
  "    -t     Threaded mode.\n".
  "To unmount, run:  fusermount -u /mountpoint\n".
  "Even if the lmfs.pl process is killed, you must still unmount with fusermount.\n";
  exit 1;
}

my @sourcedirs = split ":", $source;
## Let's scrub the sourcedirs to make sure they aren't harmful
grep{ $_ =~ s/\/$//; } @sourcedirs;
my @tmp;
push @tmp, @sourcedirs;
for(my $x = @tmp-1;$x >= 0; $x--)
{
  my $mp = $mountpoint;
  $mp =~ s/\/$//;
  quotemeta $mp;
  if($tmp[$x] eq '' || $tmp[$x] =~ /^$mp\//)
  {
    &log(LOG_WARNING, "$tmp[$x]: Invalid source path");
    splice @tmp, $x;
  }
  else
  {
    grep
    {
      my $path = $_;
      if($_)
      {
        quotemeta $path;
        if($tmp[$x] =~ /^$path\//)
        {
          &log(LOG_WARNING, "$tmp[$x]: Invalid source path");
          splice @tmp, $x;
        }
      }
    } @sourcedirs;
  }
}
my %tmp = map { $_, 0 } @tmp;
@sourcedirs = keys %tmp;
my $src_ok;
grep
{
  if(-f "$_/.lmfs/signature")
  { $src_ok = 1; }
} @sourcedirs;
if(!$src_ok)
{
  print
  "No signature found.\n".
  "Every source directory must have a matching signature stored in /.lmfs/signature\n".
  "To create one:\n".
  "   mkdir -p /src1/.lmfs\n".
  "   echo 'MyMirrorSignature' > /src1/.lmfs/signature\n".
  "   cp -R /src1/.lmfs /src2\n";
  exit 1;
}
my $signature : shared;
my @descriptors : shared;

Fuse::main(mountpoint=>$mountpoint
	,"debug"=>$debug
	,"threaded"=>$threaded
	,"mountopts"=>join(",",@mountopts)
	,"getattr"=>"main::lmfs_getattr"
	,"readlink"=>"main::lmfs_readlink"
	,"getdir"=>"main::lmfs_getdir"
	,"mknod"=>"main::lmfs_mknod"
	,"mkdir"=>"main::lmfs_mkdir"
	,"unlink"=>"main::lmfs_unlink"
	,"rmdir"=>"main::lmfs_rmdir"
	,"symlink"=>"main::lmfs_symlink"
	,"rename"=>"main::lmfs_rename"
	,"link"=>"main::lmfs_link"
	,"chmod"=>"main::lmfs_chmod"
	,"chown"=>"main::lmfs_chown"
	,"truncate"=>"main::lmfs_truncate"
	,"utime"=>"main::lmfs_utime"
	,"open"=>"main::lmfs_open"
	,"read"=>"main::lmfs_read"
	,"write"=>"main::lmfs_write"
	,"statfs"=>"main::lmfs_statfs"
	,"flush"=>"main::lmfs_flush"
	,"release"=>"main::lmfs_release"
	,"fsync"=>"main::lmfs_fsync"
	,"setxattr"=>"main::lmfs_setxattr"
	,"getxattr"=>"main::lmfs_getxattr"
	,"listxattr"=>"main::lmfs_listxattr"
	,"removexattr"=>"main::lmfs_removexattr"
	,"lock"=>"main::lmfs_lock"
	,"access"=>"main::lmfs_access"
	);
exit;

###############################
## Internal functions
###############################

sub log
{
  # level, message;
  my $level = shift;
  my $msg = shift;
  Unix::Syslog::openlog("LMFS", undef, LOG_LOCAL7);
  Unix::Syslog::syslog($level, $msg);
  Unix::Syslog::closelog;
}

sub getfd
{ # Takes a fileh and returns an array of real file descriptors
  my $fileh = shift;
  lock(@descriptors);
  my @fd;
  grep
  {
    push @fd, $_;
  } @{$descriptors[$fileh]{"fd"}};
  grep { $_ += 0; } @fd;
  return @fd;
}

sub gethash
{ # Takes a path to a file, and returns a string with encoded information about the file.
  # The return value is a : and ; -separated string with the following fields:
  #	0 path		Full path to the file
  #	1 mode		file mode  (type and permissions)
  #	2 uid		numeric user ID of file’s owner
  #	3 gid		numeric group ID of file’s owner
  #	4 size		total size of file, in bytes
  #	5 mtime		last modify time in seconds since the epoch
  # Note that this is not a complete list of 'stat' output.  File path is added, and system/device dependent info is removed.
  # Path is followed by a :, each other field is followed by a ;
  # This is to ease in comparison.  To compare the hashes of two files, remove everything up to the : and the rest should match.
  my $path = shift;
  my @stat = lstat($path);
  if(!@stat){ @stat = (0,0,0,0,0,0,0,0,0,0); }
  return "$path:$stat[2];$stat[4];$stat[5];$stat[7];$stat[9]";
}

sub tombstone
{ # Takes a path (relative to the mountpoint) and records it as deleted in /.lmfs/tombstones
  # If that file is found on any sources with a timestamp older than the delete, it
  # will be deleted.  If it has a newer stamp, it will be cloned as usual and the
  # tombstone removed.
  my $path = shift;
  if($path eq "/.lmfs/tombstones"){return}
  grep
  {
    if(&verify($_))
    {
      open my $fh, ">>$_/.lmfs/tombstones";
      flock($fh, LOCK_EX);
      print $fh "$path:0;0;0;tombstone;".time."\n";
      close $fh;
    }
  } @sourcedirs;
}

sub scavenge
{ # Make sure tombstone files are up to date.  A simple
  # replace isn't good enough here, so we'll merge all the entries.
  # If a hash is sent in, it will be removed from the list.
  # Hashes will also be removed for timeout.
  my $scv = shift;
  my $path = "/.lmfs/tombstones";
  my @hashes;
  my @fullpaths;
  grep
  {
    if(&verify($_))
    {
      my $full = $_.$path;
      my $hash = &gethash($full);
      push @hashes, $hash;
      push @fullpaths, $full;
    }
  } @sourcedirs;
  @fullpaths = sort @fullpaths; # This should (hopefully) prevent deadlock races
			        # by ensuring that every instance will lock in the
				# same order.
  @hashes = sort
  	{
	  my @aa = split(/[;:]/,$a);
	  my @bb = split(/[;:]/,$b);
	  $bb[5] cmp $aa[5];
	} @hashes;
  my $cutoff = time - $max_tombstone_age;
  my @unique;
  grep
  {
    my %hash;
    ($hash{'file'}, $hash{'hash'}) = split(":", $_);
    if(!@unique){ push @unique, \%hash; }
    elsif(${$unique[@unique-1]}{'hash'} ne $hash{'hash'}){ push @unique, \%hash; }
  } @hashes;
  if(@unique == 1 &! $scv){return}
  &log(LOG_INFO, "Updating tombstones list");
  my @tomb;
  my %fh;
  grep
  {
    open my $f, "+<$_";
    flock($f, LOCK_EX);
    push @tomb, <$f>;
    $fh{$_} = $f;
  } @fullpaths;
  my %u = map { $_, 0 } @tomb;
  delete $u{$scv."\n"};
  my @a = keys(%u);
  @a = grep{my @b = split(/[:;]/, $_);if($b[5] < $cutoff){0}else{1}} @a;
  my $t = join("", $a);
  grep
  {
    my $f = $fh{$_};
    seek($f, 0, SEEK_SET);
    truncate($f, 0);
    print $f $t;
    close $f;
  } @fullpaths;
}

sub gettombstone
{ # Returns a tombstone that matches the given path, if it exists.
  # First it ensures that all sources contain up-to-date tombstone files.
  my $path = shift;
  if($path eq "/.lmfs/tombstones"){return}
  my $ret;
  &scavenge();
  my $fh;
  grep
  {
    if(!$fh)
    {
      open $fh, "<$_/.lmfs/tombstones";
    }
  } @sourcedirs;
  if($fh){ flock($fh, LOCK_SH); }
  else{ return }
  my $scav;
  my $cutoff = time - $max_tombstone_age;
  while(my $line = <$fh> &! $ret)
  {
    my @t = split(/[:;]/, $line);
    if($t[5] < $cutoff){$scav = $line}
    if($t[0] eq $path)
    {
      $ret = $line;
    }
  }
  close $fh;
  if($scav){&scavenge($scav)}
  return $ret;
}

sub verify
{ # Read the signature from /.lmfs/signature
  # Compare it against $signature (or fill in $signature if null) to see
  # if this source is a valid member of our mirror.
  my $path = shift;
  $! = 0;
  my $ret = open my $fh, "<$path/.lmfs/signature";
  if(!$ret)
  {
    &log(LOG_WARNING, "$path/.lmfs/signature: $!");
    return 0;
  }
  my $sig = <$fh>;
  close $fh;
  if($signature eq $sig){ return 1; }
  if(!$signature)
  {
    $signature = $sig;
    &log(LOG_INFO, "Assigning signature '$signature' to '$mountpoint'");
    return 1;
  }
  &log(LOG_WARNING, "Signature for '$path' ($sig) does not match '$signature'");
  return 0;
}

sub getpath
{ # Takes a path relative to our mount, and returns a list of real paths.
  # This is a good place for checking all copies are up to date.
  my $path = shift;
  if($path =~ /^\/.lmfs(\/.*)?$/){return}
  $path =~ s/\/\//\//;
  my @fullpaths;
  my @hashes;
  grep
  {
    if(&verify($_))
    {
      my $full = $_.$path;
      my $hash = &gethash($full);
      push @hashes, $hash;
      push @fullpaths, $full;
    }
  } @sourcedirs;
  my $ts = &gettombstone($path);
  if($ts){ push @hashes, $ts; }
  if($path ne "/" && $path !~ /^\/\.lmfs\//)
  {
    @hashes = sort
  	{
	  my @aa = split(/[;:]/,$a);
	  my @bb = split(/[;:]/,$b);
	  $bb[5] cmp $aa[5];
	} @hashes;
    my ($srcpath, $srchash) = split(":",$hashes[0]);
    if($srchash !~ /0;0$/)
    {
      for(my $x=@hashes-1;$x > 0;$x--)
      {
        my ($dstpath, $hash) = split(":",$hashes[$x]);
        if($hash ne $srchash)
        {
          if($srchash =~ /tombstone/) # Most recent is a delete
          {
            if($hash !~ /0;0$/) # This file still exists
	    {
	      if(-d $dstpath){ rmdir($dstpath);}
	      else{ unlink($dstpath);}
            }
	  }
	  else
	  {
	    if($hash =~ /tombstone/)
	    { &scavenge("$dstpath:$hash"); }
	    else
	    {
              # Need to copy srcpath to path
              &clone($srcpath,$dstpath);
            }
	  }
	}
      }
    }
  }
  return @fullpaths;
}

sub clone
{ # copy source to dest, including times, permissions, and extended attributes
  # delete, copy, chmod, chown, utime, xattr
  # Right now this is perhaps an UGLY HACK, just calling rsync to do the copy.
  # -aHAXxv tells rsync to preserve all sorts of info, and --no-r tells it not
  # to copy recursively.  We want only one file at a time here.
  # -d tells it to update directory attributes as well.
  # Some of these options are nonstandard, and may not work on all distros
  # unless you manually install rsync and apply patches

  my $src = shift;
  my $dst = shift;
  
  # To keep directories in the right place, chop the filename off dest.
  $src =~ s/\/$//;
  $dst =~ s/\/[^\/]*.$/\//;
  &log(LOG_NOTICE, "Executing: $rsync $rsync_parameters \"$src\" \"$dst\"");
  `$rsync $rsync_parameters "$src" "$dst"`;
}

sub beuser
{ # Determines the user's uid/gid and sets our real and effective uid/gid to match
  # Call this before any file accesses
  my $context = &Fuse::fuse_get_context();
  my $uid = $context->{"uid"};
  my $gid = $context->{"gid"};
  syscall(&SYS_setresgid, $gid, $gid, -1);
  syscall(&SYS_setresuid, $uid, $uid, -1);
}

sub beroot
{ # Resets our uid/gid to root
  # Call this after accesses
  my $ruid = 0;
  my $euid = 0;
  my $rgid = 0;
  my $egid = 0;
  syscall(&SYS_setresuid, $ruid, $euid, -1);
  syscall(&SYS_setresgid, $rgid, $egid, -1);
}

##############################
## Callback functions
##############################

sub lmfs_getattr
{
    my $path = shift;
    my @paths = &getpath($path);
    &beuser();
    my @ret = lstat($paths[0]);
    &beroot();
    return @ret;
}

sub lmfs_readlink
{
    my $path = shift;
    my @paths = &getpath($path);
    &beuser();
    my $ret = readlink($paths[0]);
    &beroot();
    return $ret;
}

sub lmfs_getdir
{
  my $path = shift;
  my @paths = &getpath($path);
  my @list;
  &beuser();
  grep
  {
    opendir my $DH, $_;
    while(my $entry = readdir($DH))
    {
      if(!($path eq "/" && $entry eq ".lmfs"))
      {
        if($entry ne "." && $entry ne "..")
        {
          &beroot();
          my @fullpaths = &getpath("$path/$entry");
	  &beuser();
        }
        if(-e "$_/$entry")
        { push @list, $entry; }
      }
    }
    closedir $DH;
  } @paths;
  &beroot();
  my %hash = map { $_, 1 } @list;
  @list = keys %hash;
  push @list, 0;
  return @list;
}

sub lmfs_mknod
{
  my $path = shift;
  my $mode = shift;
  my $dev = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_mknod, $_, $mode, $dev);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_mkdir
{
  my $path = shift;
  my $mode = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_mkdir, $_, $mode);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_unlink
{
  my $path = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_unlink, $_);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  if($err >= 0) { &tombstone($path); }
  return $err;
}

sub lmfs_rmdir
{
  my $path = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_rmdir, $_);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  if($err >= 0) { &tombstone($path); }
  return $err;
}

sub lmfs_symlink
{
  my $path = shift;
  my $new = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    my $prefix = $_;
    $prefix =~ s/$path$//;
    my $fullnew = $new;
    $fullnew =~ s/^\//$path\//;
    $! = 0;
    my $ret = syscall(&SYS_symlink, $_, $fullnew);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_rename
{
  my $path = shift;
  my $new = shift;
  my @paths = &getpath($path);
  my @src = &getpath("/");
  my $err;
  &beuser();
  grep
  {
    my $fullpath = $_.$path;
    $fullpath =~ s/\/\//\//;
    my $fullnew = $_.$new;
    $fullnew =~ s/\/\//\//;
    $! = 0;
    my $ret = syscall(&SYS_rename, $fullpath, $fullnew);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @src;
  &beroot();
  if($err >= 0) { &tombstone($path); }
  return $err;
}

sub lmfs_link
{
  my $path = shift;
  my $new = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    my $prefix = $_;
    $prefix =~ s/$path$//;
    my $fullnew = $new;
    $fullnew =~ s/^\//$path\//;
    $! = 0;
    my $ret = syscall(&SYS_link, $_, $fullnew);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_chmod
{
  my $path = shift;
  my $mode = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_chmod, $_, $mode);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_chown
{
  my $path = shift;
  my $uid = shift;
  my $gid = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_chown, $_, $uid, $gid);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_truncate
{
  my $path = shift;
  my $length = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_truncate, $_, $length);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_utime
{
  my $path = shift;
  my $access = shift;
  my $mod = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    utime($access, $mod, $_);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_open
{
  my $path = shift;
  my $flags = shift;
  my @paths = &getpath($path);
  my $err;
  my $fileh;
  &beuser();
  lock(@descriptors);
  grep
  {
    $! = 0;
    my $fd = syscall(&SYS_open, $_, $flags);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
    if($e == 0)
    {
      lock(@descriptors);
      if(!$fileh){$fileh = $fd}
      if(!$descriptors[$fileh]){$descriptors[$fileh] = &share({});}
      if(!$descriptors[$fileh]{"fd"}){$descriptors[$fileh]{"fd"} = &share([]);}
      my $y = @{$descriptors[$fileh]{"fd"}}+0;
      $descriptors[$fileh]{"fd"}[$y] = $fd;
    }
  } @paths;
  &beroot();
  if($err < 0) { return $err; }
  $descriptors[$fileh]{"flags"} = $flags;
  $descriptors[$fileh]{"uid"} = &Fuse::fuse_get_context()->{"uid"};
  $descriptors[$fileh]{"gid"} = &Fuse::fuse_get_context()->{"gid"};
  $descriptors[$fileh]{"pid"} = &Fuse::fuse_get_context()->{"pid"};
  return ($fileh, 0);
}

sub lmfs_read
{
  my $path = shift;
  my $size = shift;
  my $offset = shift;
  my $fileh = shift;
  my $buf = "\0"x$size;
  my @fd = &getfd($fileh);
  &beuser();
  lock(%{$descriptors[$fileh]}); # Atomic from here on.
  $! = 0;
  my $ret = syscall(&SYS_lseek, $fd[0], $offset, 0);
  my $err = $!*-1;
  if($ret >= 0)
  {
    $ret = syscall(&SYS_read, $fd[0], $buf, $size);
    $err = $!*-1;
  }
  &beroot();
  if($err > 0){return $err;}
  return $buf;
}

sub lmfs_write
{
  my $path = shift;
  my $buffer = shift;
  my $offset = shift;
  my $fileh = shift;
  my @fd = &getfd($fileh);
  my $err;
  my $ret;
  &beuser();
  lock(%{$descriptors[$fileh]}); # Atomic from here on.
  grep
  {
    $! = 0;
    my $r = syscall(&SYS_lseek, $_, $offset, 0);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
    if($r >= 0)
    {
      $r = syscall(&SYS_write, $_, $buffer, length($buffer));
      if($r > $ret){ $ret = $r; }
      my $e = $!*-1;
      if($err == undef || $e > $err){ $err = $e; }
    }
  } @fd;
  &beroot();
  if($err < 0){ return $err; }
  return $ret;
}

sub lmfs_statfs
{
#long    f_type;     /* type of filesystem (see below) */
#long    f_bsize;    /* optimal transfer block size */
#long    f_blocks;   /* total data blocks in file system */
#long    f_bfree;    /* free blocks in fs */
#long    f_bavail;   /* free blocks avail to non-superuser */
#long    f_files;    /* total file nodes in file system */
#long    f_ffree;    /* free file nodes in fs */
#fsid_t  f_fsid;     /* file system id */
#long    f_namelen;  /* maximum length of filenames */
  my ($ret, $namelen, $files, $files_free, $blocks, $blocks_free, $blocksize);
  grep
  {
    my $buf = "\0"x128;
    my $r = syscall(&SYS_statfs, $_, $buf);
    my ($type, $blsize, $bl, $blfree, $user_blocks_avail, $f, $ffree, $fsid, $nlen) = unpack  "L!7 x L!", $buf;
    if(!$ret || $r > $ret){$ret = $r;}
    if(!$namelen || $nlen < $namelen){$namelen = $nlen;}
    if(!$files || $f < $files){$files = $f;}
    if(!$files_free || $ffree < $files_free){$files_free = $ffree;}
    if(!$blocks || $bl < $blocks){$blocks = $bl;}
    if(!$blocks_free || $blfree < $blocks_free){$blocks_free = $blfree;}
    if(!$blocksize || $blsize < $blocksize){$blocksize = $blsize;}
  } @sourcedirs;
  return ($ret, $namelen, $files, $files_free, $blocks, $blocks_free, $blocksize)
}

sub lmfs_flush  # STUB - means a file descriptor has been closed - but there might still be clones of it out there
{
  my $path = shift;
  return 0;
}

sub lmfs_release # means all related file descriptors have been closed
{
  my $path = shift;
  my $flags = shift;
  my $fileh = shift;
  my @fd = &getfd($fileh);
  my $err;
  &beuser();
#  lock(%{$descriptors[$fileh]}); # Atomic from here on.
  grep
  {
    my $ret = syscall(&SYS_close, $_);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @fd;
  &beroot();
  delete $descriptors[$fileh];
  return $err;
}

sub lmfs_fsync
{
  my $path = shift;
  my $datasync = shift;
  my $flags = shift;
  my $fileh = shift;
  my $func = &SYS_fsync;
  if($datasync){ $func = &SYS_fdatasync; }
  my @fd = &getfd($fileh);
  my $err;
  &beuser();
  lock(%{$descriptors[$fileh]}); # Atomic from here on.
  grep
  {
    $! = 0;
    my $ret = syscall($func, $_);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @fd;
  &beroot();
  return $err;
}

sub lmfs_setxattr
{
  my $path = shift;
  my $key = shift;
  my $value = shift;
  my $flags = shift;
  my @paths = &getpath($path);
  my $err;
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_setxattr, $_, $key, $value, length($value), $flags);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_getxattr
{
  my $path = shift;
  my $key = shift;
  my $size = 256;
  my $value = "\0"x$size;
  my @paths = &getpath($path);
  &beuser();
  $! = 0;
  my $ret = syscall(&SYS_getxattr, $paths[0], $key, $value, $size);
  my $err = $!*-1;
  &beroot();
  if($ret < 1){ return $err; }
  $value =~ s/\0+//g;
  return $value;
}

sub lmfs_listxattr
{
  my $path = shift;
  my $size = 256;
  my $list = "\0"x$size;
  my @paths = &getpath($path);
  &beuser();
  $! = 0;
  my $ret = syscall(&SYS_listxattr, $paths[0], $list, $size);
  my $err = $!*-1;
  &beroot();
  if($ret < 0){ return $err; }
  my @r = split("\0", $list);
  push @r, $ret;
  return @r;
}

sub lmfs_removexattr
{
  my $path = shift;
  my $key = shift;
  my @paths = &getpath($path);
  my $err
  &beuser();
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_removexattr, $_, $key);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @paths;
  &beroot();
  return $err;
}

sub lmfs_lock
{
  my $path = shift;
  my $cmd = shift;
  my $flock = shift;
  my $fileh = shift;
  my @fd = &getfd($fileh);
  my $err;
  &beuser();
  lock(%{$descriptors[$fileh]}); # Atomic from here on.
  grep
  {
    $! = 0;
    my $ret = syscall(&SYS_fcntl, $_, $cmd, $flock);
    my $e = $!*-1;
    if($err == undef || $e > $err){ $err = $e; }
  } @fd;
  &beroot();
  if($err < 0){ return $err; }
  return $flock;
}

sub lmfs_access
{
  my $path = shift;
  my $mask = shift;
  my @paths = &getpath($path);
  &beuser();
  $! = 0;
  my $ret = syscall(&SYS_access, $paths[0], $mask);
  my $err = $!*-1;
  &beroot();
  return $err;
}

