examples/fioc.pl

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