#! /usr/bin/perl

# Parses a scripted protect file to generate the expected p4 protect
# input format.  Allows for defining a collection of blocks of related
# behavior.  Includes IP range handling, as well.
#
# See the included README.TXT file.
#
# by Matt Albrecht
#
# Revision History:
# 23-May-2003       Initial release


use warnings;
use strict;

use vars qw( $debug $DBGOUT $lineno @protections );
$debug = 0;
$DBGOUT = \*STDERR;
$lineno = 0;
@protections = (
    "list", "read", "write", "super", "open", "review", "admin"
    );

my $globalIP = "*";
my %settings = ();
my @mappings = ();

my @knownTypes = (
    "access", "type", "name", "ip", "globalip"
    );



#-----------------------------------------------------------------------------
# Start functions



# Writes a conditional debug statement
# Arguments:
#   0. Debug text to write.
sub debug($)
{
    print $DBGOUT join( " ", @_ )."\n" if $debug;
}


# Tests if an element is in a list
# Arguments:
#   0. element
#   1... list
# Returns:
#   0 if not found, or 1 if found
sub isInList($@)
{
    my ($element, @list) = @_;
    
    foreach my $i (@list) {
        return 1 if $i eq $element;
    }
    return 0;
}


# Trims off line-feed, left and right whitespace, and comments
# Arguments:
#   0. input line
# Returns:
#   trimmed line
sub trimLine($)
{
    $lineno++;
    
   ($_) = @_;
    return "" if (! $_);
    
    chomp;
    
    # Strip off comments, so that comments do not have to be
    # only on their own line
    s/#.*$//;
    
    # Strip off starting and trailing whitespace.
    s/^\s+//;
    s/\s+$//;

    debug( "trimmed line $lineno to [$_]" );
    
    return $_;
}


# Validates that a protection line is valid (IP address validation comes
# later).
# Arguments:
#   0. access type
#   1. group or user
#   2. group or user name
sub validateArguments($$$)
{
    my ($access, $groupOrUser, $name) = @_;
    debug( "access [$access] type [$groupOrUser] name [$name]" );
    
    die "No protections defined on line $lineno."
        unless ($access && $access ne "");
    die "No group or user type defined on line $lineno."
        unless ($groupOrUser && $groupOrUser ne "");
    die "No group or user name defined on line $lineno."
        unless ($name && $name ne "");
    
    # Validate the protections
    die "Invalid protection '$access' on line $lineno."
        unless isInList($access, @protections);
    
    die "Invalid user or group type on line $lineno."
        unless isInList($groupOrUser, "user", "group");
}


# Parse the IP range value into a set of IP values.  Also, validates
# the IP values returned.
# Arguments:
#   0. the IP range string
# Returns:
#   A list of IP values
sub parseIP($)
{
    my ($ipRangeList) = @_;
    my @ipList = ();
    
    foreach my $ipRange (split(/\s*[\/\|&]\s*/,$ipRangeList)) {
        return "*" if ($ipRange eq "*");

        my $prefix = "";
        if ($ipRange =~ /^proxy-/) {
            $prefix = "proxy-";
            $ipRange = substr($ipRange, 6);
        }
         
        my (@parts) = split( /\./, $ipRange );
        debug( "parts = [".join("|", @parts)."]" );
        die "Incorrect number of IP octets on line $lineno."
            if $#parts != 3;
    
        my @range = ();
        foreach my $part (@parts)
        {
            # Parse the part into a range
            # Currently, this is incomplete!
        
            my @nlist = ();
            if ($part =~ /^(\d+)|\*$/)
            {
                # it's a strict decimal value, or '*'
                push @nlist, $part;
            }
            elsif ($part =~ /^\[(\d+,)+\d+\]$/)
            {
                $_ = $part;
                s/^\[//;
                s/\]$//;
                my @vals = split( /,/ );
                foreach my $val (@vals)
                {
                    push @nlist, $val;
                }
            }
            elsif ($part =~ /^\[(\d+)-(\d+)\]$/)
            {
                for (my $i = $1; $i <= $2; $i++)
                {
                    push @nlist, $i;
                }
            }
            else
            {
                die "Invalid octet format ($part) on line $lineno.";
            }
        
            my $v = \@nlist;
            push @range, $v;
        }
    
        my @r1 = @{$range[0]};
        my @r2 = @{$range[1]};
        my @r3 = @{$range[2]};
        my @r4 = @{$range[3]};
        foreach my $v1 (@r1)
        {
            foreach my $v2 (@r2)
            {
                foreach my $v3 (@r3)
                {
                    foreach my $v4 (@r4)
                    {
                        push @ipList, $prefix . join( ".", $v1, $v2, $v3, $v4 );
                    }
                }
            }
        }
    }
    
print STDERR "ips: [".join("][",@ipList)."]\n";
    return @ipList;
}


# Output the protections line.
# Arguments:
#   0. access type
#   1. group or user
#   2. group or user name
#   3. IP address
#   4. mapping
sub printLine($$$$$)
{
    print "\t", join( " ", @_ ), "\n";
}



#-----------------------------------------------------------------------------
# Start live code
    

print "Protections:\n";

while (<>)
{
    trimLine( $_ );
    
    # skip blank lines and comments
    next if ($_ eq "");
    #next if (/^#/);

    if (/^{/)
    {
        # start of a new block
        /^{(.*)$/;
        my $line = $1;

        # find the end of the block
        while ($line !~ /}$/)
        {
            my $a = trimLine( <> );
            # A line break is the same as a comma
            $line = $line . ';' . $a;
            debug("read block header [$line]");
        }
        # Strip off last colon
        $line =~ /^(.*)}$/;
        $line = $1;
        
        # Parse the block
        %settings = ();
        @mappings = ();
        my @vars = split( /;/, $line );
        foreach my $varset (@vars)
        {
            debug("reading variable setting [$varset]");
            if ($varset =~ /^\s*(-?\/\/.*)\s*$/)
            {
                debug("read mapping [$1]\n");
                push( @mappings, $1 );
            }
            elsif ($varset =~ /^\s*(\S+)\s*=\s*(\S+)\s*$/)
            {
                my $name = lc $1;
                my $value = $2;
                
                my $found = 0;
                foreach my $entry (@knownTypes)
                {
                    $found = 1 if ($entry eq $name);
                }
                die "Unknown block variable name [$name]." if !$found;
                
                debug( "read [$name]=[$value]" );
                if ($name eq "globalip")
                {
                    $globalIP = $value;
                }
                else
                {
                    $settings{ $name } = $value;
                    debug( "Setting = ".$settings{$name} );
                }
            }
        }
    }
    else
    {
        # parse the user line
        my @values = split;
        my $index = 0;
        my $access = $settings{"access"} || $values[$index++];
        my $type = $settings{"type"} || $values[$index++];
        my $name = $settings{"name"} || $values[$index++];
        my $ip = $settings{"ip"} || $globalIP;
        my $mappingAppend;
        
        # path is a bigger issue.
        if ($#mappings <= -1)
        {
            push( @mappings, $values[$index] );
        }
        else
        {
            $mappingAppend = $values[$index];
        }
        
        validateArguments( $access, $type, $name );
        
        my @ipList = parseIP( $ip );
        foreach my $mip (@ipList)
        {
            # output a protection line for each mapping
            if ($mappingAppend && $mappingAppend =~ /^-?\/\//)
            {
                # use the path given, not the list of paths
                printLine( $access, $type, $name, $mip, $mappingAppend );
            }
            else
            {
                # use the list of paths, and maybe append a bit of a path
                foreach my $mapping (@mappings)
                {
                    my $nm = $mapping;
                    if ($mappingAppend)
                    {
                        $nm .= $mappingAppend;
                    }
                    printLine( $access, $type, $name, $mip, $nm );
                }
            }
        }
    }
}