#!/usr/bin/perl

# Extract data from IPS manifests
# and write driver configuration files:
# /etc/driver_aliases,
# /etc/driver_classes,
# /etc/minor_perm,
# /etc/devlink.tab,
# /etc/name_to_major,
# /etc/security/device_policy,
# /etc/security/extra_privs.

use strict;
use warnings FATAL => 'all';
use Getopt::Long qw(:config no_ignore_case);

# All these array contain strings ending with "\n":
my @driver_aliases = ();    # strings like 'e1000g "pci8086,1010"'
my @driver_classes = ();    # strings like 'adpu320<tab>scsi'
my @minor_perm     = ();    # strings like 'devinfo:devinfo,ro 0444 root sys'
my @device_policy =
  ();    # strings like 'mm:* read_priv_set=none write_priv_set=none'
my @devlink_tab =
  ();    # strings like 'type=ddi_pseudo;minor1=cpqary3<tab>cpqary3\M2'
my @extra_privs   = ();    # strings like 'nskern:sys_devices'
my @name_to_major = ();    # strings like 'mm 16'

# Drivers' major numbers:
my %major2name = ();       # id => name
my %name2major = ();       # name => id

# Default open privileges, must be first entry in the file:
push @device_policy, "* read_priv_set=none write_priv_set=none\n";

# -D i386_ONLY=
my %defs    = ();
my $rootdir = '/tmp';
my $majors  = 'debian/name_to_major';
my $arch    = 'i386';
my @archs   = qw/i386 sparc/;

sub usage() {
    print <<USAGE;
Usage: $0 [options] [manifests] ...
   or: cat manifest | $0 [options]

Options:
    -D var=value    Define a variable to substitute in manifests
                    E. g. if you want x86 drivers, set i386_ONLY
                    to empty string: -D i386_ONLY=

    -r directory    Create file tree under this directory ($rootdir)
                    This script will create all required directories,
                    including /etc. Every file will be overwritten.

    -m file         initial name2major file with predefined
                    major numbers ($majors)

    -a arch         Consider drivers for this architecture only ($arch),
                    supported values: @archs

    --help, -h      Show this message

USAGE
    exit 1;
}

GetOptions(
    'r=s'    => \$rootdir,
    'D=s'    => \%defs,
    'm=s'    => \$majors,
    'a=s'    => \$arch,
    'help|h' => sub { usage() },
) or usage();

sub set_major($$) {
    my ( $name, $id ) = @_;
    die "`$name' already defined ($name2major{$name})"
      if exists $name2major{$name};
    die "`$id' already defined ($major2name{$id})" if exists $major2name{$id};
    $name2major{$name} = $id;
    $major2name{$id}   = $name;
}

sub new_major($) {
    my ($name) = @_;
    return if exists $name2major{$name};

    my $newid = 1;
    $newid++ while exists $major2name{$newid};
    set_major( $name, $newid );
}

sub collect($) {
    my $drv  = $_[0];
    my $name = '';

    # For the case when name= does not go first:
    if ( $drv =~ m/\bname=([a-zA-Z0-9_-]+)\b/ ) {
        $name = $1;
    }
    else {
        die "could not get a driver name from line `$drv'";
    }

# http://stackoverflow.com/questions/168171/regular-expression-for-parsing-name-value-pairs
    while (
        $drv =~ s/((?:\\.|[^= ]+)*)=("(?:\\.|[^"\\]+)*"|(?:\\.|[^ "\\]+)*)// )
    {
        my ( $k, $v ) = ( $1, $2 );
        $v =~ s/^"(.+)"$/$1/;
        $v =~ s/^'(.+)'$/$1/;
        if ( $k eq 'name' ) {
            $name eq $v
              or die
"We've read name= again and it differs from the previous: `$name' != `$v'";
        }
        elsif ( $k eq "alias" ) {
            push @driver_aliases, qq($name "$v"\n);
        }
        elsif ( $k eq "perms" ) {
            push @minor_perm, qq($name:$v\n);
        }
        elsif ( $k eq "clone_perms" ) {
            push @minor_perm, qq(clone:$v\n);    # Fuck you, IPS.
        }
        elsif ( $k eq "class" ) {
            push @driver_classes, qq($name\t$v\n);
        }
        elsif ( $k eq "policy" ) {
            my ($first_token) = split( /\s+/, $v );
            $v = "* $v" if $first_token =~ /=/;
            push @device_policy, qq($name:$v\n);
        }
        elsif ( $k eq "devlink" ) {
            $v =~ s/\\t/\t/g;
            push @devlink_tab, qq($v\n);
        }
        elsif ( $k eq "privs" ) {
            push @extra_privs, qq($name:$v\n);
        }
        else {
            die "Do not know what to do with `$k=$v'";
        }
    }

    # Do it here to ensure $name is correct:
    new_major($name);
}

sub read_manifest($) {
    open( MF, '<', $_[0] ) or die "Could not open `$_[0]' for reading: $!";

# http://stackoverflow.com/questions/12799907/how-to-read-multi-line-values-from-a-file-using-perl
    while (<MF>) {

        # Maybe multiline:
        $_ .= <MF> while s/\\\n// and not eof;

        # Substitute variables:
        foreach my $k ( keys %defs ) {
            s/\Q$($k)\E/$defs{$k}/g;
        }

        # Ignore comments:
        next if /^#/;

        # Skip sparc drivers on i386 and vice versa.
        # For common drivers variable ARCH must be defined
        # (i386 or sparc, e. g. -D ARCH=i386)
        if (/^set\s+name=variant\.arch\s+value=(\S+)/) {
            $1 ~~ @archs
              or die "arch `$1' is not within supported list: @archs";
            last if $1 ne $arch;
        }

        if (/^driver/) {
            chomp;
            collect($_);
        }
    }
    close(MF);
}

$arch ~~ @archs or die "Architecture `$arch' is not supported";

-d "$rootdir" or die "`$rootdir': not such directory.";

open( N2M, '<', $majors ) or die "Could not open `$majors' for reading: $!";
while (<N2M>) {
    my ( $n, $m ) = split( /\s+/, $_ );
    set_major( $n, $m );
}
close(N2M);

# Reading IPS manifests given in command line:
if (@ARGV) {
    read_manifest($_) foreach (@ARGV);
}
else {    # or from stdin:
    while (<STDIN>) {
        chomp;
        read_manifest($_);
    }
}

-d "$rootdir/etc"
  or mkdir "$rootdir/etc"
  or die "Could not mkdir `$rootdir/etc': $!";
-d "$rootdir/etc/security"
  or mkdir "$rootdir/etc/security"
  or die "Could not mkdir `$rootdir/etc/security': $!";

sub write_file($$) {
    my ( $fname, $array_ref ) = @_;
    open( DA, ">$fname" ) or die "Could not open `$fname' for writing: $!";
    print DA foreach @{$array_ref};
    close(DA);
}

# Asterisk (*) will go first. It is important for device_policy.
@device_policy  = sort { $a cmp $b } @device_policy;
@devlink_tab    = sort { $a cmp $b } @devlink_tab;
@driver_aliases = sort { $a cmp $b } @driver_aliases;
@driver_classes = sort { $a cmp $b } @driver_classes;
@extra_privs    = sort { $a cmp $b } @extra_privs;
@minor_perm     = sort { $a cmp $b } @minor_perm;
@name_to_major =
  map { "$major2name{$_} $_\n" } sort { $a <=> $b } keys %major2name;

write_file( "$rootdir/etc/driver_aliases",         \@driver_aliases );
write_file( "$rootdir/etc/driver_classes",         \@driver_classes );
write_file( "$rootdir/etc/minor_perm",             \@minor_perm );
write_file( "$rootdir/etc/name_to_major",          \@name_to_major );
write_file( "$rootdir/etc/devlink.tab",            \@devlink_tab );
write_file( "$rootdir/etc/security/device_policy", \@device_policy );
write_file( "$rootdir/etc/security/extra_privs",   \@extra_privs );

exit(0);