Fix a number of TC bugs

git-svn-id: https://shorewall.svn.sourceforge.net/svnroot/shorewall/trunk@5602 fbd18981-670d-0410-9b5c-8dc0c1a9a2bb

New/Shorewall/Chains.pm

@@ -67,6 +67,7 @@ our @EXPORT = qw( STANDARD
 		  new_chain
 		  ensure_chain
 		  ensure_filter_chain
+		  ensure_mangle_chain
 		  new_standard_chain
 		  new_builtin_chain
 		  initialize_chain_table
@@ -469,6 +470,16 @@ sub ensure_filter_chain( $$ )
     $chainref;
 }
 
+sub ensure_mangle_chain($) {
+    my $chain = $_[0];
+
+    my $chainref = ensure_chain 'mangle', $chain;
+    
+    $chainref->{referenced} = 1;
+
+    $chainref;
+}
+
 #
 # Add a builtin chain
 #

New/Shorewall/Providers.pm

@@ -31,7 +31,7 @@ use Shorewall::Chains;
 use strict;
 
 our @ISA = qw(Exporter);
-our @EXPORT = qw( setup_providers );
+our @EXPORT = qw( setup_providers %routemarked_interfaces $routemarked_interfaces);
 our @EXPORT_OK = ( );
 our @VERSION = 1.00;
 
@@ -41,6 +41,9 @@ use constant { LOCAL_NUMBER   => 255,
 	       UNSPEC_NUMBER  => 0
 	       };
 
+our %routemarked_interfaces;
+our $routemarked_interfaces = 0;
+
 my $balance             = 0;
 my $first_default_route = 1;
 
@@ -51,8 +54,6 @@ my %providers  = ( 'local' => { number => LOCAL_NUMBER   , mark => 0 } ,
 		   unspec  => { number => UNSPEC_NUMBER  , mark => 0 } );
 
 my @providers;
-my %routemarked_interfaces;
-my $routemarked_interfaces = 0;
 
 #
 # Set up marking for 'tracked' interfaces. Unline in Shorewall 3.x, we add these rules inconditionally, even if the associated interface isn't up.

New/Shorewall/Tc.pm

@@ -33,11 +33,12 @@ use Shorewall::Config;
 use Shorewall::Zones;
 use Shorewall::Chains;
 use Shorewall::Interfaces;
+use Shorewall::Providers;
 
 use strict;
 
 our @ISA = qw(Exporter);
-our @EXPORT = qw( process_tcrules setup_traffic_shaping );
+our @EXPORT = qw( setup_tc );
 our @EXPORT_OK = qw( process_tc_rule );
 our @VERSION = 1.00;
 
@@ -219,39 +220,6 @@ sub process_tc_rule( $$$$$$$$$$ ) {
     
 }
 	
-#
-# Process the tcrules file
-#
-sub process_tcrules() {
-    
-    open TC, "$ENV{TMP_DIR}/tcrules" or fatal_error "Unable to open stripped tcrules file: $!";
-
-    while ( $line = <TC> ) {
-
-	chomp $line;
-	$line =~ s/\s+/ /g;
-
-	my ( $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $extra ) = split /\s+/, $line;
-
-	if ( $mark eq 'COMMENT' ) {
-	    if ( $capabilities{COMMENTS} ) {
-		( $comment = $line ) =~ s/^\s*COMMENT\s*//;
-		$comment =~ s/\s*$//;
-	    } else {
-		warning_message "COMMENT ignored -- requires comment support in iptables/Netfilter";
-	    }
-	} else {
-	    fatal_error "Invalid tcrule: \"$line\"" if $extra;
-	    process_tc_rule $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos
-	}
-	
-    }
-
-    close TC;
-
-    $comment = '';
-}
-
 #
 # Perl version of Arn Bernin's 'tc4shorewall'.
 #
@@ -366,8 +334,10 @@ sub validate_tc_class( $$$$$$ ) {
 	} elsif ( $option eq 'tcp-ack' ) {
 	    $tcref->{tcp_ack} = 1;
 	} elsif ( $option =~ /^tos=0x[0-9a-f]{2}$/ ) {
+	    ( undef, $option ) = split /=/, $option;
 	    push @{$tcref->{tos}}, "$option/0xff";
 	} elsif ( $option =~ /^tos=0x[0-9a-f]{2}\/0x[0-9a-f]{2}$/ ) {
+	    ( undef, $option ) = split /=/, $option;
 	    push @{$tcref->{tos}}, $option;
 	} else {
 	    fatal_error "Unknown option ( $option ) for tcclass \"$line\"";
@@ -470,7 +440,8 @@ sub setup_traffic_shaping() {
 	my ( $device, $mark ) = split /:/, $class;
 	my $devref  = $tcdevices{$device};
 	my $tcref   = $tcclasses{$device}{$mark};
-	my $classid = "$devref->{number}:${prefix}${mark}";
+	my $devnum  = $devref->{number};
+	my $classid = "$devnum:${prefix}${mark}";
 	my $rate    = $tcref->{rate};
 	my $quantum = calculate_quantum $rate;
 	my $dev     = chain_base $device;
@@ -493,7 +464,7 @@ sub setup_traffic_shaping() {
 	# add filters
 	#
 	if ( "$capabilities{CLASSIFY_TARGET}" && known_interface $device ) {
-	    emit "run_iptables -t mangle -A tcpost -o $device -m mark --mark $mark/0xFF -j CLASSIFY --set-class $classid";
+	    add_rule ensure_chain( 'mangle' , 'tcpost' ), " -o $device -m mark --mark $mark/0xFF -j CLASSIFY --set-class $classid";
 	} else {
 	    emit "run_tc filter add dev $device protocol ip parent $devnum:0 prio 1 handle $mark fw classid $classid";
 	}
@@ -504,7 +475,7 @@ sub setup_traffic_shaping() {
 
 	   
 	for my $tospair ( @{$tcref->{tos}} ) {
-	    my ( $tos, $mask ) = split q(//), $tospair;
+	    my ( $tos, $mask ) = split q(/), $tospair;
 	    emit "run_tc filter add dev $device parent $devnum:0 protocol ip prio 10 u32 match ip tos $tos $mask flowid $classid";
 	}
 
@@ -518,4 +489,75 @@ sub setup_traffic_shaping() {
     }
 }
 
+#
+# Process the tcrules file and setup traffic shaping
+#
+sub setup_tc() {
+
+    ensure_mangle_chain 'tcpre';
+
+    if ( $capabilities{MANGLE_FORWARD} ) {
+	ensure_mangle_chain 'tcfor';
+	ensure_mangle_chain 'tcpost';
+    }
+    
+    open TC, "$ENV{TMP_DIR}/tcrules" or fatal_error "Unable to open stripped tcrules file: $!";
+
+    while ( $line = <TC> ) {
+
+	chomp $line;
+	$line =~ s/\s+/ /g;
+
+	my ( $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos , $extra ) = split /\s+/, $line;
+
+	if ( $mark eq 'COMMENT' ) {
+	    if ( $capabilities{COMMENTS} ) {
+		( $comment = $line ) =~ s/^\s*COMMENT\s*//;
+		$comment =~ s/\s*$//;
+	    } else {
+		warning_message "COMMENT ignored -- requires comment support in iptables/Netfilter";
+	    }
+	} else {
+	    fatal_error "Invalid tcrule: \"$line\"" if $extra;
+	    process_tc_rule $mark, $source, $dest, $proto, $ports, $sports, $user, $testval, $length, $tos
+	}
+	
+    }
+
+    close TC;
+
+    $comment = '';
+
+    my $mark_part = '';
+
+    if ( $routemarked_interfaces && ! $config{TC_EXPERT} ) {
+	$mark_part = '-m mark --mark 0/0xFF00';
+	
+	for my $interface ( keys %routemarked_interfaces ) {
+	    add_rule $mangle_table->{PREROUTING} , "-i $interface -j tcpre";
+	}
+    }
+
+    add_rule $mangle_table->{PREROUTING} , "$mark_part -j tcpre";
+    add_rule $mangle_table->{OUTPUT} ,     "$mark_part -j tcpre";
+
+    if ( $capabilities{MANGLE_FORWARD} ) {
+	add_rule $mangle_table->{FORWARD} ,     '-j tcfor';
+	add_rule $mangle_table->{POSTROUTING} , '-j tcpost';
+    }
+
+    if ( $config{HIGH_ROUTE_MARKS} ) {
+	for my $chain qw(INPUT FORWARD POSTROUTING) {
+	    insert_rule $mangle_table->{$chain}, 1, '-j MARK --and-mark -0xFF';
+	}
+    }
+
+    if ( $config{TC_SCRIPT} ) {
+	save_progress_message 'Setting up Traffic Control...';
+	append_file $config{TC_SCRIPT};
+    } elsif ( $config{TC_ENABLED} eq 'Internal' ) {
+	setup_traffic_shaping if -s "$ENV{TMP_DIR}/tcdevices";
+    }
+}
+
 1;

New/compiler.pl

@@ -49,9 +49,9 @@ use Shorewall::Zones;
 use Shorewall::Interfaces;
 use Shorewall::Hosts;
 use Shorewall::Nat;
+use Shorewall::Providers;
 use Shorewall::Tc;
 use Shorewall::Tunnels;
-use Shorewall::Providers;
 use Shorewall::Policy;
 use Shorewall::Macros;
 use Shorewall::Actions;
@@ -645,9 +645,10 @@ sub compile_firewall( $ ) {
 	emit 'restore_default_route';
     }
     #
-    # Traffic Shaping
+    # TCRules and Traffic Shaping
     #
-    setup_traffic_shaping if -s "$ENV{TMP_DIR}/tcdevices";
+    progress_message2 "Processing TC Rules...";                  
+    setup_tc;
     #
     # Setup Masquerading/SNAT
     #
@@ -689,12 +690,6 @@ sub compile_firewall( $ ) {
     #
     progress_message2 "$doing one-to-one NAT...";                
     setup_nat;
-    #
-    # TCRules
-    #
-    progress_message2 "Processing TC Rules...";                  
-    process_tcrules;
-    #
     # Accounting.
     #
     progress_message2 "Setting UP Accounting...";