带有保险丝的Perl中的虚拟文件系统

所以首先我发现了CPAN上的Fuse::Simple模块.
其概要表明,它为保险丝模块提供了一个非常简单的API,用于从散列结构创建任意文件系统.它的source code不是那么大,所以我刚刚创建了’listing.pl’脚本文件,并复制了大部分功能(除了fserr导致修改只读值异常),把主要的子内容放出来,所以它们将是主脚本的流程,硬编码文件系统结构($fs var),并在此处进行了一些微小的调整(像我的声明vars以防止异常),最后得到文件系统挂载,列出所有目录和文件可读.所以这是我最后得到的代码：

#!/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's 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 CACHEn" if $debug;
        $obj = saferun($obj,@args);
    } elsif (exists $codecache{$obj}) { # found in cache
        print "got cached $objn" if $debug;
        $obj = $codecache{$obj}; # could be undef,or an error,BTW
    } else {
        print "running $obj() to cachen" if $debug;
        $obj = $codecache{$old} = saferun($obj);
    }

    if (ref($obj) eq "NOCACHE") {
        print "returned a nocache() value - flushingn" 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 = $@;
    if (ref($died)) {
    print "+++ Error $$diedn" if ref($died) eq "ERROR";
    return $died;
    } elsif ($died) {
    print "+++ $diedn";
    # 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_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 varn"
      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 "Flushingn" if $debug;
    %codecache = ();
    return 0;
}

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

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

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's 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 "," $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's 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,# $files,$files_free,# $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,$off); # this runs the coderefs!
    return -$$obj if ref($obj) eq "ERROR";
    return length($buf);
}

最后一句话：我没有尝试使用模块本身(它没有列在我的发行版软件包存储库中,而且我太懒了(抱歉)通过cpanm或其他方式安装它).但是我认为如果我必须使用FUSE与Perl,我可能只需要使用Fuse :: Simple而不是Fuse,也许分配它.我只用纯保险丝作为我的学术研究,我想…

希望这可以帮助.