Implement a more robust trace

Signed-off-by: Tom Eastep <teastep@shorewall.net>

Shorewall/Perl/Shorewall/Chains.pm

@@ -428,6 +428,23 @@ sub decr_cmd_level( $ ) {
     assert( --$_[0]->{cmdlevel} >= 0);
 }
 
+#
+# Trace a change to the chain table
+#
+sub trace( $$$ ) {
+    my ($chainref, $rulenum, $message) = @_;
+
+    my $heading = $rulenum ? sprintf "NF-----> $chainref->{table}:$chainref->{name}:$rulenum" : sprintf "NF-----> $chainref->{table}:$chainref->{name}";
+
+    my $length = length $heading;
+
+    if ( $length < 32 ) {
+	print $heading . ' ' x ( 32 - $length) . "$message\n";
+    } else {
+	print $heading . ' ' x 8 * ( ( $length + 8 ) / 8 ) . "$message\n";
+    }
+}
+
 #
 # Add run-time commands to a chain. Arguments are:
 #
@@ -440,6 +457,10 @@ sub add_commands ( $$;@ ) {
 
     push @{$chainref->{rules}}, join ('', $indentation , $_ ) for @_;
 
+    if ( $debug ) {
+	print "CS-----> $chainref->{table}:$chainref->{name}\t${indentation}, $_\n" for @_;
+    }
+
     $chainref->{referenced} = 1;
 }
 
@@ -455,6 +476,8 @@ sub push_rule( $$ ) {
     } else {
 	push @{$chainref->{rules}}, $rule;
 	$chainref->{referenced} = 1;
+	my $rulenum;
+	$rulenum=@{$chainref->{rules}}, trace( $chainref, $rulenum, $rule ) if $debug;
     }
 }
 
@@ -577,9 +600,14 @@ sub add_reference ( $$ ) {
 sub purge_jump ( $$ ) {
     my ( $fromref, $toref ) = @_;
     my $to = $toref->{name};
+    my $rule = 0;
 
     for ( @{$fromref->{rules}} ) {
-	$_ = undef if defined && / -[gj] ${to}\b/;
+	$rule++;
+	if ( defined && / -[gj] ${to}\b/ ) {
+	    trace( $fromref, undef, qq("$_" deleted) ) if $debug;
+	    $_ = undef;
+	}
     }
 
     $toref->{referenced} = 0 unless @{$toref->{rules}};
@@ -600,8 +628,11 @@ sub insert_rule1($$$)
     assert( ! $chainref->{cmdlevel});
 
     $rule .= "-m comment --comment \"$comment\"" if $comment;
+    $rule  = join( ' ', '-A', $chainref->{name}, $rule );
 
-    splice( @{$chainref->{rules}}, $number, 0,  join( ' ', '-A', $chainref->{name}, $rule ) );
+    splice( @{$chainref->{rules}}, $number, 0, $rule );
+
+    trace( $chainref, ++$number, $rule ) if $debug;
 
     $iprangematch = 0;
 
@@ -698,6 +729,7 @@ sub move_rules( $$ ) {
 	$chain2->{referenced} = 1;
 	$chain1->{referenced} = 0;
 	$chain1->{rules}      = [];
+	trace( $chain2, undef, "Moved $count rules from chain $chain1->{name}" ), trace( $chain1, undef, 'Invalidated' ) if $debug;
 	$count;
     }
 }
@@ -721,7 +753,9 @@ sub copy_rules( $$ ) {
 
     ( s/\-([AI]) $name1(\b)/-$1 ${name2}$2/ ) for @rules;
 
-    pop @$rules; # Delete the jump to chain1
+    my $last = pop @$rules; # Delete the jump to chain1
+
+    trace( $chain2, undef, "$count rules appended from chain $chain1->{name}" ) if $debug;
 
     push @$rules, @rules;
     #
@@ -733,7 +767,11 @@ sub copy_rules( $$ ) {
 
     unless ( --$chain1->{references}{$name2} ) {
 	delete $chain1->{references}{$name2};
-	$chain1->{referenced} = 0, progress_message "  Unreferenced chain $name1 deleted"  unless keys %{$chain1->{references}};
+	unless ( keys %{$chain1->{references}} ) {
+	    $chain1->{referenced} = 0;
+	    progress_message "  Unreferenced chain $name1 deleted";
+	    trace( $chain1, undef, 'Invalidated' ) if $debug;
+	}    
     }
 }
 
@@ -1333,7 +1371,19 @@ sub optimize_chain( $ ) {
 	    $count = 0;
 
 	    for my $fromref ( map $filter_table->{$_} , keys %{$chainref->{references}} ) {
-		defined && s/ -[jg] $chainref->{name}$/ -j ACCEPT/ && $count++ for @{$fromref->{rules}};
+		my $rule = 0;
+		for ( @{$fromref->{rules}} ) {
+		    $rule++;
+
+		    if ( defined ) {
+			my $before;
+			$before = $_ if $debug;
+			if ( s/ -[jg] $chainref->{name}$/ -j ACCEPT/ ) {
+			    $count++;
+			    trace( $chainref, $rule, qq("$before" changed to "$_") ) if $debug;
+			}
+		    }
+		} 
 	    }
 
 	    progress_message "  $count references to ACCEPT policy chain $chainref->{name} replaced";
@@ -1352,8 +1402,15 @@ sub delete_references( $ ) {
     my $count    = 0;
     
     for my $fromref ( map $chain_table{$table}{$_} , keys %{$chainref->{references}} ) {
+	my $rule = 0;
 	for ( @{$fromref->{rules}} ) {
-	    $_ = undef, $count++ if defined && / -[jg] $chainref->{name}$/;
+	    $rule++;
+
+	    if ( defined && / -[jg] $chainref->{name}$/ ) {
+		trace( $fromref, $rule, qq("$_" deleted) ) if $debug;
+		$_ = undef;
+		$count++;
+	    }
 	}
     }
 
@@ -1382,7 +1439,18 @@ sub replace_references( $$ ) {
 	#
 	for my $fromref ( map $chain_table{$table}{$_} , keys %{$chainref->{references}} ) {
 	    if ( $fromref->{referenced} ) {
-		defined && s/ -([jg]) $chainref->{name}(\b)/ -$1 ${target}$2/ && $count++ for @{$fromref->{rules}};
+		my $rule = 0;
+		for ( @{$fromref->{rules}} ) {
+		    $rule++;
+		    if ( defined ) {
+			my $before;
+			$before = $_ if $debug;
+			if ( s/ -([jg]) $chainref->{name}(\b)/ -$1 ${target}$2/ ) {
+			    $count++;
+			    trace( $fromref, $rule, qq("$before" changed to "$_") ) if $debug;
+			}
+		    }
+		}    
 	    }
 	}
     } else {
@@ -1391,7 +1459,18 @@ sub replace_references( $$ ) {
 	#
 	for my $fromref ( map $chain_table{$table}{$_} , keys %{$chainref->{references}} ) {
 	    if ( $fromref->{referenced} ) {
-		defined && s/ -[jg] $chainref->{name}(\b)/ -j ${target}$1/ && $count++ for @{$fromref->{rules}};
+		my $rule = 0;
+		for ( @{$fromref->{rules}} ) {
+		    $rule++;
+		    if ( defined ) {
+			my $before;
+			$before = $_ if $debug;
+			if ( s/ -[jg] $chainref->{name}(\b)/ -j ${target}$1/ ) {
+			    $count++ ;
+			    trace( $fromref, $rule, qq( "$before" changed to "$_") ) if $debug;
+			}
+		    }
+		}
 	    }
 	}
     }
@@ -1418,14 +1497,21 @@ sub replace_references1( $$$ ) {
 	#
 	for my $fromref ( map $chain_table{$table}{$_} , keys %{$chainref->{references}} ) {
 	    if ( $fromref->{referenced} ) {
+		my $rule = 0;
 		for ( @{$fromref->{rules}} ) {
-		    if ( defined && /^-A $fromref->{name} .*-[jg] $chainref->{name}\b/ ) {
+		    $rule++;
-			#
+		    if ( defined ) {
-			# Prevent multiple '-p' matches
+			if ( /^-A $fromref->{name} .*-[jg] $chainref->{name}\b/ ) {
-			#
+			    my $before;
-			s/ -p [^ ]+ / /	if / -p / && $matches =~ / -p /;
+			    $before = $_ if $debug;
-			s/\s+-([jg]) $chainref->{name}(\b)/$matches -$1 ${target}$2/;
+			    #
-			$count++;
+			    # Prevent multiple '-p' matches
+			    #
+			    s/ -p [^ ]+ / / if / -p / && $matches =~ / -p /;
+			    s/\s+-([jg]) $chainref->{name}(\b)/$matches -$1 ${target}$2/;
+			    $count++;
+			    trace( $fromref, $rule, qq( "$before" changed to "$_") ) if $debug;
+			}
 		    }
 		}
 	    }
@@ -1435,15 +1521,22 @@ sub replace_references1( $$$ ) {
 	# The target is a builtin -- we must use '-j'
 	#
 	for my $fromref ( map $chain_table{$table}{$_} , keys %{$chainref->{references}} ) {
+	    my $rule = 0;
 	    if ( $fromref->{referenced} ) {
 		for ( @{$fromref->{rules}} ) {
-		    if ( defined && /^-A $fromref->{name} .*-[jg] $chainref->{name}\b/ ) {
+		    $rule++;
-			#
+		    if ( defined ) {
-			# Prevent multiple '-p' matches
+			if ( /^-A $fromref->{name} .*-[jg] $chainref->{name}\b/ ) {
-			#
+			    my $before;
-			s/ -p [^ ]+ / /	if / -p / && $matches =~ / -p /;
+			    $before = $_ if $debug;
-			s/\s+-[jg] $chainref->{name}(\b)/$matches -j ${target}$1/;
+			    #
-			$count++;
+			    # Prevent multiple '-p' matches
+			    #
+			    s/ -p [^ ]+ / / if / -p / && $matches =~ / -p /;
+			    s/\s+-[jg] $chainref->{name}(\b)/$matches -j ${target}$1/;
+			    $count++;
+			    trace( $fromref, $rule, qq( "$before" changed to "$_") ) if $debug;
+			}
 		    }
 		}
 	    }

Shorewall/Perl/Shorewall/Compiler.pm

@@ -43,7 +43,7 @@ use Shorewall::Raw;
 our @ISA = qw(Exporter);
 our @EXPORT = qw( compiler );
 our @EXPORT_OK = qw( $export );
-our $VERSION = '4.4_8';
+our $VERSION = '4.4_9';
 
 our $export;
 
@@ -881,9 +881,9 @@ sub compiler {
 	#
 	# Just checking the configuration
 	#
-	if ( $preview ) {
+	if ( $preview || $debug ) {
 	    #
-	    # User wishes to preview the ruleset -- generate the rule matrix
+	    # User wishes to preview the ruleset or we are tracing -- generate the rule matrix
 	    #
 	    generate_matrix;
 
@@ -899,7 +899,7 @@ sub compiler {
 		optimize_ruleset if $config{OPTIMIZE} & 4;
 	    }
 
-	    preview_netfilter_load;
+	    preview_netfilter_load if $preview;
 	}
 	#
 	# Re-initialize the chain table so that process_routestopped() has the same

Shorewall/Perl/Shorewall/Config.pm

@@ -118,6 +118,7 @@ our %EXPORT_TAGS = ( internal => [ qw( create_temp_script
 				       $doing
 				       $done
 				       $currentline
+				       $debug
 				       %config
 				       %globals
 
@@ -880,7 +881,7 @@ sub in_hexp( $ ) {
 sub emit {
     assert( $script_enabled );
 
-    if ( $script ) {
+    if ( $script || $debug ) {
 	#
 	# 'compile' as opposed to 'check'
 	#
@@ -890,10 +891,20 @@ sub emit {
 		$line =~ s/^\n// if $lastlineblank;
 		$line =~ s/^/$indent/gm if $indent;
 		$line =~ s/        /\t/gm;
-		print $script "$line\n";
+		print $script "$line\n" if $script;
 		$lastlineblank = ( substr( $line, -1, 1 ) eq "\n" );
+
+		if ( $debug ) {
+		    $line =~ s/^\n//;
+		    $line =~ s/\n/\nCS-----> /g;
+		    print "CS-----> $line\n";
+		}
 	    } else {
-		print $script "\n" unless $lastlineblank;
+		unless ( $lastlineblank ) {
+		    print $script "\n"  if $script;
+		    print "CS-----> \n" if $debug;
+		}
+
 		$lastlineblank = 1;
 	    }
 	}
@@ -998,7 +1009,7 @@ sub timestamp() {
 }
 
 #
-# Write a message if $verbosity >= 2
+# Write a message if $verbosity >= 2.
 #
 sub progress_message {
     my $havelocaltime = 0;
@@ -1801,6 +1812,7 @@ sub read_a_line() {
 
 		    $currentline = '';
 		} else {
+		    print "IN===> $currentline\n" if $debug;
 		    return 1;
 		}
 	    }
@@ -1822,6 +1834,7 @@ sub read_a_line1() {
 	    $currentline =~ s/#.*$//;       # Remove Trailing Comments
 	    fatal_error "Non-ASCII gunk in file" if $currentline =~ /[^\s[:print:]]/;
 	    $currentlinenumber = $.;
+	    print "IN===> $currentline\n" if $debug;
 	    return 1;
 	}
 
@@ -2047,7 +2060,7 @@ sub load_kernel_modules( ) {
 
 	$loadedmodules{$_}++ for split_list( $config{DONT_LOAD}, 'module' );
 
-	progress_message "Loading Modules...";
+	progress_message2 "Loading Modules...";
 
 	open LSMOD , '-|', 'lsmod' or fatal_error "Can't run lsmod";
 
@@ -2607,6 +2620,8 @@ sub process_shorewall_conf() {
 	if ( -r _ ) {
 	    open_file $file;
 
+	    first_entry "Processing $file...";
+
 	    while ( read_a_line ) {
 		if ( $currentline =~ /^\s*([a-zA-Z]\w*)=(.*?)\s*$/ ) {
 		    my ($var, $val) = ($1, $2);
@@ -3093,7 +3108,7 @@ sub run_user_exit( $ ) {
     my $file = find_file $chainref->{name};
 
     if ( -f $file ) {
-	progress_message "Processing $file...";
+	progress_message2 "Processing $file...";
 
 	my $command = qq(package Shorewall::User;\nno strict;\n# line 1 "$file"\n) . `cat $file`;
 
@@ -3114,7 +3129,7 @@ sub run_user_exit1( $ ) {
     my $file = find_file $_[0];
 
     if ( -f $file ) {
-	progress_message "Processing $file...";
+	progress_message2 "Processing $file...";
 	#
 	# File may be empty -- in which case eval would fail
 	#
@@ -3145,7 +3160,7 @@ sub run_user_exit2( $$ ) {
     my ($file, $chainref) = ( find_file $_[0], $_[1] );
 
     if ( -f $file ) {
-	progress_message "Processing $file...";
+	progress_message2 "Processing $file...";
 	#
 	# File may be empty -- in which case eval would fail
 	#