Martin Krzywinski - The Perl Journal - Canada's Michael Smith Genome Sciences Centre

listing 1

Perlix, The Perl Operating System The Perl Journal, Summer 2000

Simon Cozens (2000) Perlix, the Perl Operating System. The Perl Journal, vol 5(2), issue #18, Summer 2000.

 
#!/lib/perl -w
use strict;      # This is an operating system, after all.
my $canxml; eval { use XML::Simple }; $canxml++ unless $@;
my $VERSION = "1.0";
use Data::Dumper;
use Getopt::Std; my %options;
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;};
my %fstab; open(FSTAB, "/etc/fstab") or die "$0: Can't open fstab: $!\n";
if (($_=<FSTAB>) =~/^<\?xml/) {
     die "XML support not installed.\n" unless $canxml;
     $fstab{$_->{directory}} =
          [ $_->{filesystem}, $_->{type}, join ",", keys %{$_->{options}} ]
     for (@{XMLin(join "", <FSTAB>)->{entry}}) ;
} else {
     do {
          next if /^#/;
          my ($device, $mpoint, $type, $options) = split;
          $fstab{$mpoint} = [$device, $type, $options];
     } while (defined ($_ = <FSTAB>));
}
print Dumper(\%fstab);
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.
     $where =$dev_or_point;
     ($what,$type) = ($fstab{$where}->[0], $fstab{$where}->[1]);
     defined $options{t} && do {print "Can't change type here.\n"; exit};
     $options{o} ||= $fstab{$where}->[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 $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);
}

The Perl Journal

Volumes 1–6 (1996–2002)

Perlix, the Perl Operating System

Simon Cozens

listing 1