turtlefirewall.pm

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

sub _LoadFirewallItem {
	my $this = shift;

	my $type = shift;
	my @list = @_;

	my %attrs = upperKeys( %{shift @list} );
	my $name = $attrs{'NAME'};

	if( $this->{fwItems}{$name} ne '' ) {
		print STDERR qq~Error: "$name" item is already present.\n~;
	}
	$this->{fwItems}{$name} = $type;
	push @{$this->{fwKeys}{$type}}, $name;
	%{$this->{fw}{$type}{$name}} = %attrs;
	if( $type eq 'GROUP' ) {
		$this->{fw}{'GROUP'}{$name}{ITEMS} = ();
		for( my $j=0; $j<=$#list; $j+=2 ) {
			if( $list[$j] ne '0' ) {
				my %item_attrs = upperKeys( %{ shift @{$list[$j+1]} } );
				my $item = $item_attrs{'NAME'};
				if( $this->{fwItems}{$item} ne '' ) {
					push @{$this->{fw}{'GROUP'}{$name}{ITEMS}}, $item;
				} else {
					print STDERR "Error: $item item of $name group is not defined.\n";
				}
			}
		}
	}
}

###
# Internal method for add NAT, MASQUERADE or REDIRECT to firewall object
sub _LoadFirewallNat {
	my $this = shift;
	my $type = shift;
	my @list = @_;
	#my $name = $list[$i];
	my %attrs = upperKeys( %{shift @list} );
	
	###
	# Backward compatibility with TurtleFirewall < 1.29 configuration file
	if( $type eq 'MASQUERADE' ) {
		if( !$attrs{DST} && $attrs{ZONE} ) {
			$attrs{DST} = $attrs{ZONE};
			delete $attrs{ZONE};
		}
		if( !$attrs{SERVICE} ) {
			$attrs{SERVICE} = 'all';
		}
	}
	
	%{$this->{fw}{$type}[$#{$this->{fw}{$type}}+1]} = %attrs;
}

###
# Internal method for add RULE to firewall object
sub _LoadFirewallRule {
	my $this = shift;
	my @list = @_;
	my %attrs = upperKeys( %{shift @list} );

	my @srcs = split(/,/,$attrs{'SRC'});
	foreach my $src (@srcs) {
		if( $this->{fwItems}{$src} eq '' && $src ne '*' ) {
			print STDERR "Error: rule number ".($#{$this->{fw}{RULE}}+2)." has an invalid source item ($src).\n";
		}
	}

	my @dsts = split(/,/,$attrs{'DST'});
	foreach my $dst (@dsts) {
		if( $this->{fwItems}{$dst} eq '' && $dst ne '*' ) {
			print STDERR "Errore: rule number ".($#{$this->{fw}{RULE}}+2)." has an invalid destination item ($dst).\n";
		}
	}

	%{$this->{fw}{'RULE'}[$#{$this->{fw}{'RULE'}}+1]} = %attrs;
}

###
# Internal method for add OPTIONS to firewall object
#
# XML:
# <options>
#	<option name="option_name" value="option_value"/>
#	<option ...
# </option>
sub _LoadFirewallOptions {
	my $this = shift;
	my @list = @_;

	my %attrs = upperKeys( %{shift @list} );
	for( my $j=0; $j<=$#list; $j+=2 ) {
		if( $list[$j] ne '0' ) {
			my %option_attrs = upperKeys( %{ shift @{$list[$j+1]} } );
			my $name = $option_attrs{'NAME'};
			my $value = $option_attrs{'VALUE'};
			$this->{fw}{OPTION}{$name} = $value;
		}
	}
}




sub LoadServices {
	my $this = shift;
	my $servicesFile = shift;
	my $userdefServicesFile = shift;

	$this->{fwservices_file} = $servicesFile;
	$this->{userdef_fwservices_file} = $userdefServicesFile;

	my $xml = new XML::Parser( Style=>'Tree' );

	foreach $fileName ( ($servicesFile, $userdefServicesFile) ) {
		if( -f $fileName ) {

			my @tree = @{ $xml->parsefile( $fileName ) };

			#------
			# Ciclo sui tag di primo livello (SERVICES)
			for( my $i=0; $i<=$#tree; $i+=2 ) {
				my $name = uc($tree[$i]);
				if ($name eq 'SERVICES') {
					my @list = @{$tree[$i+1]};
					shift @list;

					#------
					# Ciclo sui tag di secondo livello (SERVICE)
					for( my $j=0; $j<=$#list; $j+=2 ) {
						my $name2 = uc($list[$j]);
						if( $name2 eq 'SERVICE' ) {
							my %attrs = upperKeys( %{ shift @{$list[$j+1]} } );
							my @filters = @{$list[$j+1]};

							my $service = $attrs{'NAME'};

							%{ $this->{services}{$service} } = (
								'DESCRIPTION' => $attrs{'DESCRIPTION'},
								'FILTERS' => ()
								);

							for( my $k=0; $k<=$#filters; $k+=2 ) {
								my $name3 = uc( $filters[$k] );
								my %filter = upperKeys( %{shift @{$filters[$k+1]}} );
								if( $name3 eq 'FILTER' ) {
									%{$this->{services}{$service}{FILTERS}[$#{$this->{services}{$service}{FILTERS}}+1]} = %filter;
								}
							}
						}
					}
				}
			}
		}
	}
}

###
# Funzione di servizio.
# Passato un hash come parametro ne converte le chiavi in maiuscolo.
sub upperKeys {
	my %hash = @_;
	my %newHash;
	@ks = keys %hash;
	foreach $k (@ks) {
		$newHash{uc($k)} = $hash{$k};
	}
	return %newHash;
}

sub SaveFirewall {
	my $this = shift;
	$this->SaveFirewallAs( $this->{fw_file} );
}

sub SaveFirewallAs {
	my $this = shift;
	my ($fwFile) = @_;

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

	my $xml = "<firewall>\n";

	$xml .= "\n";
	$xml .= "<options>\n";
	foreach my $k (keys %{$fw{'OPTION'}}) {
		$xml .= $this->attr2xml( 'option', ('name'=>$k, 'value'=>$fw{'OPTION'}{$k}) );
	}
	$xml .= "</options>\n";

	$xml .= "\n";
	foreach my $k (keys %{$fw{'ZONE'}}) {
		if( $k ne 'FIREWALL' ) {
			$xml .= $this->attr2xml( 'zone', %{$fw{'ZONE'}{$k}} );
		}
	}
	$xml .= "\n";
	foreach my $k (keys %{$fw{'NET'}}) {
		$xml .= $this->attr2xml( 'net', %{$fw{'NET'}{$k}} );
	}
	$xml .= "\n";
	foreach my $k (keys %{$fw{'HOST'}}) {
		$xml .= $this->attr2xml( 'host', %{$fw{'HOST'}{$k}} );
	}
	$xml .= "\n";
	#foreach my $k (keys %{$fw{'GROUP'}}) {
	foreach my $k (@{$this->{fwKeys}{GROUP}}) {
		$xml .= "<group name=\"$k\" description=\"".$this->_clean($fw{'GROUP'}{$k}{DESCRIPTION})."\">\n";
		foreach my $item (@{$fw{'GROUP'}{$k}{ITEMS}}) {
			$xml .= "\t<item name=\"".$this->_clean($item)."\"/>\n";
		}
		$xml .= "</group>\n";
	}
	$xml .= "\n";
	my @nats = @{$fw{'NAT'}};
	for my $i (0..$#nats) {
		$xml .= $this->attr2xml( 'nat', %{$nats[$i]} );
	}
	$xml .= "\n";
	my @masq = @{$fw{'MASQUERADE'}};
	for my $i (0..$#masq) {
		$xml .= $this->attr2xml( 'masquerade', %{$masq[$i]} );
	}
	$xml .= "\n";
	my @redirectlist = @{$fw{'REDIRECT'}};
	for my $i (0..$#redirectlist) {
		$xml .= $this->attr2xml( 'redirect', %{$redirectlist[$i]} );
	}
	$xml .= "\n";
	my @rules = @{$fw{'RULE'}};
	for my $i (0..$#rules) {
		$xml .= $this->attr2xml( 'rule', %{$rules[$i]} );
	}
	$xml .= "\n";
	$xml .= "</firewall>\n";

	open( FWFILE, ">$fwFile" );
	print FWFILE $xml;
	close( FWFILE );
}
sub attr2xml {
	my $this = shift;
	my ($tag, %attr, @order) = @_;
	my $appo = "<$tag";
	foreach my $k (keys %attr) {
		$appo .= ' '.lc($k).'="'.$this->_clean($attr{$k}).'"';
	}
	$appo .= "/>\n";
	return $appo;
}
# Translate """ to "'", "<" to "&lt;" and ">" to "&gt;" and "&" to "&amp;"
sub _clean {
	my $this = shift;
	my $s = shift;
	$s =~ s/\"/\'/g;
	$s =~ s/\</&lt;/g;
	$s =~ s/\>/&gt;/g;
	$s =~ s/\&/&amp;/g;
	return $s;
}

###
# Check if a name is correct (use only [a-zA-Z0-9\_\-])
sub checkName {
	my $this = shift;
	my $name = shift;
	return $name =~ /^[a-zA-Z0-9\_\-]*$/;
}


# Return the status of firewall (1 = 0n, 0 = off)
sub GetStatus {
	my $iptables = qx{iptables -L -n};
	return $iptables =~ /Chain BACK/g;
}


sub startFirewall {
	my $this = shift;
	
	# PreLoad modules for ftp connections and NAT
	$this->command("modprobe ip_tables >& /dev/null");
	$this->command("modprobe ip_conntrack >& /dev/null");
	$this->command("modprobe ip_conntrack_ftp >& /dev/null");
	$this->command("modprobe ip_nat_ftp >& /dev/null");
		
	# Abilitiamo l'IP forwarding
	$this->command("echo \"1\" >/proc/sys/net/ipv4/ip_forward");
	
	if( $this->{fw}{OPTION}{rp_filter} eq 'unchange' ) {
		print "rp_filter: unchange\n";
	} else {
		my $flag;
		if( $this->{fw}{OPTION}{rp_filter} eq 'off' ) {
			print "rp_filter: off\n";
			$flag = 0;
		} else {
			print "rp_filter: on\n";
			$flag = 1;
		}
		$this->command("for f in /proc/sys/net/ipv4/conf/*/rp_filter; do echo $flag > ".'$f'."; done" );
	}

	if( $this->{fw}{OPTION}{log_martians} eq 'unchange' ) {
		print "log_martians: unchange\n";
	} else {
		my $flag;
		if( $this->{fw}{OPTION}{log_martians} eq 'off' ) {
			print "log_martians: off\n";
			$flag = 0;
		} else {
			print "log_martians: on\n";
			$flag = 1;
		}
		$this->command( "for f in /proc/sys/net/ipv4/conf/*/log_martians; do echo $flag > ".'$f'."; done" );
	}
	
	###
	# I want ever icmp_echo_ignore_all set to off. Turtle Firewall use iptables
	# rules for drop or allow icmp echo packets. Andrea Frigido 2004-07-17
	$this->command( "echo \"1\" >/proc/sys/net/ipv4/icmp_echo_ignore_broadcasts" );
	$this->command( "echo \"0\" >/proc/sys/net/ipv4/icmp_echo_ignore_all" );
	
	###
	# Disable tcp_ecn flag.
	$this->command( "echo 0 > /proc/sys/net/ipv4/tcp_ecn" );

	# Don't accept source routed packets. Attackers can use source routing to generate
	# traffic pretending to be from inside your network, but which is routed back along
	# the path from which it came, namely outside, so attackers can compromise your
	# network. Source routing is rarely used for legitimate purposes.
	$this->command( "for f in /proc/sys/net/ipv4/conf/*/accept_source_route; do echo 0 > ".'$f'."; done" );

	# Disable ICMP redirect acceptance. ICMP redirects can be used to alter your routing
	# tables, possibly to a bad end.
	$this->command( "for f in /proc/sys/net/ipv4/conf/*/accept_redirects; do echo 0 > ".'$f'."; done" );

	# Enable bad error message protection.
	$this->command( "echo 1 > /proc/sys/net/ipv4/icmp_ignore_bogus_error_responses" );
	
	####
	# Other options
	if( $this->{fw}{OPTION}{ip_conntrack_max} > 0 ) {
		open( FILE, ">/proc/sys/net/ipv4/ip_conntrack_max" );
		print FILE $this->{fw}{OPTION}{ip_conntrack_max};
		close FILE;
		print "ip_conntrack_max: ",$this->{fw}{OPTION}{ip_conntrack_max},"\n";
	}

	my $rules = $this->getIptablesRules();
	
	my $use_iptables_restore = 1;
	
	if( $use_iptables_restore ) {
		umask 0077;
		open FILE, ">/etc/turtlefirewall/iptables.dat";
		print FILE $rules;
		close FILE;
		print "run iptables-restore\n";
		if( -x '/sbin/iptables-restore' ) {
			$this->command("cat /etc/turtlefirewall/iptables.dat | /sbin/iptables-restore");
		} elsif( -x '/usr/sbin/iptables-restore' ) {
			$this->command("cat /etc/turtlefirewall/iptables.dat | /usr/sbin/iptables-restore");	
		} else {
			print STDERR "Error: iptables-restore needed\n";
		}
		# doesn't unlink, for debugging
		#unlink "/etc/turtlefirewall/iptables.dat";
	} else {	
		$this->iptables_restore_emu( $rules );
	}

}

sub stopFirewall {
	my $this = shift;
	#
	# Stop the firewall, allow all connections.
	#
	$this->command(
		"iptables -F\n".
		"iptables -X\n".
		"iptables -t nat -F\n".
		"iptables -t nat -X\n".
		"iptables -P INPUT ACCEPT\n".
		"iptables -P OUTPUT ACCEPT\n".
		"iptables -P FORWARD ACCEPT" );
	# enable ping
	$this->command( "echo \"0\" >/proc/sys/net/ipv4/icmp_echo_ignore_all" );
}

###
# 
sub getIptablesRules {
	my $this = shift;
	
	my $chains = '';
	my $rules = '';
	
	my $mangle_chains = '';
	my $mangle_rules = '';
	
	my $log_limit=60;
	my $log_limit_burst=5;
	if( $this->{fw}{OPTION}{log_limit} > 0 ) {
		$log_limit = $this->{fw}{OPTION}{log_limit};
		print "log_limit: $log_limit\n";
	}
	if( $this->{fw}{OPTION}{log_limit_burst} > 0 ) {
		$log_limit_burst = $this->{fw}{OPTION}{log_limit_burst};
		print "log_limit_burst: $log_limit_burst\n";
	}
	$this->{log_limit} = $log_limit;
	$this->{log_limit_burst} = $log_limit_burst;
	
	$chains .= "*filter\n";
	$chains .= ":FORWARD DROP [0:0]\n";
	$chains .= ":INPUT DROP [0:0]\n";
	$chains .= ":OUTPUT DROP [0:0]\n";

	# Chains for mangle table
	$mangle_chains .= "*mangle\n".
			":PREROUTING ACCEPT [0:0]\n".
			":INPUT ACCEPT [0:0]\n".
			":FORWARD ACCEPT [0:0]\n".
			":OUTPUT ACCEPT [0:0]\n".
			":POSTROUTING ACCEPT [0:0]\n";
	
	# abilito l'accesso da/verso l'interfaccia lo.
	$rules .= "-A INPUT -i lo -j ACCEPT\n";
	$rules .= "-A OUTPUT -o lo -j ACCEPT\n";

	### Log invalid packets then drop packets
	$chains .= ":INVALID - [0:0]\n";
	$chains .= ":CHECK_INVALID - [0:0]\n";
	
	###
	# Deprecated (doesn't work with kernel 2.6,x)
	#print "drop_unclean: ";
	#if( $this->{fw}{OPTION}{drop_unclean} eq 'on' ) {
	#	# 13-09-2002 It doesn't work, wait stable version of unclean module (Andrea Frigido)
	#	# This next rule is marked experimental but does not appear to block legitimite traffic
	#	$rules .= "-A CHECK_INVALID -m unclean -j INVALID\n";
	#	$rules .= "-A INVALID -m unclean ".
	#		" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID unclean:\"\n";
	#	print "on\n";
	#} else {
	#	print "off\n";
	#}
	
	print "drop_invalid_state: ";
	if( $this->{fw}{OPTION}{drop_invalid_state} ne 'off' ) {
		$rules .= "-A CHECK_INVALID -m state --state INVALID -j INVALID\n";
		$rules .= "-A INVALID -m state --state INVALID ".
			" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID STATE:\"\n";
		print "on\n";
	} else {
		print "off\n";
	}
	
	print "drop_invalid_all: ";
	if( $this->{fw}{OPTION}{drop_invalid_all} ne 'off' ) {
		$rules .= "-A CHECK_INVALID -p tcp --tcp-flags ALL ALL -j INVALID\n";
		$rules .= "-A INVALID -p tcp --tcp-flags ALL ALL ".
			" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID ALL:\"\n";
		print "on\n";
	} else {
		print "off\n";
	}
	
	print "drop_invalid_none: ";
	if( $this->{fw}{OPTION}{drop_invalid_none} ne 'off' ) {
		$rules .= "-A CHECK_INVALID -p tcp --tcp-flags ALL NONE -j INVALID\n";
		$rules .= "-A INVALID -p tcp --tcp-flags ALL NONE ".
			" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID NONE:\"\n";
		print "on\n";
	} else {
		print "off\n";
	}
	
	print "drop_invalid_fin_notack: ";
	if( $this->{fw}{OPTION}{drop_invalid_fin_notack} ne 'off' ) {
		$rules .= "-A CHECK_INVALID -p tcp --tcp-flags FIN,ACK FIN -j INVALID\n";
		$rules .= "-A INVALID -p tcp --tcp-flags FIN,ACK FIN ".
			" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID FIN,!ACK:\"\n";
		print "on\n";
	} else {
		print "off\n";
	}
	
	print "drop_invalid_sys_fin: ";
	if( $this->{fw}{OPTION}{drop_invalid_syn_fin} ne 'off' ) {
		$rules .= "-A CHECK_INVALID -p tcp --tcp-flags SYN,FIN SYN,FIN -j INVALID\n";
		$rules .= "-A INVALID -p tcp --tcp-flags SYN,FIN SYN,FIN ".
			" -m limit --limit $log_limit/hour --limit-burst $log_limit_burst -j LOG --log-prefix \"TFW INVALID SYN,FIN:\"\n";
		print "on\n";
	} else {
		print "off\n";
	}

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