turtlefirewall.pm

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

	my $is_redirect = $redirect{REDIRECT} ne 'NO';

	my $src = $redirect{SRC};
	my $dst = $redirect{DST};

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

	# Vedo se come destinazione ho un group
	if( $fwItems{$dst} eq 'GROUP' ) {
		my %newredirect = %redirect;
		foreach my $item ( @{$fw{GROUP}{$dst}{ITEMS}} ) {
			# Ignore ZONE items (PREROUTING don't accept -o option)
			if( $item ne 'FIREWALL' && $fw{ZONE}{$item}{IF} eq '' ) {
				$newredirect{DST} = $item;
				$rules .= $this->applyRedirect( %newredirect );
			}
		}
		return $rules;
	}

	# Definisco il SERVICE
	my $service = $redirect{SERVICE};
	my $port = $redirect{PORT};
	my $toport = $redirect{TOPORT};

	my ($src_zone, $src_peer, $src_mac) = $this->expand_item( $src );
	my %src_zone_attr = $this->GetZone( $src_zone );
	my $src_if = $src_zone_attr{IF};

	my $dst_zone;
	my $dst_peer;
	my $dst_if;
	if( $dst eq '*' ) {
		$dst_zone = '*';
		$dst_peer = '0.0.0.0/0';
		$dst_if = '';
	} else {
		($dst_zone, $dst_peer) = $this->expand_item( $dst );
		my %dst_zone_attr = $this->GetZone( $dst_zone );
		$dst_if = $dst_zone_attr{IF};
	}

	print $is_redirect ? '' : 'NOT ',"REDIRECT ( service $service";
	if( $service eq 'tcp' || $service eq 'udp' ) { print "($port)"; }
	print " $src";
	if( $src_mac ne '' ) { print "(mac:$src_mac)"; }
	print " --> $dst )";
	if( $is_redirect ) {
		 print " TO LOCAL PORT $toport";
	}
	print "\n";

	# Creo le 2 catene di andata e ritorno.
	$rules .= $this->applyServiceRedirect( \%services, $service, $src_if, $src_peer, $src_mac, $dst_if, $dst_peer, $port, $toport, $is_redirect);
	
	return $rules;
}

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

sub _applyServiceRedirect {
	my $this = shift;
	my ($ref_calledServices, $ref_services, $serviceName, $src_if, $src_peer, $src_mac, $dst_if, $dst_peer, $port, $toport, $is_redirect) = @_;

	my $rules = '';
	
	my %service = %{$ref_services->{$serviceName}};

	$ref_calledServices->{$serviceName} = 1;

	# ciclo sulle regole di filering
	for( my $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 _applyService
			$rules .= $this->_applyServiceRedirect( $ref_calledServices, $ref_services, $filter{SERVICE},
				$src_if, $src_peer, $src_mac, $dst_if, $dst_peer, $port, $toport, $is_redirect );
			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};

		# I only use the first tcp/udp filter rule
		if( $direction eq 'go' && ($p eq 'tcp' || $p eq 'udp' || $p eq '') &&
		    ($filter{JUMP} eq '' || $filter{JUMP} eq 'ACCEPT') ) {

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

			my $cmd = "-A REDIR ";
			if( $src_if ne '' ) { $cmd .= "-i $src_if "; }
			if( $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 ";
			}

			# iptables prerouting chain don't accept -o option.
			#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 ";
			} else {
				$cmd .= "-p * ";
			}

			#if( $icmptype ne '' ) { $cmd .= "--icmp-type $icmptype "; }
			if( $sport ne '' ) { $cmd .= "--sport $sport "; }
			if( $dport ne '' ) { $cmd .= "--dport $dport "; }
			if( $state ne '' ) { $cmd .= "-m state --state $state "; }

			if( $is_redirect ) {
				if( $toport eq '' ) {
					$cmd .= "-j REDIRECT";
				} else {
					$cmd .= "-j REDIRECT --to-port $toport";
				}
			} else {
				# Don't redirect and return to parent chain
				$cmd .= "-j RETURN";
			}

			if( $p ne '' ) {
				$rules .= "$cmd\n";
			} else {
				# I must explode '-p *' in -p tcp e -p udp
				$cmd =~ s/ \-p \*/ -p tcp/;
				$rules .= "$cmd\n";
				$cmd =~ s/ \-p tcp/ -p udp/;
				$rules .= "$cmd\n";
			}
		}
	}
	return $rules;
}

# Applica una regola di filtro del firewall
sub applyRule {
	my $this = shift;
	my $display = shift;
	my $mangle = shift;
	my %rule = @_;

	if( $rule{ACTIVE} eq 'NO' ) {
		return '';
	}
	
	my %fw = %{$this->{fw}};
	my %fwItems = %{$this->{fwItems}};
	my %services = %{$this->{services}};

	my $rules = '';
	
	my $src = $rule{SRC};
	my $dst = $rule{DST};
	my $target = $rule{TARGET};
	my $service = $rule{SERVICE};
	my $port = $rule{PORT};
	my $mark = $rule{MARK};

	if( $display ) {
		if( $target=~ /DROP|REJECT/ ) {
			print "$target $service";
		} else {
			print "ALLOW $service";
		}
		if( $service eq 'tcp' || $service eq 'udp' ) { print "($port)"; }
		print " $src";
		#if( $src_mac ne '' ) { print "(mac:$src_mac)"; }
		print " --> $dst\n";
	}

	my @srcs = ();
	my @src_list = split( /,/, $src );
	foreach my $s (@src_list) {
		if( $s eq '*' ) {
			# all zones
			foreach my $item ( sort(keys(%{$fw{ZONE}})) ) {
				if( $item ne 'FIREWALL' ) {
					push @srcs, $item;
				}
			}
		} elsif( $fwItems{$s} eq 'GROUP' ) {
			# source is a group
			foreach my $item ( @{$fw{GROUP}{$s}{ITEMS}} ) {
				push @srcs, $item;
			}
		} else {
			push @srcs, $s;
		}
	}
	# sort
	@srcs = sort(@srcs);
	# unique values
	my $prev = '***none***';
	@srcs = grep($_ ne $prev && (($prev) = $_), @srcs);
	if( $#srcs > 0 ) {
		# more then one element
		my %newrule = %rule;
		foreach my $s (@srcs) {
			$newrule{SRC} = $s;
			$rules .= $this->applyRule( 0, $mangle, %newrule );
		}
		return $rules;
	} else {
		$src = shift @srcs;
	}

	my @dsts = ();
	my @dst_list = split( /,/, $dst );
	foreach my $d (@dst_list) {
		if( $d eq '*' ) {
			# all zones
			foreach my $item ( sort(keys(%{$fw{ZONE}})) ) {
				if( $item ne 'FIREWALL' ) {
					push @dsts, $item;
				}
			}
		} elsif( $fwItems{$d} eq 'GROUP' ) {
			# source is a group
			foreach my $item ( @{$fw{GROUP}{$d}{ITEMS}} ) {
				push @dsts, $item;
			}
		} else {
			push @dsts, $d;
		}
	}
	# sort
	@dsts = sort(@dsts);
	# unique values
	my $prev = '***none***';
	@dsts = grep($_ ne $prev && (($prev) = $_), @dsts);
	if( $#dsts > 0 ) {
		# more then one element
		my %newrule = %rule;
		foreach my $d (@dsts) {
			$newrule{DST} = $d;
			$rules .= $this->applyRule( 0, $mangle, %newrule );
		}
		return $rules;
	} else {
		$dst = shift @dsts;
	}

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

	my ($src_zone, $src_peer, $src_mac) = $this->expand_item( $src );
	my ($dst_zone, $dst_peer) = $this->expand_item( $dst );

	if( $src_zone eq 'FIREWALL' && $dst_zone eq 'FIREWALL' ) {
		# ignore chain FIREWALL-FIREWALL
		if( !$mangle ) {
			print "** FIREWALL-->FIREWALL ignored **\n";
		}
		return $rules;
	}

	#command( "" );
	#comment( "# service $service: $src --> $dst  ($src_peer -> $dst_peer) [$src_zone -> $dst_zone]" );

	# Creo le 2 catene di andata e ritorno.
	my $andata = "$src_zone-$dst_zone";
	my $ritorno = "$dst_zone-$src_zone";
	
	if( $mangle ) {
		if( $mark ne '' ) {
			$rules .= $this->applyService( \%services, $service, $andata, $ritorno, $src_peer, $src_mac, $dst_peer, $port, $target, $mark );
		}
	} else {
		$rules .= $this->applyService( \%services, $service, $andata, $ritorno, $src_peer, $src_mac, $dst_peer, $port, $target, '' );
	}
	
	return $rules;
}

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

# Applica un servizio
sub _applyService {
	my $this = shift;
	my( $ref_calledServices, $ref_services, $serviceName, $goChain, $backChain, $src, $src_mac, $dst, $port, $target, $mangle_mark ) = @_;

	my %service = %{$ref_services->{$serviceName}};

	my $rules = '';
	
	$ref_calledServices->{$serviceName} = 1;

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

	# 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 _applyService
			$rules .= $this->_applyService( $ref_calledServices, $ref_services, $filter{SERVICE},
				$goChain, $backChain,$src, $src_mac, $dst, $port, $target, $mangle_mark );
			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( $target =~ /DROP|REJECT/ && $direction ne 'go' ) {
			# Don't process Back filters
			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' ) {
			$cmd = "-A $goChain ";
			if( $src ne '0.0.0.0/0' ) { $cmd .= "-s $src "; }
			# MAC address
			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 --mac-source $src_mac ";
			}
			if( $dst ne '0.0.0.0/0' ) { $cmd .= "-d $dst "; }
		} else {
			$cmd = "-A $backChain ";
			if( $dst ne '0.0.0.0/0' ) { $cmd .= "-s $dst "; }
			if( $src ne '0.0.0.0/0' ) { $cmd .= "-d $src "; }
		}

		if( $p ne '' ) { $cmd .= "-p $p "; }
		if( $icmptype ne '' ) { $cmd .= "--icmp-type $icmptype "; }
		if( $sport ne '' ) { $cmd .= "--sport $sport "; }
		if( $dport ne '' ) { $cmd .= "--dport $dport "; }
		if( $state ne '' ) { $cmd .= "-m state --state $state "; }

		# If target=DROP|REJECT then LOG before block
		if( $target =~ /DROP|REJECT/ ) {
			my $cmdlog = $cmd;
			my $logprefix = "TFW $goChain(".substr($target,0,3).")";
			if( length($logprefix) > 28 ) {
				# iptables need log-prefix strings up to 29 chars length
				$logprefix = substr( $logprefix, 0, 28 );
			}
			$cmdlog .= "-m limit --limit $this->{log_limit}/hour --limit-burst $this->{log_limit_burst} -j LOG --log-prefix \"$logprefix:\"";
			$rules .= "$cmdlog\n";
			$jump = $target;
		}

		# Se e' in andata accetto il passaggio del pacchetto se e' in ritorno lo invio
		# alla catena BACK che si occupa di verificare che sia realmente un pacchetto di
		# una connessione gia' aperta.
		if( $mangle_mark eq '' ) {
			# filter rule
			if( $jump eq '' ) {
				$cmd .= "-j ".( $direction eq 'go' ? 'ACCEPT' : 'BACK' );
			} else {
				$cmd .= "-j $jump";
			}
		} else {
			# mangle rule
			if( $jump eq '' ) {
				if( $direction ne 'go' && $state eq '' ) {
					# BACK
					$cmd .= "-m state --state ESTABLISHED,RELATED ";
				} 
				$cmd .= "-j MARK --set-mark $mangle_mark";
			} else {
				if( $jump eq 'ICMP-ACC' ) {
					# ICMP-ACC
					my $prot = $p eq 'icmp' ? '' : '-p icmp'; 
					$cmd = "$cmd $prot --icmp-type destination-unreachable -j MARK --set-mark $mangle_mark\n".
						"$cmd $prot --icmp-type source-quench -j MARK --set-mark $mangle_mark\n".
						"$cmd $prot --icmp-type time-exceeded -j MARK --set-mark $mangle_mark\n".
						"$cmd $prot --icmp-type parameter-problem -j MARK --set-mark $mangle_mark";
				} else {
					$cmd .= "-j MARK --set-mark $mangle_mark";
				}
			}
		}
		
		#print "\n$cmd\n";

		$rules .= "$cmd\n";
	}
	return $rules;
}

# dato il nome dell'item ritorna la zona e l'ip + netmask
sub expand_item {
	my $this = shift;
	my $item = shift;
	
	my %fw = %{$this->{fw}};
	my %fwItems = %{$this->{fwItems}};
	my $itemType = $fwItems{$item};

	my $zone = '';
	my $ip = '';
	my $mac = '';

	if( $itemType eq 'ZONE' ) {
		$zone = $item;
		$ip = '0.0.0.0/0';
	}
	if( $itemType eq 'NET' ) {
		$zone = $fw{NET}{$item}{ZONE};
		$ip = $fw{NET}{$item}{IP}.'/'.$fw{NET}{$item}{NETMASK};
	}
	if( $itemType eq 'HOST' ) {
		$zone = $fw{HOST}{$item}{ZONE};
		$ip = $fw{HOST}{$item}{IP}.'/32';
		$mac = $fw{HOST}{$item}{MAC};
	}
	return ($zone, $ip, $mac);
}

sub command {
	my $this = shift;
	my $cmd = shift;

	my $out = qx{$cmd 2>&1};
	if( $out ne '' ) {
		print "$cmd\n$out";
	}
}

sub iptables_restore_emu {
	my $this = shift;
	my $rules = shift;
	
	my $table = '';
	my @lines = split(/\n/, $rules);
	foreach my $line (@lines) {
		$line =~ s/\#(.*)$//;
		if( !$line || $line eq 'COMMIT' ) {
			next;
		}
		if( $line =~ /^\*(.*?)$/ ) {
			$table = $1 eq 'filter' ? '' : $1;
			next;
		}
		my $cmd = '';
		my $chain = '';
		my $policy = '';
		if( $line =~ /^\:(.*?) (.*?) (.*?)$/ ) {
			$chain = $1;
			$policy = $2;
			if( $chain =~ /^(INPUT|OUTPUT|FORWARD)$/ ) {
				next;
			}
			$cmd = "-N $chain". ($policy ne '-' ? " -P $policy" : ''); 
		} else {
			$cmd = $line;
		}
		if( $table ) { $cmd = "-t $table $cmd"; }
		
		$this->command("iptables $cmd");
	}
}

1;