Виртуальная файловая система в Perl с предохранителем

Ответ 1

Я действительно не являюсь постоянным пользователем модуля Fuse, ни системы FUSE. Из-за чистого любопытства эта проблема исходила. Таким образом, хотя я не могу объяснить очень подробно, как использовать простой модуль Fuse для достижения вашей цели, у меня есть рабочий код, который создает нужную файловую систему (по крайней мере, в моей системе и, похоже, она способна создавать любое произвольное дерево файловой системы), и я могу объяснить, как я получил этот код.

Итак, в первую очередь я обнаружил модуль Fuse:: Simple на CPAN. Его SYNOPSIS показывает, что он предоставляет действительно простой API для модуля Fuse для создания произвольных файловых систем из хэш-структуры. Его исходный код не такой уж огромный, поэтому я просто создал файл "listing.pl" script и скопировал там большинство функций ( кроме fserr, вызвавшего исключение Modification of a read-only value), выведите основное вспомогательное содержимое, поэтому они будут основным потоком script, жестко закодированным структурой файловой системы ($fs var) и сделают некоторые небольшие корректировки здесь и там (например, объявить vars с my для предотвращения исключений), и, наконец, получить файловую систему смонтированной, со всеми перечисленными каталогами и файлами. Итак, это код, который я получил наконец:

#!/usr/bin/env perl
use strict;
use warnings;
use diagnostics;
use Carp;
use Fuse;
use Errno qw(:POSIX);         # ENOENT EISDIR etc
use Fcntl qw(:DEFAULT :mode); # S_IFREG S_IFDIR, O_SYNC O_LARGEFILE etc.
use Switch;

my $debug = 0;
my %codecache = ();
my $ctime = time();
my $uid = $>;
my $gid = $) + 0;

my $fs = {
    "file1.txt" => "File 1 contents",
    "subdir" => {
        "subdir-l2" => {},
        "file2.txt" => "File 2 contents"
    }
};

# some default args
my %args = (
    "mountpoint"  => "listing",
    "debug"       => $debug,
    "fuse_debug"  => 0,
    "threaded"    => 0,
    "/"           => $fs
);
# the default subs
my %fs_subs = (
    "chmod"       => \&fs_not_imp,
    "chown"       => \&fs_not_imp,
    "flush"       => \&fs_flush,
    "fsync"       => \&fs_not_imp,
    "getattr"     => \&fs_getattr,
    "getdir"      => \&fs_getdir,
    "getxattr"    => \&fs_not_imp,
    "link"        => \&fs_not_imp,
    "listxattr"   => \&fs_not_imp,
    "mkdir"       => \&fs_not_imp,
    "mknod"       => \&fs_not_imp,
    "open"        => \&fs_open,
    "read"        => \&fs_read,
    "readlink"    => \&fs_readlink,
    "release"     => \&fs_release,
    "removexattr" => \&fs_not_imp,
    "rmdir"       => \&fs_not_imp,
    "rename"      => \&fs_not_imp,
    "setxattr"    => \&fs_not_imp,
    "statfs"      => \&fs_statfs,
    "symlink"     => \&fs_not_imp,
    "truncate"    => \&fs_truncate,
    "unlink"      => \&fs_not_imp,
    "utime"       => sub{return 0},
    "write"       => \&fs_write,
);
# except extract these ones back out.
$debug = delete $args{"debug"};
$args{"debug"} = delete( $args{"fuse_debug"} ) || 0;
delete $args{"/"};
# add the functions, if not already defined.
# wrap in debugger if debug is set.
for my $name (keys %fs_subs) {
    my $sub = $fs_subs{$name};
#   $sub = wrap($sub, $name) if $debug;
    $args{$name} ||= $sub;
}
Fuse::main(%args);

sub fetch {
    my ($path, @args) = @_;

    my $obj = $fs;
    for my $elem (split '/', $path) {
    next if $elem eq ""; # skip empty // and before first /
    $obj = runcode($obj); # if there anything to run
    # the dir we're changing into must be a hash (dir)
    return ENOTDIR() unless ref($obj) eq "HASH";
    # note that ENOENT and undef are NOT the same thing!
    return ENOENT() unless exists $obj->{$elem};
    $obj = $obj->{$elem};
    }

    return runcode($obj, @args);
}

sub runcode {
    my ($obj, @args) = @_;

    while (ref($obj) eq "CODE") {
    my $old = $obj;
    if (@args) { # run with these args. don't cache
        delete $codecache{$old};
        print "running $obj(",quoted(@args),") NO CACHE\n" if $debug;
        $obj = saferun($obj, @args);
    } elsif (exists $codecache{$obj}) { # found in cache
        print "got cached $obj\n" if $debug;
        $obj = $codecache{$obj}; # could be undef, or an error, BTW
    } else {
        print "running $obj() to cache\n" if $debug;
        $obj = $codecache{$old} = saferun($obj);
    }

    if (ref($obj) eq "NOCACHE") {
        print "returned a nocache() value - flushing\n" if $debug;
        delete $codecache{$old};
        $obj = $$obj;
    }

    print "returning ",ref($obj)," ",
      defined($obj) ? $obj : "undef",
      "\n" if $debug;
    }
    return $obj;
}

sub saferun {
    my ($sub, @args) = @_;

    my $ret = eval { &$sub(@args) };
    my $died = [email protected];
    if (ref($died)) {
    print "+++ Error $$died\n" if ref($died) eq "ERROR";
    return $died;
    } elsif ($died) {
    print "+++ $died\n";
    # stale file handle? moreorless?
    return ESTALE();
    }
    return $ret;
}

sub nocache {
    return bless(\ shift, "NOCACHE"); # yup, utter abuse of bless   :-)
}

sub dump_open_flags {
    my $flags = shift;

    printf "  flags: 0%o = (", $flags;
    for my $bits (
    [ O_ACCMODE(),   O_RDONLY(),     "O_RDONLY"    ],
    [ O_ACCMODE(),   O_WRONLY(),     "O_WRONLY"    ],
    [ O_ACCMODE(),   O_RDWR(),       "O_RDWR"      ],
    [ O_APPEND(),    O_APPEND(),    "|O_APPEND"    ],
    [ O_NONBLOCK(),  O_NONBLOCK(),  "|O_NONBLOCK"  ],
    [ O_SYNC(),      O_SYNC(),      "|O_SYNC"      ],
    [ O_DIRECT(),    O_DIRECT(),    "|O_DIRECT"    ],
    [ O_LARGEFILE(), O_LARGEFILE(), "|O_LARGEFILE" ],
    [ O_NOFOLLOW(),  O_NOFOLLOW(),  "|O_NOFOLLOW"  ],
    ) {
    my ($mask, $flag, $name) = @$bits;
    if (($flags & $mask) == $flag) {
        $flags -= $flag;
        print $name;
    }
    }
    printf "| 0%o !!!", $flags if $flags;
    print ")\n";
}

sub accessor {
    my $var_ref = shift;

    croak "accessor() requires a reference to a scalar var\n"
      unless defined($var_ref) && ref($var_ref) eq "SCALAR";

    return sub {
    my $new = shift;
    $$var_ref = $new if defined($new);
    return $$var_ref;
    }
}

sub fs_not_imp { return -ENOSYS() }

sub fs_flush {
    # we're passed a path, but finding my coderef stuff from a path
    # is a bit of a 'mare. flush the lot, won't hurt TOO much.
    print "Flushing\n" if $debug;
    %codecache = ();
    return 0;
}

sub easy_getattr {
    my ($mode, $size) = @_;

    return (
    0, 0,       # $dev, $ino,
    $mode,
    1,          # $nlink, see fuse.sourceforge.net/wiki/index.php/FAQ
    $uid, $gid, # $uid, $gid,
    0,          # $rdev,
    $size,      # $size,
    $ctime, $ctime, $ctime, # actually $atime, $mtime, $ctime,
    1024, 1,    # $blksize, $blocks,
    );
}

sub fs_getattr {
    my $path = shift;
    my $obj = fetch($path);

    # undef doesn't actually mean "file not found", it could be a coderef
    # file-sub which has returned undef.
    return easy_getattr(S_IFREG | 0200, 0) unless defined($obj);

    switch (ref($obj)) {
    case "ERROR" {  # this is an error to be returned.
        return -$$obj;
    }
    case "" {       # this isn't a ref, it a real string "file"
        return easy_getattr(S_IFREG | 0644, length($obj));
    }
    # case "CODE" should never happen - already been run by fetch()
    case "HASH" {   # this is a directory hash
        return easy_getattr(S_IFDIR | 0755, 1);
    }
    case "SCALAR" { # this is a scalar ref. we use these for symlinks.
        return easy_getattr(S_IFLNK | 0777, 1);
    }
    else {          # what the hell is this file?!?
        print "+++ What on earth is ",ref($obj)," $path ?\n";
        return easy_getattr(S_IFREG | 0000, 0);
    }
    }
}

sub fs_getdir {
    my $obj = fetch(shift);
    return -$$obj if ref($obj) eq "ERROR"; # THINK this is a good idea.
    return -ENOENT() unless ref($obj) eq "HASH";
    return (".", "..", sort(keys %$obj), 0);
}

sub fs_open {
    # doesn't really need to open, just needs to check.
    my $obj = fetch(shift);
    my $flags = shift;
    dump_open_flags($flags) if $debug;

    # if it undefined, and we're not writing to it, return an error
    return -EBADF() unless defined($obj) or ($flags & O_ACCMODE());

    switch (ref($obj)) {
    case "ERROR"  { return -$$obj; }
    case ""       { return 0 }          # this is a real string "file"
    case "HASH"   { return -EISDIR(); } # this is a directory hash
    else          { return -ENOSYS(); } # what the hell is this file?!?
    }
}

sub fs_read {
    my $obj = fetch(shift);
    my $size = shift;
    my $off = shift;

    return -ENOENT() unless defined($obj);
    return -$$obj if ref($obj) eq "ERROR";
    # any other types of refs are probably bad
    return -ENOENT() if ref($obj);

    if ($off >  length($obj)) {
    return -EINVAL();
    } elsif ($off == length($obj)) {
    return 0; # EOF
    }
    return substr($obj, $off, $size);
}

sub fs_readlink {
    my $obj = fetch(shift);
    return -$$obj if ref($obj) eq "ERROR";
    return -EINVAL() unless ref($obj) eq "SCALAR";
    return $$obj;
}

sub fs_release {
    my ($path, $flags) = @_;
    dump_open_flags($flags) if $debug;
    return 0;
}

sub fs_statfs {
    return (
        255, # $namelen,
        1,1, # $files, $files_free,
        1,1, # $blocks, $blocks_avail, # 0,0 seems to hide it from df?
        2,   # $blocksize,
    );
}

sub fs_truncate {
    my $obj = fetch(shift, ""); # run anything to set it to ""
    return -$$obj if ref($obj) eq "ERROR";
    return 0;
}

sub fs_write {
    my ($path, $buf, $off) = @_;
    my $obj = fetch($path, $buf, $off); # this runs the coderefs!
    return -$$obj if ref($obj) eq "ERROR";
    return length($buf);
}

Заключительное слово: я не пытался использовать сам модуль (он не указан в моем репозитории пакетов дистрибутива, и я был слишком ленив (извините), чтобы установить его с помощью cpanm или другим способом). Но я думаю, что если мне придется просто использовать FUSE с Perl, я, вероятно, просто воспользуюсь Fuse:: Simple, а не Fuse, возможно, разблокируя его. Я бы использовал простой плавкий предохранитель только для своих академических исследований, я думаю...

Надеюсь, что это поможет.