examples/rmount_remote.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use IO::File;
   5 use POSIX qw(ENOENT ENOSYS EEXIST EPERM O_RDONLY O_RDWR O_APPEND O_CREAT);
   6 use Fcntl qw(S_ISBLK S_ISCHR S_ISFIFO SEEK_SET);
   7 use Data::Dumper;
   8 require 'syscall.ph'; # for SYS_mknod and SYS_lchown
   9
  10 my ($rootdir) = @ARGV;
  11
  12 # strip leading and trailing slashes
  13 $rootdir = $1 if($rootdir =~ /^\/?(.*)\/?$/);
  14
  15 sub fixup { return "/$rootdir" . shift }
  16
  17 sub x_getattr {
  18         my ($file) = fixup(shift);
  19         my (@list) = lstat($file);
  20         return -$! unless @list;
  21         return @list;
  22 }
  23
  24 sub x_getdir {
  25         my ($dirname) = fixup(shift);
  26         unless(opendir(DIRHANDLE,$dirname)) {
  27                 return -ENOENT();
  28         }
  29         my (@files) = readdir(DIRHANDLE);
  30         closedir(DIRHANDLE);
  31         return (@files, 0);
  32 }
  33
  34 sub x_open {
  35         my ($file) = fixup(shift);
  36         my ($mode) = shift;
  37         return -$! unless sysopen(FILE,$file,$mode);
  38         close(FILE);
  39         return 0;
  40 }
  41
  42 sub x_read {
  43         my ($file,$bufsize,$off) = @_;
  44         my ($rv) = -ENOSYS();
  45         my ($handle) = new IO::File;
  46         return -ENOENT() unless -e ($file = fixup($file));
  47         my ($fsize) = -s $file;
  48         return -ENOSYS() unless open($handle,$file);
  49         if(seek($handle,$off,SEEK_SET)) {
  50                 read($handle,$rv,$bufsize);
  51         }
  52         return $rv;
  53 }
  54
  55 sub x_write {
  56         my ($file,$buf,$off) = @_;
  57         my ($rv);
  58         return -ENOENT() unless -e ($file = fixup($file));
  59         my ($fsize) = -s $file;
  60         return -ENOSYS() unless open(FILE,'+<',$file);
  61         if($rv = seek(FILE,$off,SEEK_SET)) {
  62                 $rv = print(FILE $buf);
  63         }
  64         $rv = -ENOSYS() unless $rv;
  65         close(FILE);
  66         return length($buf);
  67 }
  68
  69 sub err { return (-shift || -$!) }
  70
  71 sub x_readlink { return readlink(fixup(shift)                 ); }
  72 sub x_unlink { return unlink(fixup(shift)) ? 0 : -$!;          }
  73 sub x_rmdir { return err(rmdir(fixup(shift))               ); }
  74
  75 sub x_symlink { print "symlink\n"; return symlink(shift,fixup(shift)) ? 0 : -$!; }
  76
  77 sub x_rename {
  78         my ($old) = fixup(shift);
  79         my ($new) = fixup(shift);
  80         my ($err) = rename($old,$new) ? 0 : -ENOENT();
  81         return $err;
  82 }
  83 sub x_link { return link(fixup(shift),fixup(shift)) ? 0 : -$! }
  84 sub x_chown {
  85         my ($fn) = fixup(shift);
  86         print "nonexistent $fn\n" unless -e $fn;
  87         my ($uid,$gid) = @_;
  88         # perl's chown() does not chown symlinks, it chowns the symlink's
  89         # target.  it fails when the link's target doesn't exist, because
  90         # the stat64() syscall fails.
  91         # this causes error messages when unpacking symlinks in tarballs.
  92         my ($err) = syscall(&SYS_lchown,$fn,$uid,$gid,$fn) ? -$! : 0;
  93         return $err;
  94 }
  95 sub x_chmod {
  96         my ($fn) = fixup(shift);
  97         my ($mode) = shift;
  98         my ($err) = chmod($mode,$fn) ? 0 : -$!;
  99         return $err;
 100 }
 101 sub x_truncate { return truncate(fixup(shift),shift) ? 0 : -$! ; }
 102 sub x_utime { return utime($_[1],$_[2],fixup($_[0])) ? 0:-$!; }
 103
 104 sub x_mkdir { my ($name, $perm) = @_; return 0 if mkdir(fixup($name),$perm); return -$!; }
 105 sub x_rmdir { return 0 if rmdir fixup(shift); return -$!; }
 106
 107 sub x_mknod {
 108         # since this is called for ALL files, not just devices, I'll do some checks
 109         # and possibly run the real mknod command.
 110         my ($file, $modes, $dev) = @_;
 111         $file = fixup($file);
 112         $! = 0;
 113         syscall(&SYS_mknod,$file,$modes,$dev);
 114         return -$!;
 115 }
 116
 117 # kludge
 118 sub x_statfs {return 255,1000000,500000,1000000,500000,4096}
 119
 120 $| = 1;
 121 my ($len);
 122 while(read(STDIN,$len,9) == 9) {
 123         chomp $len;
 124         my ($data,$VAR1,@args);
 125         eval {
 126                 $SIG{ALRM} = sub { die "timeout\n"};
 127                 $data = "";
 128                 alarm 5;
 129                 read(STDIN,$data,$len-length($data),length($data))
 130                         while(length($data) < $len);
 131                 alarm 0;
 132         };
 133         die $@ if $@;
 134         eval $data;
 135         @args = @{$VAR1};
 136         my $cmd = shift(@args);
 137         exit 0 if $cmd eq "bye";
 138         die "cannot find command $cmd\n" unless exists($main::{"x_$cmd"});
 139         @args = $main::{"x_$cmd"}(@args);
 140         $cmd = Dumper(\@args)."\n";
 141         $cmd = sprintf("%08i\n%s",length($cmd),$cmd);
 142         print $cmd;
 143 }