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 qw(:all);
  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
  37 sub fioc_resize {
  38     my ($size) = @_;
  39     print 'called ', (caller(0))[3], "\n";
  40     return 0 if $size == $fioc_size;
  41
  42     if ($size < $fioc_size) {
  43         $fioc_buf = substr($fioc_buf, 0, $size);
  44     }
  45     else {
  46         $fioc_buf .= "\0" x ($size - $fioc_size);
  47     }
  48     $fioc_size = $size;
  49     return 0;
  50 }
  51
  52 sub fioc_expand {
  53     my ($size) = @_;
  54     print 'called ', (caller(0))[3], "\n";
  55     if ($size > $fioc_size) {
  56         return fioc_resize($size);
  57     }
  58     return 0;
  59 }
  60
  61 sub fioc_file_type {
  62     my ($path) = @_;
  63     print 'called ', (caller(0))[3], "\n";
  64     return FIOC_ROOT if $path eq '/';
  65     return FIOC_FILE if $path eq '/' . FIOC_NAME;
  66     return FIOC_NONE;
  67 }
  68
  69 sub fioc_getattr {
  70     my ($path) = @_;
  71     print 'called ', (caller(0))[3], "\n";
  72     my @stbuf = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);
  73
  74     $stbuf[4] = $<;
  75     $stbuf[5] = (split(/\s+/, $())[0];
  76     $stbuf[8] = $stbuf[9] = time();
  77
  78     my $type = fioc_file_type($path);
  79     if ($type == FIOC_ROOT) {
  80         $stbuf[2] = S_IFDIR | 0755;
  81         $stbuf[3] = 2;
  82     }
  83     elsif ($type == FIOC_FILE) {
  84         $stbuf[2] = S_IFREG | 0644;
  85         $stbuf[3] = 1;
  86         $stbuf[7] = $fioc_size;
  87     }
  88     else {
  89         return -&ENOENT;
  90     }
  91     return @stbuf;
  92 }
  93
  94 sub fioc_open {
  95     my ($path, $flags, $info) = @_;
  96     print 'called ', (caller(0))[3], "\n";
  97
  98     return 0 if fioc_file_type($path) != FIOC_NONE;
  99     return -&ENOENT;
 100 }
 101
 102 sub fioc_read {
 103     my ($path, $size, $offset) = @_;
 104     print 'called ', (caller(0))[3], "\n";
 105
 106     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 107     return q{} if $offset > $fioc_size;
 108
 109     if ($size > $fioc_size - $offset) {
 110         $size - $fioc_size - $offset;
 111     }
 112
 113     return substr($fioc_buf, $offset, $size);
 114 }
 115
 116 sub fioc_write {
 117     my ($path, $data, $offset) = @_;
 118     print 'called ', (caller(0))[3], "\n";
 119     lock($fioc_buf);
 120
 121     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 122     return -&ENOMEM if fioc_expand($offset + length($data));
 123
 124     substr($fioc_buf, $offset, length($data), $data);
 125     return length($data);
 126 }
 127
 128 sub fioc_truncate {
 129     my ($path, $size) = @_;
 130     print 'called ', (caller(0))[3], "\n";
 131     lock($fioc_buf);
 132
 133     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 134
 135     return fioc_resize($size);
 136 }
 137
 138 sub fioc_readdir {
 139     my ($path, $offset) = @_;
 140     print 'called ', (caller(0))[3], "\n";
 141
 142     return -&EINVAL if fioc_file_type($path) != FIOC_ROOT;
 143
 144     return ('.', '..', FIOC_NAME, 0);
 145 }
 146
 147 sub fioc_ioctl {
 148     my ($path, $cmd, $flags, $data) = @_;
 149     print 'called ', (caller(0))[3], "\n";
 150
 151     return -&EINVAL if fioc_file_type($path) != FIOC_FILE;
 152     return -&ENOSYS if $flags & FUSE_IOCTL_COMPAT;
 153
 154     if ($cmd == FIOC_GET_SIZE) {
 155         return(0, pack('L!', $fioc_size));
 156     }
 157     elsif ($cmd == FIOC_SET_SIZE) {
 158         lock($fioc_buf);
 159         fioc_resize(unpack('L!', $data));
 160         return 0;
 161     }
 162     elsif ($cmd == TCGETS) {
 163         # perl sends TCGETS as part of calling isatty() on opening a file;
 164         # this appears to be a more canonical answer
 165         return -&ENOTTY;
 166     }
 167
 168     return -&EINVAL;
 169 }
 170
 171 croak("Fuse doesn't have ioctl") unless Fuse::fuse_version() >= 2.8;
 172
 173 Fuse::main(
 174     'mountpoint' => $ARGV[0],
 175     'getattr'   => 'main::fioc_getattr',
 176     'readdir'   => 'main::fioc_readdir',
 177     'truncate'  => 'main::fioc_truncate',
 178     'open'      => 'main::fioc_open',
 179     'read'      => 'main::fioc_read',
 180     'write'     => 'main::fioc_write',
 181     'ioctl'     => 'main::fioc_ioctl',
 182     'threaded'  => 1);