1 package Guardian
::IPtables
;
5 use Exporter
qw(import);
7 our @EXPORT = qw(DoBlock DoUnblock DoFlush);
9 # Array of supported block actions.
10 my @supported_actions = ("DROP", "REJECT");
12 # Path where the IPtables related binaries are stored.
13 my $bindir = "/usr/sbin/";
15 # Hash which contains the path to the IPtables binaries,
16 # based on the used IP protocol version. IPtables is
17 # designed to use different binaries for IPv4 and IPv6.
23 # The used firewall chain.
24 my $chain = "GUARDIAN";
27 ## The DoBlock subroutine.
29 ## This subroutine is called, when a given address should be locked by
32 ## Guardian is using the "append" option from IPtables, which will add the new rule
33 ## to the end of the chain to prevent from possible race-conditions when adding/deleting
34 ## rules at the same time.
37 my ($address, $action) = @_;
39 # If no action has been given, default to "DROP".
44 # Check if the given action is supported.
45 unless(&_check_action
($action)) {
46 # Abort and return an error message.
47 return "Unsupported action: $action";
50 # Obtain which binary should be executed.
51 my $iptables = &_omit_binary
($address);
53 # Abort if no suitable binary could be obtained.
55 return "No suitable binary found.";
58 # Call IPtables binary to block the given address.
59 system("$iptables --wait -A $chain -s $address -j $action");
63 ## The DoUnblock subroutine.
65 ## This subroutine can be used to delete all firewall rules (unblock)
66 ## of a previously blocked address.
68 ## To do this a subroutine will be called, which is collecting all rule
69 ## positions in the firewall chain for the given address, which returns
70 ## them in reversed order. This list of rules will be deleted one-by-one
71 ## so multiple entries (if present) for the address will be deleted.
73 ## This approach also eliminates the exact rule argument processing again
74 ## for dropping it. So it is not neccessary to know the additional arguments
75 ## like firewall action (DROP, REJECT) etc.
80 # Obtain which binary should be executed.
81 my $iptables = &_omit_binary
($address);
83 # Abort if no suitable binary could be obtained.
85 return "No suitable binary found.";
88 # Get rulepositions for the specified address.
89 my @rules = &_get_rules_positions_by_address
($address, $iptables);
91 # Loop through the rules array and drop the firewall rules.
92 foreach my $rule (@rules) {
93 # Call iptables to delete the rule.
94 system("$iptables --wait -D $chain $rule");
99 ## The DoFlush subroutine.
101 ## Call this subroutine to entirely flush the IPtables chains for each
102 ## supported protocol version.
105 # Loop through the binaries hash to flush
106 foreach my $key (keys %binaries) {
107 # Grab binary from hash and generate the absolute path
109 my $iptables = join ("/", $bindir,$binaries{$key});
111 # Execute the binary if avail- and executeable.
113 system("$iptables --wait -F $chain");
119 ## Get rules subroutine.
121 ## This subroutine is used to get the rule position of the active
122 ## firewall rules for a given address. Those position will be collected
123 ## and returned in reversed order.
125 sub _get_rules_positions_by_address
($$) {
126 my ($address, $iptables) = @_;
128 # Array to store the rule positions.
131 # Call iptables and list all firewall rules.
132 open(RULES
, "$iptables --wait -L $chain -n -v --line-numbers |");
134 # Read input line by line.
135 foreach my $line (<RULES
>) {
136 # Skip descriptive line.
137 next if ($line =~ /^Chain/);
138 next if ($line =~ /^ pkts/);
140 # Generate array, based on the line content
141 # (seperator is a single or multiple space's)
142 my @comps = split(/\s{1,}/, $line);
143 my ($pos, $pkts, $bytes, $target, $prot, $opt, $in, $out, $source, $destination) = @comps;
145 # Compare the current source address with the given one.
146 # If they are equal, the rule position will be added to the
148 if ($address eq $source) {
154 my @reversed_rules = reverse @rules;
156 # Return the reversed array.
157 return @reversed_rules;
161 ## The _check_action function.
163 ## This private function is used to check if the given action is supported by
164 ## the firewall engine.
166 sub _check_action
($) {
169 # Check if the recieved action is part of the supported_actions array.
170 foreach my $item (@supported_actions) {
171 # Exit the loop and return "nothing" if we found a match.
172 if($item eq $action) {
178 # If we got here, the given action is not part of the array of supported
179 # actions. Return nothing (False).
184 ## The _omit_binary function.
186 ## This private function is responsible for selecting and returning the correct
187 ## IPtables binary, based on which kind of IP address has been given.
189 sub _omit_binary
($) {
192 # Obtain used protocol version, based on the
194 my $proto_version = &Guardian
::Base
::DetectIPProtocolVersion
($address);
196 # Abort if the protocol version could not proper be detected.
197 unless ($proto_version) {
198 # Return nothing (False).
202 # Obtain which binary is responsible, based on the detected protocol version and
203 # generate the full path to it.
204 my $binary = join("/",$bindir,$binaries{$proto_version});
206 # Abort if the obtained binary is not avail- or executeable.
207 unless (-x
$binary) {
208 # Return nothing (False).
212 # Return the detected and validated binary.