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