examples/fioc.pl

   1 #!/usr/bin/env perl
   2
   3 # fioc.pl: A Perl conversion of the fioc example IOCTL server program
   4 # from the FUSE distribution. I've endeavored to stay pretty close
   5 # structure-wise to the C version, while using Perl-specific features.
   6 # I wrote this to provide a way to verify my ioctl() wrapper
   7 # implementation would work properly. So far, it seems to, and it will
   8 # interoperate with the C client as well.
   9
  10 use strict;
  11 no strict qw(refs);
  12
  13 use threads;
  14 use threads::shared;
  15
  16 use Carp;
  17 local $SIG{'__WARN__'} = \&Carp::cluck;
  18
  19 use Fuse;
  20 use Fcntl qw(:mode);
  21 use POSIX;
  22
  23 my $fioc_size :shared = 0;
  24 use constant FIOC_NAME => 'fioc';
  25 my $fioc_buf :shared = '';
  26 use constant FIOC_NONE  => 0;
  27 use constant FIOC_ROOT  => 1;
  28 use constant FIOC_FILE  => 2;
  29
  30 require 'asm/ioctl.ph';
  31
  32 our %sizeof = ('size_t' => length(pack('L!')));
  33 sub FIOC_GET_SIZE { _IOR(ord 'E', 0, 'size_t'); }
  34 sub FIOC_SET_SIZE { _IOW(ord 'E', 1, 'size_t'); }
  35 sub TCGETS { 0x5401; }
  36 use constant FUSE_IOCTL_COMPAT => 0x1;
  37
  38 sub fioc_resize {
  39     my ($size) = @_;
  40     print 'called ', (caller(0))[3], "\n";
  41     return 0 if $size == $fioc_size;
  42
  43     if ($size < $fioc_size) {
  44         $fioc_buf = substr($fioc_buf, 0, $size);
  45     }
  46     else {
  47         $fioc_buf .= "\0" x ($size - $fioc_size);
  48     }
  49     $fioc_size = $size;
  50     return 0;
  51 }
  52
  53 sub fioc_expand {
  54     my ($size) = @_;
  55     print 'called ', (caller(0))[3], "\n";
  56     if ($size > $fioc_size) {
  57         return fioc_resize($size);
  58     }
  59     return 0;
  60 }
  61
  62 sub fioc_file_type {
  63     my ($path) = @_;
  64     print 'called ', (caller(0))[3], "\n";
  65     return FIOC_ROOT if $path eq '/';
  66     return FIOC_FILE if $path eq '/' . FIOC_NAME;
  67     return FIOC_NONE;
  68 }
  69
  70 sub fioc_getattr {
  71     my ($path) = @_;
  72     print 'called ', (caller(0))[3], "\n";
  73     my @stbuf = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  74
  75     $stbuf[4] = $<;
  76     $stbuf[5] = (split(/\s+/, $())[0];
  77     $stbuf[8] = $stbuf[9] = time();
  78
  79     my $type = fioc_file_type($path);
  80     if ($type == FIOC_ROOT) {
  81         $stbuf[2] = S_IFDIR | 0755;
  82         $stbuf[3] = 2;
  83     }
  84     elsif ($type == FIOC_FILE) {
  85         $stbuf[2] = S_IFREG | 0644;
  86         $stbuf[3] = 1;
  87         $stbuf[7] = $fioc_size;
  88     }
  89     else {
  90         return -&ENOENT;
  91     }
  92     return @stbuf;
  93 }
  94
  95 sub fioc_open {
  96     my ($path, $flags, $info) = @_;
  97     print 'called ', (caller(0))[3], "\n";
  98
  99     return 0 if fioc_file_type($path) != FIOC_NONE;
 100     return -&ENOENT;
 101 }
 102
 103 sub fioc_read {
 104     my ($path, $size, $offset) = @_;
 105     print 'called ', (caller(0))[3], "\n";
 106
 107     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 108     return q{} if $offset > $fioc_size;
 109
 110     if ($size > $fioc_size - $offset) {
 111         $size - $fioc_size - $offset;
 112     }
 113
 114     return substr($fioc_buf, $offset, $size);
 115 }
 116
 117 sub fioc_write {
 118     my ($path, $data, $offset) = @_;
 119     print 'called ', (caller(0))[3], "\n";
 120     lock($fioc_buf);
 121
 122     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 123     return -&ENOMEM if fioc_expand($offset + length($data));
 124
 125     substr($fioc_buf, $offset, length($data), $data);
 126     return length($data);
 127 }
 128
 129 sub fioc_truncate {
 130     my ($path, $size) = @_;
 131     print 'called ', (caller(0))[3], "\n";
 132     lock($fioc_buf);
 133
 134     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 135
 136     return fioc_resize($size);
 137 }
 138
 139 sub fioc_readdir {
 140     my ($path, $offset) = @_;
 141     print 'called ', (caller(0))[3], "\n";
 142
 143     return -&EINVAL if fioc_file_type($path) != FIOC_ROOT;
 144
 145     return ('.', '..', FIOC_NAME, 0);
 146 }
 147
 148 sub fioc_ioctl {
 149     my ($path, $cmd, $flags, $data) = @_;
 150     print 'called ', (caller(0))[3], "\n";
 151
 152     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 153     return -&ENOSYS if $flags & FUSE_IOCTL_COMPAT;
 154
 155     if ($cmd == FIOC_GET_SIZE) {
 156         return(0, pack('L!', $fioc_size));
 157     }
 158     elsif ($cmd == FIOC_SET_SIZE) {
 159         lock($fioc_buf);
 160         fioc_resize(unpack('L!', $data));
 161         return 0;
 162     }
 163     elsif ($cmd == TCGETS) {
 164         # perl sends TCGETS as part of calling isatty() on opening a file;
 165         # this appears to be a more canonical answer
 166         return -&ENOTTY;
 167     }
 168
 169     return -&EINVAL;
 170 }
 171
 172 croak("Fuse doesn't have ioctl") unless Fuse::fuse_version() >= 2.8;
 173
 174 Fuse::main(
 175     'mountpoint' => $ARGV[0],
 176     'getattr'   => 'main::fioc_getattr',
 177     'readdir'   => 'main::fioc_readdir',
 178     'truncate'  => 'main::fioc_truncate',
 179     'open'      => 'main::fioc_open',
 180     'read'      => 'main::fioc_read',
 181     'write'     => 'main::fioc_write',
 182     'ioctl'     => 'main::fioc_ioctl',
 183     'threaded'  => 1);