turtlefirewall.pm

linux环境下的一个防火墙程序的源代码

	print "drop_invalid_fragment: ";
	if( $this->{fw}{OPTION}{drop_invalid_fragment} ne 'off' ) {
		$rules .= "-A CHECK_INVALID -f -j INVALID\n";
		$rules .= "-A INVALID -f ".
			" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID fragment:\"\n";
		print "on\n";
	} else {
		print "off\n";
	}

	$rules .= "-A CHECK_INVALID -j RETURN\n";
	# Log all invalid then drop
	$rules .= "-A INVALID -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID PACKET:\"\n";
	$rules .= "-A INVALID -j DROP\n";

	$rules .= "-A INPUT -j CHECK_INVALID\n";
	$rules .= "-A OUTPUT -j CHECK_INVALID\n";
	$rules .= "-A FORWARD -j CHECK_INVALID\n";
	# END of INVALID Packets filter by Mark Francis
	############################################
	
	# Definizione della catena di ritorno
	# Chain dei pacchetti di ritorno (NO nuove connessioni)
	$chains .= ":BACK - [0:0]\n";
	$rules .= "-A BACK -m state --state ESTABLISHED,RELATED -j ACCEPT\n";
	$rules .= "-A BACK -j RETURN\n";

	# Definizione della catena ICMP-ACC
	# Chain per la gestione degli errori standard ICMP
	$chains .= ":ICMP-ACC - [0:0]\n";
	$rules .= "-A ICMP-ACC -p icmp --icmp-type destination-unreachable -j ACCEPT\n";
	$rules .= "-A ICMP-ACC -p icmp --icmp-type source-quench -j ACCEPT\n";
	$rules .= "-A ICMP-ACC -p icmp --icmp-type time-exceeded -j ACCEPT\n";
	$rules .= "-A ICMP-ACC -p icmp --icmp-type parameter-problem -j ACCEPT\n";
	$rules .= "-A ICMP-ACC -j RETURN\n";

	
	# Creo le catene delle ZONE
	my @zone = $this->GetZoneList();
	for(my $i=0; $i<=$#zone; $i++ ) {
		my $z1 = $zone[$i];
		my %zone1 = $this->GetZone($z1);
		for($j=0; $j<=$#zone; $j++ ) {
			my $z2 = $zone[$j];
			my %zone2 = $this->GetZone($z2);
			if( $z1 eq 'FIREWALL' || $z2 eq 'FIREWALL' ) {
				# Definisco le catene per i pacchetti che hanno come destinazione od
				# origine lo stesso firewall.
				# Notare che escludo la coppia FIREWALL -> FIREWALL
				if( $z1 eq 'FIREWALL' && $z2 ne 'FIREWALL' ) {
					$chains .= ":$z1-$z2 - [0:0]\n";
					$rules .= "-A OUTPUT -o \"".$zone2{'IF'}."\" -j $z1-$z2\n";
					$mangle_chains .= ":$z1-$z2 - [0:0]\n";
					$mangle_rules .= "-A OUTPUT -o \"".$zone2{'IF'}."\" -j $z1-$z2\n";
				}
				if( $z1 ne 'FIREWALL' && $z2 eq 'FIREWALL' ) {
					$chains .= ":$z1-$z2 - [0:0]\n";
					$rules .= "-A INPUT -i ".$zone1{'IF'}." -j $z1-$z2\n";
					$mangle_chains .= ":$z1-$z2 - [0:0]\n";
					$mangle_rules .= "-A INPUT -i ".$zone1{'IF'}." -j $z1-$z2\n";
				}
			} else {
				$chains .= ":$z1-$z2 - [0:0]\n";
				$rules .= "-A FORWARD -i ".$zone1{'IF'}." -o ".$zone2{'IF'}." -j $z1-$z2\n";
				$mangle_chains .= ":$z1-$z2 - [0:0]\n";
				$mangle_rules .= "-A FORWARD -i ".$zone1{'IF'}." -o ".$zone2{'IF'}." -j $z1-$z2\n";
			}
		}
	}
	
	# MASQUERADE (sempre dopo il NAT)
	#my $chains_nat = "#=====================================\n".
	#		"# NAT\n".
	my $chains_nat = "*nat\n".
			":PREROUTING ACCEPT [0:0]\n".
			":POSTROUTING ACCEPT [0:0]\n".
			":OUTPUT ACCEPT [0:0]\n";
	my $rules_nat = '';
	for( my $i=1; $i <= $this->GetNatsCount(); $i++ ) {
		$rules_nat .= $this->applyNat( $this->GetNat($i) );
	}

	# MASQUERADE (sempre dopo il NAT)
	#$chains_nat .= "#=====================================\n".
	#		"# Masquerading\n";
	my $masqueradesCount = $this->GetMasqueradesCount();
	if( $masqueradesCount > 0 ) {
		# Add MASQ chain
		$chains_nat .= ":MASQ - [0:0]\n";
		$rules_nat .= "-A POSTROUTING -j MASQ\n";
		for( my $i=1; $i <= $masqueradesCount; $i++ ) {
			$rules_nat .= $this->applyMasquerade( $this->GetMasquerade($i) );
		}
		# close the MASQ chain with a RETURN to the POSTROUTING parent chain
		$rules_nat .= "-A MASQ -j RETURN\n";
	}
	
	# REDIRECT
	#$chains_nat .= "#=====================================\n".
	#		"# REDIRECT\n";
	my $redirectCount = $this->GetRedirectCount();
	if( $redirectCount > 0 ) {
		# Add REDIR chain
		$chains_nat .= ":REDIR - [0:0]\n";
		$rules_nat .= "-A PREROUTING -j REDIR\n";
		for( my $i=1; $i <= $redirectCount; $i++ ) {
			$rules_nat .= $this->applyRedirect( $this->GetRedirect($i) );
		}
		# close the REDIR chain with a RETURN to the PREROUTING parent chain
		$rules_nat .= "-A REDIR -j RETURN\n";
	}

	# Applicazione delle RULEs
	#$rules .= "#=====================================\n".
	#	"# Regole di forwarding.\n";
	my $rulesCount = $this->GetRulesCount();
	my $mangle_specrules = ''; 
	for( my $i=1; $i <= $rulesCount; $i++ ) {
		$rules .= $this->applyRule( 1, 0, $this->GetRule($i) );
		$mangle_specrules .= $this->applyRule( 0, 1, $this->GetRule($i) );
	}

	# chiudo le catene delle zone
	#$rules .= "#=====================================\n".
	#	"# Chiusura di tutte le catene con relativo log\n";
	for(my $i=0; $i<=$#zone; $i++ ) {
		$z1 = $zone[$i];
		for($j=0; $j<=$#zone; $j++ ) {
			$z2 = $zone[$j];
			if( $z1 ne 'FIREWALL' || $z2 ne 'FIREWALL' ) {
				my $logprefix = "TFW $z1-$z2";
				if( length($logprefix) > 28 ) {
					# iptables need log-prefix strings up to 29 chars length (with char ":")
					$logprefix = substr( $logprefix, 0, 28 );
				}
				#comment( "# Chiusura catena $z1 -> $z2" );
				$rules .= "-A $z1-$z2 -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"$logprefix:\"\n";
				$rules .= "-A $z1-$z2 -j DROP\n";
			}
		}
	}
	for my $chain (('INPUT','OUTPUT','FORWARD')) {
		$rules .= "-A $chain -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW $chain:\"\n";
	}
	print "DENY any other connections\n";
	
	return ($mangle_specrules ? $mangle_chains.$mangle_rules.$mangle_specrules."COMMIT\n" : "*mangle\nCOMMIT\n").
		$chains.$rules."COMMIT\n".$chains_nat.$rules_nat."COMMIT\n";
}


sub applyNat {
	my $this = shift;
	my %nat = @_;

	my %fw = %{$this->{fw}};
	my %fwItems = %{$this->{fwItems}};
	my %services = %{$this->{services}};

	my $rules = '';
	
	if( $nat{ACTIVE} eq 'NO' ) {
		return '';
	}

	my $virtual	= $nat{VIRTUAL};
	my $real	= $nat{REAL};
	my $nmService	= $nat{SERVICE};
	my $port	= $nat{PORT};			# Optional port identifier
	my $virtual_ip='';
	my $virtual_if='';
	my $real_ip='';

	# service is a list of services?
	if( $nmService =~ /,/ ) {
		my @services = split( /,/, $nmService );
		my %newnat = %nat;
		foreach my $serv (@services) {
			$newnat{SERVICE} = $serv;
			$rules .= $this->applyNat( %newnat );
		}
		return $rules;
	}

	if( $virtual eq '' ) {
		print STDERR "Error: VIRTUAL attribute missing in NAT rule definition.\n";
		return $rules;
	}
	if( $real eq '' ) {
		print STDERR "Error: REAL attribute missing in NAT rule definition.\n";
		return $rules;
	}

	if( $fwItems{$virtual} ne 'HOST' && $fwItems{$virtual} ne 'ZONE' ) {
		print STDERR "Error: in a NAT rule definition, VIRTUAL attribute [$virtual] is not a valid host or zone name.\n";
		return $rules;
	}
	if( $fwItems{$virtual} eq 'HOST' ) {
		$virtual_ip = $fw{HOST}{$virtual}{IP};
	}
	if( $fwItems{$virtual} eq 'ZONE' ) {
		$virtual_if = $fw{ZONE}{$virtual}{IF};
	}

	if( $fwItems{$real} ne 'HOST' ) {
		print STDERR "Error: in a NAT rule definition, REAL attribute is not a valid host name.\n";
		return $rules;
	}
	$real_ip = $fw{HOST}{$real}{IP};

	if( $nmService eq '' || $nmService eq 'all' ) {
		# Interface-wide nat. This was the only way natting was used to be.
		if( $virtual_ip ne '' ) {
			# Virtual HOST to Real HOST nat
			print "NAT virtual( $virtual ) --> real( $real )\n";
			#command( "#NAT virtual( $virtual ) -to-> real( $real )" );
			$rules .= "-A PREROUTING -d $virtual_ip -j DNAT --to-destination $real_ip\n";
			# Nat for firewall itself
			$rules .= "-A OUTPUT -d $virtual_ip -j DNAT --to-destination $real_ip\n";
			# Source NAT
			$rules .= "-A POSTROUTING -s $real_ip -j SNAT --to-source $virtual_ip\n";
		} else {
			# ZONE interface to Real HOST nat
			print "NAT from zone( $virtual ) --> real( $real )\n";
			#command( "#NAT from zone ( $virtual ) -to-> real( $real )" );
			$rules .= "-A PREROUTING -i $virtual_if -j DNAT --to-destination $real_ip\n";
			$rules .= "-A POSTROUTING -s $real_ip -o $virtual_if -j MASQUERADE\n";
			# In this case I can't make NAT for firewall itself becouse I can't use -i option
			# with OUTPUT chain
		}
	} else {
		# Service-wide nat. This was introduced with v0.98.
		# On the 'go' way of the specified service we do a DNAT from $virtual_ip:$dport
		# to $real_ip:$dport, while on the 'back' way we do a SNAT from $real_ip:$sport
		# to $virtual_ip:$sport. $state conditions and $jump tags are added to the iptable
		# entries as well.
		
		print "NAT virtual( $virtual ) --> real( $real ) on service( $nmService".
				($port ne '' ? "($port)" : '')." )\n";
		#$rules .= "#NAT virtual( $virtual ) -to-> real( $real ) on service( $nmService($port) )\n";

		# Outputs a nat roule for each defined service channel
		foreach my $filter (@{$services{$nmService}{FILTERS}}) {
			my $direction	= $filter->{DIRECTION};
			my $proto	= $filter->{P};
			my $icmptype	= $filter->{ICMPTYPE};
			my $sport	= $filter->{SPORT};
			my $dport	= $filter->{DPORT};
			my $state	= $filter->{STATE};

			# Fetches
			if( $sport eq 'PORT' ) { $sport = $port; }
			if( $dport eq 'PORT' ) { $dport = $port; }

			# Basic command skeleton
			my $cmd = '';
			$cmd .= (
				$direction eq 'go' ?
					( $virtual_ip ne '' ?
						"-A PREROUTING -d $virtual_ip "
					:
						"-A PREROUTING -i $virtual_if "
					)
				:
					"-A POSTROUTING -s $real_ip "
			);

			# Add protocol filter if the service defines it
			if( $proto eq 'tcp' || $proto eq 'udp' ) {
				$cmd .= "-p $proto ";
				#$cmd .= ( $direction eq 'go' ? "--dport $dport " : "--sport $sport " );
				if( $dport ne '' ) { $cmd .= "--dport $dport "; }
				if( $sport ne '' ) { $cmd .= "--sport $sport "; }
			} elsif( $proto ne 'icmp' ) {
				# Well, I'm coding this... But what purpouse is supposed
				# to have an icmp nat? Mmmmm...
				$cmd .= "-p $proto ";

				if( $icmptype ne '' ) {
					$cmd .= "--icmp-type $icmptype ";
				}
			} elsif( $proto ne '' ) {
				print "  a nat on protocol \"$proto\" had been disregarded.\n";
				next;
			}

			# Add state-related rule
			if( $state ne '' ) {
				$cmd .= "-m state --state $state ";
			}

			# Destination/source mangling
			$cmd .= (
				$direction eq 'go' ?
					"-j DNAT --to-destination $real_ip"
				:
					( $virtual_ip ne '' ?
						"-j SNAT --to-source $virtual_ip"
					:
						"-o $virtual_if -j MASQUERADE"
					)
			);

			# Finally, executes the command
			$rules .= "$cmd\n";

			# If is possible, now I apply the same rule to firewall itself
			if( $cmd =~ /PREROUTING/ && $cmd !~ / -i / ) {
				$cmd =~ s/PREROUTING/OUTPUT/;
				$rules .= "$cmd\n";
			}
		}
	}
	return $rules;
}

# Applica una regola di mascheramento
sub applyMasquerade {
	my $this = shift;
	my %masq = @_;
	
	my %fw = %{$this->{fw}};
	my %fwItems = %{$this->{fwItems}};
	my %services = %{$this->{services}};

	my $rules = '';

	if( $masq{ACTIVE} eq 'NO' ) {
		return '';
	}
	
	# Masquerade or don't masquerade?
	my $is_masquerade = $masq{MASQUERADE} ne 'NO';

	my $src = $masq{SRC};
	my $dst = $masq{DST};
	
	###
	# Backward compatibility with TurtleFirewall < 1.29
	if( !$dst && $masq{ZONE} ) {
		$dst = $masq{ZONE};
	}

	if( $dst eq '' ) {
		print STDERR "Error: DST or ZONE attribute missing in MASQUERADE rule.";
		return $rules;
	}

	#if( $fwItems{$zone} ne 'ZONE' ) {
	#	print STDERR "Error: invalid ZONE attribute missing in MASQUERADE rule.";
	#	return
	#}

	# Vedo se come sorgente ho un group
	if( $fwItems{$src} eq 'GROUP' ) {
		my %newmasq = %masq;
		foreach my $item ( @{$fw{GROUP}{$src}{ITEMS}} ) {
			if( $item ne 'FIREWALL' ) {
				$newmasq{SRC} = $item;
				$rules .= $this->applyMasquerade( %newmasq );
			}
		}
		return $rules;
	}

	# Vedo se come destinazione ho un group
	if( $fwItems{$dst} eq 'GROUP' ) {
		my %newmasq = %masq;
		foreach my $item ( @{$fw{GROUP}{$dst}{ITEMS}} ) {
			if( $item ne 'FIREWALL' ) {
				$newmasq{DST} = $item;
				$rules .= $this->applyMasquerade( %newmasq );
			}
		}
		return $rules;
	}
	
	# Definisco il SERVICE
	my $service = $masq{SERVICE};
	my $port = $masq{PORT};

	# service is a list of services?
	if( $service =~ /,/ ) {
		my @services = split( /,/, $service );
		my %newmasq = %masq;
		foreach my $serv (@services) {
			$newmasq{SERVICE} = $serv;
			$rules .= $this->applyMasquerade( %newmasq );
		}
		return $rules;
	}

	if( $service eq '' ) {
		$service = 'all';
	}

	my ($src_zone, $src_peer, $src_mac) = $this->expand_item( $src );
	my %src_zone_attr = $this->GetZone( $src_zone );
	$src_if = $src_zone_attr{IF};
	my ($dst_zone, $dst_peer) = $this->expand_item( $dst );
	my %dst_zone_attr = $this->GetZone( $dst_zone );
	$dst_if = $dst_zone_attr{IF};
	
	print $is_masquerade ? '' : 'NOT ',"MASQUERADE ( service $service";
	if( $service eq 'tcp' || $service eq 'udp' ) { print "($port)"; }
	print $src ? " $src" : ' *';
	if( $src_mac ne '' ) { print "(mac:$src_mac)"; }
	print " --> $dst ) IF $dst_if\n";
	
	$rules .= $this->applyServiceMasquerade( \%services, $service, $src_if, $src_peer, $src_mac, $dst_if, $dst_peer, $port, $is_masquerade);
	return $rules;
}

sub applyServiceMasquerade {
	my $this = shift;
	my %calledServices = ();
	return $this->_applyServiceMasquerade( \%calledServices, @_ );
}

sub _applyServiceMasquerade {
	my $this = shift;
	my ($ref_calledServices, $ref_services, $serviceName, $src_if, $src_peer, $src_mac, $dst_if, $dst_peer, $port, $is_masquerade) = @_;
	
	my %service = %{$ref_services->{$serviceName}};

	# commento del servizio
	#comment( "# $serviceName: ".$service{DESCRIPTION} );

	$ref_calledServices->{$serviceName} = 1;

	my $rules = '';
	
	# ciclo sulle regole di filering
	my $i;
	for( $i = 0; $i <= $#{$service{FILTERS}}; $i++ ) {

		my %filter = %{$service{FILTERS}[$i]};

		if( $filter{SERVICE} ne '' && !$ref_calledServices->{$filter{SERVICE}} ) {
			# It is a subservice, recursion call to _applyServiceMasquerade
			$rules .= $this->_applyServiceMasquerade( $ref_calledServices, $ref_services, $filter{SERVICE},
				$src_if, $src_peer, $src_mac, $dst_if, $dst_peer, $port, $is_masquerade );
			next;
		}

		my $direction = $filter{DIRECTION};
		my $p = $filter{P};
		my $icmptype = $filter{ICMPTYPE};
		my $sport = $filter{SPORT};
		my $dport = $filter{DPORT};
		my $state = $filter{STATE};
		my $jump = $filter{JUMP};

		if( $direction ne 'go' ) {
			# Don't process Back filters, masquerade is apply only for go direction
			next;
		}

		# porta impostata dalla regola del firewall
		if( $sport eq 'PORT' ) {
			$sport = $port;
		}
		if( $dport eq 'PORT' ) {
			$dport = $port;
		}

		my $cmd='';
		if( $direction eq 'go' && ($jump eq '' || $jump eq 'ACCEPT') ) { 
			$cmd = "-A MASQ ";
			if( $src_if ne '' ) { $cmd .= "-i $src_if "; }
			if( $src_peer && $src_peer ne '0.0.0.0/0' ) { $cmd .= "-s $src_peer "; }
			if( $src_mac =~ /^[0-9a-fA-F]{2}\:[0-9a-fA-F]{2}\:[0-9a-fA-F]{2}\:[0-9a-fA-F]{2}\:[0-9a-fA-F]{2}\:[0-9a-fA-F]{2}$/ ) {
				$cmd .= "-m mac --source-mac $src_mac ";
			}
			if( $dst_if ne '' ) { $cmd .= "-o $dst_if "; }
			if( $dst_peer ne '0.0.0.0/0' ) { $cmd .= "-d $dst_peer "; }
			if( $p ne '' ) { $cmd .= "-p $p "; }
			if( $sport ne '' ) { $cmd .= "--sport $sport "; }
			if( $dport ne '' ) { $cmd .= "--dport $dport "; }
			if( $state ne '' ) { $cmd .= "-m state --state $state "; }
			
			if( $is_masquerade ) {
				$cmd .= "-j MASQUERADE";
			} else {
				# Don't masquerade and return to parent chain
				$cmd .= "-j RETURN";
			}
			
			#print "$cmd\n";
			$rules .= "$cmd\n";
		}
	}
	return $rules;
}

# Apply Redirect rule
sub applyRedirect {
	my $this = shift;
	my %redirect = @_;

	my %fw = %{$this->{fw}};
	my %fwItems = %{$this->{fwItems}};
	my %services = %{$this->{services}};

	my $rules = '';	
	
	if( $redirect{ACTIVE} eq 'NO' ) {
		return '';
	}

	# Redirect or don't redirect?