Listing 1: Perlix's mount program. Perlix, The Perl Operating System
The Perl Journal, 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);
}