[Tokyo.pm] (Fun) mount.pl

[scozens ＠ pwj.co.jp]

カズンズです。

リナックスをご理由するの方が、今書いたばっかりのものをご覧になってくさい：
リナックスのカーナルの上にすあるPerlix というPerl OSです。libcやGNUの
ものがはいてありません、PPT (http://language.perl.com/ppt/)
とシステム的なアップを集まて、全部はパールです。 それとも、Linux-OSより
早いし、簡単し、ライトウェイトてす。本当ですよ。つぎのTPJで説明するはずだ
けれど、ここにスニーク・プリービューです。

今晩、ftp://othersideofthe.earth.li/pub/perl/perlix.tar.gzで出発したい。
そこまで、世界誕生のmountを紹介したいんです:

#!/lib/perl -w
###　大切：自分の責任において使える... ####
use strict; # This is an operating system, after all.
use Getopt::Std; my %options;
my $VERSION ="1.0";

getopts("t:ho:v",\%options);
defined $options{v} && do {print "Perlix mount version $VERSION\n"; exit};
defined $options{h} && exec("perldoc mount");
my $dev_or_point = shift || do {print "mtab support not here yet.\n";
exit;};
$dev_or_point =~ s|/$||;

my %fstab; open(FSTAB, "/etc/fstab") or die "$0: Can't open fstab: $!\n";
while (<FSTAB>) {
    next if /^#/;
    my ($device, $mpoint, $type, $options)=split;
    $fstab{$mpoint}=[$device, $type, $options];
}

require "syscall.ph"; require "/usr/include/mount.ph";
use constant MAGIC => 0xC0ED0000; # Kernel mount magic. (Linux specific!)
use constant MS_RDONLY  =>   0; use constant MS_NOSUID  => 1;
use constant MS_NODEV   =>   2; use constant MS_NOEXEC  => 3;
use constant MS_SYNC    =>   4; use constant MS_REMOUNT => 5;

my ($mount, $what, $where, $type);
if (exists $fstab{$dev_or_point}) { # It's a mount point.
    $what =$dev_or_point;
    ($where,$type) = ($fstab{$what}->[0], $fstab{$what}->[1]);
    defined $options{t} && do {print "Can't change type here.\n"; exit};
    $options{o} ||=$fstab{$what}->[2],
    $mount = options($options{o})+(0+MAGIC);
} else { # It's a block device, you'd hope.
    $what=$dev_or_point;
    -b $what or die "$what isn't a block device.\n";
    $where=shift or die "You need to tell me where to mount $what\n";
    $mount = options($options{o}||"")+(0+MAGIC);
    $type=$options{t} or die "Don't know how to mount $what on $where\n";
}

my $data="";
syscall(&SYS_mount, $what, $where, $type, $mount, $data);
die "Mounting $what on $where: $!\n" if $!;

sub options {
    my $options = shift;
    my $options = shift;
    my $mode=chr(0); # I've got a bit vector and I'm not afraid to use it.
    for (split ",", $options) {
        last if $_ eq "defaults";
        ($_ eq "ro"       ) && do { vec($mode,MS_RDONLY ,1)=1; next};
        ($_ eq "rw"       ) && do { vec($mode,MS_RDONLY ,1)=0; next};
        ($_ eq "nosuid"   ) && do { vec($mode,MS_NOSUID ,1)=1; next};
        ($_ eq "nodev"    ) && do { vec($mode,MS_NODEV  ,1)=1; next};
        ($_ eq "noexec"   ) && do { vec($mode,MS_NOEXEC ,1)=1; next};
        ($_ eq "sync"     ) && do { vec($mode,MS_SYNC   ,1)=1; next};
        ($_ eq "remount"  ) && do { vec($mode,MS_REMOUNT,1)=1; next};
        warn "Unrecognised option $_ ignored\n";
    }
    return ord($mode);
}

--
正気？もちろん正気だ。なぜ尋ねる？