使用Fuse在Perl中创建虚拟文件系统

Question

使用Fuse在Perl中创建虚拟文件系统

10

有人可以帮我在Perl中创建一个虚拟文件系统。非常简单，只需要2层深度，如下：

/subdir
   subdir-l2
   file2.txt
/file1.txt

我尝试使用Fuse.pm，但不明白如何创建子目录级别。我创建了%files哈希表，如果进入子目录，则会使用新记录重新创建它。这仅用于测试。

#!/usr/bin/env perl 

use strict;
use warnings;
use utf8;
use Fuse;
use POSIX qw(ENOENT EISDIR EINVAL);

my (%files) = (
    '.' => { 
        type => 0040,
        mode => 0755,
        ctime => 1490603721
    },
    subdir => {
        type => 0040,
        mode => 0755,
        ctime => 1490603721
    },
    "file1.txt" => { 
            type => 0100,
            mode => 0755,
            ctime => 1490603721
        }
 );

sub filename_fixup {
    my ($file) = shift;
    $file =~ s,^/,,;
    $file = '.' unless length($file);
    return $file;
}

sub getdir {
    my $tmp = shift;
    if ($tmp eq '/') {  
        return (keys %files),0;
    } else { 
        (%files) = (
                '.' => {
                    type => 0040,
                    mode => 0755,
                    ctime => 1490603721    
                },

                # /subdir/subdir-l2
                "subdir-l2" => {
                    type => 0040,
                    mode => 0755,
                    ctime => 1490603721    
                } ,

                # /subdir/a-l2.file
                "file2.txt" => {
                    cont => "File 'al2'.\n",
                    type => 0100,
                    mode => 0755,
                    ctime => 1490603721
                }      
        );
        return (keys %files),0;
    }
}

sub getattr {   
    my ($file) = filename_fixup(shift);
    $file =~ s,^/,,;
    $file = '.' unless length($file);
    return -ENOENT() unless exists($files{$file});
    my ($size) = exists($files{$file}{cont}) ? length($files{$file}{cont}) : 0;
    $size = $files{$file}{size} if exists $files{$file}{size};
    my ($modes) = ($files{$file}{type}<<9) + $files{$file}{mode};
    my ($dev, $ino, $rdev, $blocks, $gid, $uid, $nlink, $blksize) = (0,0,0,1,0,0,1,1024);
    my ($atime, $ctime, $mtime);
    $atime = $ctime = $mtime = $files{$file}{ctime};
    return ($dev,$ino,$modes,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks);
}

Fuse::main(
    mountpoint  => "/tmp/123",
    getdir      => \&getdir,
    getattr     => \&getattr,
);

一级挂载正常，但如果深入到更深层次，我就会遇到

?????????? ? ? ? ?            ? file2.txt
?????????? ? ? ? ?            ? subdir-l2

- Anton Shevtsov

我不确定这与什么有关，但我记得在2014年的YAPC::EU上参加了Xan Tronix关于使用Perl创建文件系统的演讲。虽然它不是Fuse，但也许它会有用。 - simbabque

@simbabque 非常有趣！ - Anton Shevtsov

@simbabque 一切都很好，但是 Filesys::POSIX 文件系统无法挂载到真实文件夹。所有工作都是相反的，即本地路径可以挂载到虚拟路径，反之亦然。 - Anton Shevtsov

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- a1111exe · Accepted Answer

我并不是Fuse模块或FUSE系统的常规用户，只是出于好奇尝试解决这个问题。因此，虽然我无法详细解释如何使用普通的Fuse模块来实现您的目标，但我有一个可以创建所需文件系统的工作代码（至少在我的系统上，并且看起来它能够创建任意的文件系统树），我可以解释一下我是如何让这段代码工作的。

首先，我在CPAN上发现了Fuse::Simple模块。它的SYNOPSIS显示它为Fuse模块提供了一个非常简单的API，用于从哈希结构创建任意文件系统。它的源代码并不大，所以我创建了一个'listing.pl'脚本文件，并将其中大部分函数复制到那里（除了导致 Modification of a read-only value 异常的fserr），将主要子内容放出来，使它们成为主脚本的流程，硬编码文件系统结构（ $fs 变量），进行了一些微小的调整（例如使用 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'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 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 = $@;
    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'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 ",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'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,
        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或其他方式安装它）。但是我认为，如果我只需要使用Perl与FUSE，我可能会使用Fuse::Simple而不是Fuse，也许会分叉它。我想我只会在我的学术研究中使用普通的Fuse...

希望这有所帮助。