<commit_before>#!/usr/bin/perl
#
# This module is part of aims, an iptables scripting language.
#
#
package Aims::Main;

use strict;
use warnings;

use File::Spec;

use Aims::NetAddr qw (ip2net ip2bcast);
use Aims::Grammar qw($grammar);
use Aims::Error qw(error warn debug);

use Mexpar::Lexer qw(lex prepare);
use Mexpar::Parser qw(parse ontoken);
use Mexpar::Error qw(delegate mkerrmsg);

use Exporter qw(import);
our @EXPORT_OK = qw(
    compile getcompiled
    newscope endscope getscope
    getlines copyline addline
    getrule newrule skiprule ruleskipped getruleset
    getoption setoption
    getvar setvar
    getcomment setcomment
    ifexists protoexists getifaddr getifnet getifbcast getifmask if2host
    bracelist parenlist
    tokenpos protocheck
);


prepare($grammar);


#
# Define a delegate error handler
#
delegate(sub {
    my $msg = mkerrmsg(@_);
    my $scope = getscope();
    my $file = $scope->{'file'};
    error("$file: $msg");
});


my $protocols = loadprotos();
my $interfaces = loadifs();
my $compiled = [];
my $scopes = [];


# default options
my $defoptions = {
    'inline-comments' => 'off',
    'origin-comments' => 'off',
    'debug' => 'off',
    'log-level' => '',
    'log-prefix' => '',
    'log-tcp-sequence' => 'off',
    'log-tcp-options' => 'off',
    'log-uid' => 'off',
    'strict' => 'off',
};


##
# dovars
# 
# Process variables for the $line
#
# $line The line to process
#
sub dovars
{
    my $line = shift;
    my $scope = getscope();
    my $variables = $scope->{'variables'};

    # replace any variables on the line
    my $i=0;
    foreach my $t (@$line) {
        if ($t->{'type'} eq 'T_VARIABLE') {
            my $varname = substr($t->{'value'}, 1);

            if (!defined($variables->{$varname})) {
                error({
                    code => 'E_UNDEFINED_VARIABLE',
                    file => $t->{'file'},
                    line => $t->{'line'},
                    char => $t->{'char'},
                    name => $t->{'value'}
                });
            }

            my $varval = $variables->{$varname};
            foreach my $vt (@$varval) {
                $vt->{'file'} = $scope->{'file'};
                $vt->{'line'} = $t->{'line'};
                $vt->{'char'} = $t->{'char'};
            }
            splice(@$line, $i, 1, @$varval);
        }
        $i++;
    }

    # process any variable declarations
    my $hastokens = @$line > 1;
    my $vardef = $hastokens && $line->[0]->{'type'} eq 'T_STRING' && $line->[1]->{'type'} eq 'T_EQUALS';
    if ($vardef) {
        my $varname = $line->[0]->{'value'};
        my $varval = [];
        if ($line->[2]->{'type'} eq 'T_QUOTED_STRING') {<commit_msg>Variables with adjacent string tokens are re-lexed after substitution<commit_after>#!/usr/bin/perl
#
# This module is part of aims, an iptables scripting language.
#
#
package Aims::Main;

use strict;
use warnings;

use File::Spec;

use Aims::NetAddr qw (ip2net ip2bcast);
use Aims::Grammar qw($grammar);
use Aims::Error qw(error warn debug);

use Mexpar::Lexer qw(lex prepare);
use Mexpar::Parser qw(parse ontoken);
use Mexpar::Error qw(delegate mkerrmsg);

use Exporter qw(import);
our @EXPORT_OK = qw(
    compile getcompiled
    newscope endscope getscope
    getlines copyline addline
    getrule newrule skiprule ruleskipped getruleset
    getoption setoption
    getvar setvar
    getcomment setcomment
    ifexists protoexists getifaddr getifnet getifbcast getifmask if2host
    bracelist parenlist
    tokenpos protocheck
);


prepare($grammar);


#
# Define a delegate error handler
#
delegate(sub {
    my $msg = mkerrmsg(@_);
    my $scope = getscope();
    my $file = $scope->{'file'};
    error("$file: $msg");
});


my $protocols = loadprotos();
my $interfaces = loadifs();
my $compiled = [];
my $scopes = [];


# default options
my $defoptions = {
    'inline-comments' => 'off',
    'origin-comments' => 'off',
    'debug' => 'off',
    'log-level' => '',
    'log-prefix' => '',
    'log-tcp-sequence' => 'off',
    'log-tcp-options' => 'off',
    'log-uid' => 'off',
    'strict' => 'off',
};


##
# dovars
# 
# Process variables for the $line
#
# $line The line to process
#
sub dovars
{
    my $line = shift;
    my $scope = getscope();
    my $variables = $scope->{'variables'};

    # replace any variables on the line
    my $i=0;
    foreach my $t (@$line) {
        if ($t->{'type'} eq 'T_VARIABLE') {
            my $varname = substr($t->{'value'}, 1);

            if (!defined($variables->{$varname})) {
                error({
                    code => 'E_UNDEFINED_VARIABLE',
                    file => $t->{'file'},
                    line => $t->{'line'},
                    char => $t->{'char'},
                    name => $t->{'value'}
                });
            }

            my $varval = $variables->{$varname};
            foreach my $vt (@$varval) {
                $vt->{'file'} = $scope->{'file'};
                $vt->{'line'} = $t->{'line'};
                $vt->{'char'} = $t->{'char'};
            }
            splice(@$line, $i, 1, @$varval);

            # if the next token is a string and they are adjacent,
            # combine them into one string and re-lex them
            my $nextt = $line->[$i+1];
            my $adjacent = $t->{'char'}+length($t->{'value'}) == $nextt->{'char'};
            if (defined($nextt) && $nextt->{'type'} eq 'T_STRING' && $adjacent) {
                # make a string from the var tokens
                my $vals = [];
                foreach my $v (@$varval) {
                    push(@$vals, $v->{'value'});
                }

                # lex the string and replace the current and next tokens
                # with the result
                my $str = join(' ', @$vals).$nextt->{'value'};
                my $tokens = lex($grammar, [ $str ]);
                pop(@$tokens); # pop the EOF token
                splice(@$line, $i, 2, @$tokens);
            }
        }
        $i++;
    }

    # process any variable declarations
    my $hastokens = @$line > 1;
    my $vardef = $hastokens && $line->[0]->{'type'} eq 'T_STRING' && $line->[1]->{'type'} eq 'T_EQUALS';
    if ($vardef) {
        my $varname = $line->[0]->{'value'};
        my $varval = [];
        if ($line->[2]->{'type'} eq 'T_QUOTED_STRING') {
{'fraction_non_alphanumeric': 0.17603292702232073, 'fraction_numerical': 0.0037992718062371377, 'mean_word_length': 2.1716867469879517, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 88, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '2517978', 'n_tokens_mistral': 2141, 'n_tokens_neox': 2066, 'n_words': 543}