summaryrefslogtreecommitdiffstats
path: root/perl-install/tinyfirewall.pm
blob: 9646662de8243c06b120b0bf4a1429fc3aecf405 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
package tinyfirewall;
use diagnostics;
use strict;
use run_program;
use network::netconnect;
use network;
use POSIX qw(tmpnam);
use MDK::Common;
my @messages = (_("tinyfirewall configurator

This configures a personal firewall for this Mandrake Linux machine.
For a powerful dedicated firewall solution, please look to the
specialized MandrakeSecurity Firewall distribution."),
_("We'll now ask you questions about which services you'd like to allow
the Internet to connect to.  Please think carefully about these
questions, as your computer's security is important.

Please, if you're not currently using one of these services, firewall
it off.  You can change this configuration anytime you like by
re-running this application!"),
_("Are you running a web server on this machine that you need the whole
Internet to see? If you are running a webserver that only needs to be
accessed by this machine, you can safely answer NO here.

"),
_("Are you running a name server on this machine? If you didn't set one
up to give away IP and zone information to the whole Internet, please
answer no.

"),
_("Do you want to allow incoming Secure Shell (ssh) connections? This
is a telnet-replacement that you might use to login. If you're using
telnet now, you should definitely switch to ssh. telnet is not
encrypted -- so some attackers can steal your password if you use
it. ssh is encrypted and doesn't allow for this eavesdropping."),
_("Do you want to allow incoming telnet connections?
This is horribly unsafe, as we explained in the previous screen. We
strongly recommend answering No here and using ssh in place of
telnet.
"),
_("Are you running an FTP server here that you need accessible to the
Internet? If you are, we strongly recommend that you only use it for
Anonymous transfers. Any passwords sent by FTP can be stolen by some
attackers, since FTP also uses no encryption for transferring passwords.
"),
_("Are you running a mail server here? If you're sending you 
messages through pine, mutt or any other text-based mail client,
you probably are.  Otherwise, you should firewall this off.

"),
_("Are you running a POP or IMAP server here? This would
be used to host non-web-based mail accounts for people via 
this machine.

"),
_("You appear to be running a 2.2 kernel.  If your network IP
is automatically set by a computer in your home or office 
(dynamically assigned), we need to allow for this.  Is
this the case?
"),
_("Is your computer getting time syncronized to another computer?
Mostly, this is used by medium-large Unix/Linux organizations
to synchronize time for logging and such.  If you're not part
of a larger office and haven't heard of this, you probably 
aren't."),
_("Configuration complete.  May we write these changes to disk?



")
);
my %settings;
my $config_file = "/etc/Bastille/bastille-firewall.cfg";
my $default_config_file = "/usr/share/Bastille/bastille-firewall.cfg"; # set this later
sub ReadConfig {
    -e $config_file or cp_af($default_config_file, $config_file);
    add2hash(\%settings, { getVarsFromSh("$config_file") });
}
sub SaveConfig {
	my $tmp_file = tmpnam();
	open CONFIGFILE, "$config_file"
		or die _("Can't open %s: %s\n", $config_file, $!);
	open TMPFILE, ">$tmp_file"
		or die _("Can't open %s for writing: %s\n", $tmp_file, $!);
	while (my $line = <CONFIGFILE>)
	{
		if ($line =~ m/^(.+)\s*\=\s*"(.*)"/)
		{
			my ($variable, $value) = ($1, $2);
			my $newvalue = $settings{$variable};
			$line =~ s/".*"/"$newvalue"/
				if (exists $settings{$variable});
		}
		print TMPFILE $line;
	}
	close CONFIGFILE;
	close TMPFILE;
	rename ($config_file, $config_file . ".orig");
	system ("/bin/cp $tmp_file $config_file");
	system ("/bin/rm $tmp_file");
}
sub DoInterface {
    my ($in)=@_;
    $::isWizard=1;
    my $GetNetworkInfo = sub {
	$settings{DNS_SERVERS} = join(' ', uniq(split(' ', $settings{DNS_SERVERS}),
            @{network::read_resolv_conf("/etc/resolv.conf")}{'dnsServer', 'dnsServer2', 'dnsServer3'}));
	my (undef, undef, @netstat) = `/bin/netstat -in`;
	my @interfaces =  map { /(\S+)/ } @netstat;
	my (@route, undef, undef) = `/sbin/route -n`;
	my $defaultgw;
	my $iface;
	foreach (@route) { my @parts = split /\s+/; $parts[0] eq "0.0.0.0" and $defaultgw = $parts[1], $iface = $parts[7] }
	my $fulliface = $iface;
	$fulliface =~ s/[0-9]+/\\\+/;
	$settings{PUBLIC_INTERFACES} = join(' ', uniq(split(' ', $settings{PUBLIC_INTERFACES}), $iface));
	$settings{PUBLIC_INTERFACES} =~ $fulliface and $settings{PUBLIC_INTERFACES} =~ s/$iface *//;
	$settings{INTERNAL_IFACES} = join(' ', uniq(split(' ', $settings{INTERNAL_IFACES}),
            map { my $i=$_; my $f=$i; $f=~s/[0-9]+/\\\+/;
		  if_(and_( map {$settings{$_} !~ /$i/ and $settings{$_} !~ /$f/ } ('TRUSTED_IFACES', 'PUBLIC_IFACES', 'INTERNAL_IFACES')), $i)
	    } @interfaces ));
    };
#    my $popimap = sub {	$_[0] or return; $settings{FORCE_PASV_FTP} = 11;  mapn {$settings{"$_[0]"} = "$_[1]"; }
#[ qw(FORCE_PASV_FTP TCP_BLOCKED_SERVICES UDP_BLOCKED_SERVICES ICMP_ALLOWED_TYPES ENABLE_SRC_ADDR_VERIFY IP_MASQ_NETWORK IP_MASQ_MODULES REJECT_METHOD) ] ,
#[ "N", "6000:6020", "2049", "destination-unreachable echo-reply time-exceeded" , "Y", "", "", "DENY" ]; };
    my $popimap = sub {
	$_[0] or return;
	$settings{'FORCE_PASV_FTP'} = "N";
	$settings{TCP_BLOCKED_SERVICES}= "6000:6020";
	$settings{UDP_BLOCKED_SERVICES}= "2049";
	$settings{ICMP_ALLOWED_TYPES}= "destination-unreachable echo-reply time-exceeded";
	$settings{ENABLE_SRC_ADDR_VEIFY}= "Y";
	$settings{IP_MASQ_NETWORK}= "";
	$settings{IP_MASQ_MODULES}= "";
	$settings{REJECT_METHOD}= "DENY";
    };
    #    my $ntp = sub { $_[0] or return; mapn { $settings{$_[0]} = $_[1] } ['ICMP_OUTBOUND_DISABLED_TYPES}', 'LOG_FAILURES'], [ "", "N"] };
    my $ntp = sub { $_[0] or return;
		    $settings{'ICMP_OUTBOUND_DISABLED_TYPES}'} = "";
		    $settings{'LOG_FAILURES'} = "N";
		};
    my $dhcp = sub { if ($_[0]) {
	$settings{DHCP_IFACES} and return;
	my (undef, undef, @netstat) = `/bin/netstat -in`;
	$settings{DHCP_IFACES} = join(' ', split(' ', $settings{DHCP_IFACES}), map { /(\S+)/ } @netstat );
    } else { $settings{DHCP_IFACES} = "" } };
    my $quit = sub {
	$_[0] or $in->exit(0);
	SaveConfig();
	system($_) foreach ("/bin/cp /usr/share/Bastille/bastille-ipchains /usr/share/Bastille/bastille-netfilter /sbin",
			    "/bin/cp /usr/share/Bastille/bastille-firewall /etc/rc.d/init.d/",
			    "/bin/chmod 0700 /etc/rc.d/init.d/bastille-firewall", "/bin/chmod 0700 /sbin/bastille-ipchains",
			    "/bin/chmod 0700 /sbin/bastille-netfilter", "/sbin/chkconfig bastille-firewall on",
			    "/etc/rc.d/init.d/bastille-firewall stop", "/etc/rc.d/init.d/bastille-firewall start");
	$in->exit(0);
	return;
	$_[0] or $in->exit(0);
	cp_af($config_file, $config_file . ".orig");
	substInFile {
	    if(/^(.+)\s*\=/) {
		$a=$settings{$1};
		s/".*"/"$a"/;
	    }
	} $config_file;
	system($_) foreach ("/bin/cp /usr/share/Bastille/bastille-ipchains /usr/share/Bastille/bastille-netfilter /sbin",
			    "/bin/cp /usr/share/Bastille/bastille-firewall /etc/rc.d/init.d/",
			    "/bin/chmod 0700 /etc/rc.d/init.d/bastille-firewall", "/bin/chmod 0700 /sbin/bastille-ipchains",
			    "/bin/chmod 0700 /sbin/bastille-netfilter", "/sbin/chkconfig bastille-firewall on",
			    "/etc/rc.d/init.d/bastille-firewall stop", "/etc/rc.d/init.d/bastille-firewall start"); };
    my @struct = (
		  [$GetNetworkInfo],
		  [],
		  [undef , undef, undef, undef, ["tcp", "80"], ["tcp", "443"]],
		  [undef , undef, undef, undef, ["tcp", "53"], ["udp", "53"]],
		  [undef , undef, undef, undef, ["tcp", "22"]],
		  [undef , undef, undef, undef, ["tcp", "23"]],
		  [undef , undef, undef, undef, ["tcp", "20"],["tcp", "21"]],
		  [undef , undef, undef, undef, ["tcp", "25"]],
		  [undef , undef, undef, $popimap, ["tcp", "109"], ["tcp", "110"], ["tcp", "143"]],
		  [undef , _("No I don't need DHCP"), _("Yes I need DHCP"), $dhcp],
		  [undef , _("No I don't need NTP"), _("Yes I need NTP"), $ntp ],
		  [undef , _("Don't Save"), _("Save & Quit"), $quit ]
		 );
    if (!Kernel22()) { 
	pop @struct; pop @struct; pop @struct;
	@struct = ( @struct, [undef , _("Don't Save"), _("Save & Quit"), $quit ] );
	$messages[9]=$messages[11];
    }
    for (my $i=0;$i<@struct;$i++) {
	$::Wizard_no_previous = $i == 0;
	$::Wizard_finished = $i == $#struct;
	my $l = $struct[$i];
	@$l or goto ask;
	if (@$l == 1) {
	    ($l->[0])->();
	  ask:
	    $in->ask_okcancel(_("Firewall Configuration Wizard"), $messages[$i],1) ? next : goto prev;
	}
	my $no = $l->[1] ? $l->[1] : _("No (firewall this off from the internet)");
	my $yes = $l->[2] ? $l->[2] : _("Yes (allow this through the firewall)");
	if (my $e = $in->ask_from_list_(_("Firewall Configuration Wizard"),
				       $messages[$i],
				       [ $yes, $no ], or_( map { $_ && CheckService($_->[0], $_->[1]) } (@$l[4..6])) ? $yes : $no
				      )) {
	    map { $_ and Service($e=~/Yes/, $_->[0], $_->[1]) } (@{$struct[$i]}[4..6]);
	    $struct[$i][3] and $struct[$i][3]->($e=~/Yes/ || $e eq _("Save & Quit"));
	} else {
	  prev:
	    $i = $i-2 >= -1 ? $i-2 : -1;
	}
    }
}
sub unbox_service {
    split ' ', $settings{uc($_[0]) . "_PUBLIC_SERVICES"}
}
sub Service {
    my ($add, $protocol, $port) = @_;
    my @l = unbox_service($protocol);
    @l = uniq($add ? (@l, $port) : grep { $_ ne $port } @l);
    $settings{uc($protocol) . "_PUBLIC_SERVICES"} = join(' ', @l);
}
sub CheckService { member($_[1], unbox_service($_[0])); }
sub Kernel22 {
    my ($major, $minor, $patchlevel) = (cat_("/proc/version"))[0] =~ m/^Linux version ([0-9]+)\.([0-9]+)\.([0-9]+)/;
    $major eq "2" && $minor eq "2";
}
sub main {
    my ($in)=@_;
    my $dialog = new Gtk::Dialog();
    $dialog->set_position(1);
    $dialog->vbox->set_border_width(10);
    my $label = new Gtk::Label(_("Please Wait... Verifying installed packages"));
    $dialog->signal_connect ( delete_event => sub { Gtk->main_quit(); });
    $dialog->vbox->pack_start($label,1,1,20);
    $dialog->show_all;
    Gtk->main_iteration while Gtk->events_pending;
    if (!$in->do_pkgs->install(Kernel22() ? "ipchains" : "iptables", "Bastille")) {
	$in->ask_warn('', _("Failure installing the needed packages : %s and Bastille.
 Try to install them manually.", Kernel22() ? "ipchains" : "iptables") );
	$dialog->destroy;
	$in->exit(0);
    }
    ReadConfig;
    DoInterface($in);
}
t;[$SIZE_DEPS] =~ /^\d*\s*(.*)/)[0] } sub packageFlagSelected { $_[0]->[$FLAGS] & $PKGS_SELECTED } sub packageFlagForce { $_[0]->[$FLAGS] & $PKGS_FORCE } sub packageFlagInstalled { $_[0]->[$FLAGS] & $PKGS_INSTALLED } sub packageFlagBase { $_[0]->[$FLAGS] & $PKGS_BASE } sub packageFlagUpgrade { $_[0]->[$FLAGS] & $PKGS_UPGRADE } sub packageSetFlagSelected { $_[0]->[$FLAGS] &= ~$PKGS_SELECTED; $_[0]->[$FLAGS] |= $_[1] & $PKGS_SELECTED; } sub packageSetFlagForce { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_FORCE) : ($_[0]->[$FLAGS] &= ~$PKGS_FORCE); } sub packageSetFlagInstalled { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_INSTALLED) : ($_[0]->[$FLAGS] &= ~$PKGS_INSTALLED); } sub packageSetFlagBase { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_BASE) : ($_[0]->[$FLAGS] &= ~$PKGS_BASE); } sub packageSetFlagUpgrade { $_[1] ? ($_[0]->[$FLAGS] |= $PKGS_UPGRADE) : ($_[0]->[$FLAGS] &= ~$PKGS_UPGRADE); } sub packageMedium { $_[0]->[$MEDIUM] } sub packageProvides { map { $_[0]->{depslist}[$_] || die "unkown package id $_" } unpack "s*", $_[1]->[$PROVIDES] } sub packageRate { substr($_[0]->[$VALUES], 0, 1) } sub packageHeader { $_[0]->[$HEADER] } sub packageFreeHeader { c::headerFree(delete $_[0]->[$HEADER]) } sub packageFile { $_[0]->[$HEADER] or die "packageFile: missing header"; $_[0]->[$FILE] =~ /([^\(]*)(?:\([^\)]*\))?(-[^-]+-[^-]+)/; "$1$2." . c::headerGetEntry($_[0]->[$HEADER], 'arch') . ".rpm"; } sub packageSelectedOrInstalled { packageFlagSelected($_[0]) || packageFlagInstalled($_[0]) } sub packageId { my ($packages, $pkg) = @_; my $i = 0; foreach (@{$packages->{depslist}}) { return $i if $pkg == $packages->{depslist}[$i]; $i++ } return; } sub cleanHeaders { my ($prefix) = @_; commands::rm("-rf", "$prefix/tmp/headers") if -e "$prefix/tmp/headers"; } #- get all headers from an hdlist file. sub extractHeaders($$$) { my ($prefix, $pkgs, $medium) = @_; cleanHeaders($prefix); run_program::run("packdrake", "-x", "/tmp/$medium->{hdlist}", "$prefix/tmp/headers", map { packageHeaderFile($_) } @$pkgs); foreach (@$pkgs) { my $f = "$prefix/tmp/headers/". packageHeaderFile($_); local *H; open H, $f or log::l("unable to open header file $f: $!"), next; $_->[$HEADER] = c::headerRead(fileno H, 1) or log::l("unable to read header of package ". packageHeaderFile($_)); } @$pkgs = grep { $_->[$HEADER] } @$pkgs; } #- size and correction size functions for packages. #- invCorrectSize corrects size in the range 0 to 3Gb approximately, so #- it should not be used outside these levels. #- but since it is an inverted parabolic curve starting above 0, we can #- get a solution where X=Y at approximately 9.3Gb. we use this point as #- a limit to change the approximation to use a linear one. #- for information above this point, we have the corrected size below the #- original size wich is absurd, this point is named D below. my $A = -121568/100000000000; # -1.21568e-05; #- because perl does like that on some language (TO BE FIXED QUICKLY) my $B = 121561/100000; # 1.21561 my $C = -239889/10000; # -23.9889 #- doesn't take hdlist's into account as getAvailableSpace will do it. my $D = (-sqrt(sqr($B - 1) - 4 * $A * $C) - ($B - 1)) / 2 / $A; #- $A is negative so a positive solution is with - sqrt ... sub correctSize { my $csz = ($A * $_[0] + $B) * $_[0] + $C; $csz > $_[0] ? $csz : $_[0]; #- size correction (in MB) should be above input argument (as $A is negative). } sub invCorrectSize { my $sz = $_[0] < $D ? (sqrt(sqr($B) + 4 * $A * ($_[0] - $C)) - $B) / 2 / $A : $_[0]; $sz < $_[0] ? $sz : $_[0]; } sub selectedSize { my ($packages) = @_; my $size = 0; foreach (values %{$packages->{names}}) { packageFlagSelected($_) && !packageFlagInstalled($_) and $size += packageSize($_) - ($_->[$INSTALLED_CUMUL_SIZE] || 0); } $size; } sub correctedSelectedSize { correctSize(selectedSize($_[0]) / sqr(1024)) } #- searching and grouping methods. #- package is a reference to list that contains #- a hash to search by name and #- a list to search by id. sub packageByName { my ($packages, $name) = @_; $packages->{names}{$name} or log::l("unknown package `$name'") && undef; } sub packageById { my ($packages, $id) = @_; $packages->{depslist}[$id] or log::l("unknown package id $id") && undef; } sub packagesOfMedium { my ($packages, $mediumName) = @_; my $medium = $packages->{mediums}{$mediumName}; grep { $_->[$MEDIUM] == $medium } @{$packages->{depslist}}; } sub packagesToInstall { my ($packages) = @_; grep { $_->[$MEDIUM]{selected} && packageFlagSelected($_) && !packageFlagInstalled($_) } values %{$packages->{names}}; } sub allMediums { my ($packages) = @_; keys %{$packages->{mediums}}; } sub mediumDescr { my ($packages, $medium) = @_; $packages->{mediums}{$medium}{descr}; } #- selection, unselection of package. sub selectPackage { #($$;$$$) my ($packages, $pkg, $base, $otherOnly, $check_recursion) = @_; #- check if the same or better version is installed, #- do not select in such case. packageFlagInstalled($pkg) and return; #- check for medium selection, if the medium has not been #- selected, the package cannot be selected. $pkg->[$MEDIUM]{selected} or return; #- avoid infinite recursion (mainly against badly generated depslist.ordered). $check_recursion ||= {}; exists $check_recursion->{$pkg->[$FILE]} and return; $check_recursion->{$pkg->[$FILE]} = undef; #- make sure base package are set even if already selected. $base and packageSetFlagBase($pkg, 1); #- select package and dependancies, otherOnly may be a reference #- to a hash to indicate package that will strictly be selected #- when value is true, may be selected when value is false (this #- is only used for unselection, not selection) unless (packageFlagSelected($pkg)) { foreach (packageDepsId($pkg)) { my $preferred; if (/\|/) { #- choice deps should be reselected recursively as no #- closure on them is computed, this code is exactly the #- same as pixel's one. my %preferred; @preferred{@preferred} = (); foreach (split '\|') { my $dep = packageById($packages, $_) or next; $preferred ||= $dep; packageFlagSelected($dep) and $preferred = $dep, last; exists $preferred{packageName($dep)} and $preferred = $dep; } selectPackage($packages, $preferred, $base, $otherOnly, $check_recursion) if $preferred; } else { #- deps have been closed except for choices, so no need to #- recursively apply selection, expand base on it. my $dep = packageById($packages, $_); $base and packageSetFlagBase($dep, 1); $otherOnly and !packageFlagSelected($dep) and $otherOnly->{packageName($dep)} = 1; $otherOnly or packageSetFlagSelected($dep, 1+packageFlagSelected($dep)); } } } $otherOnly and !packageFlagSelected($pkg) and $otherOnly->{packageName($pkg)} = 1; $otherOnly or packageSetFlagSelected($pkg, 1+packageFlagSelected($pkg)); 1; } sub unselectPackage($$;$) { my ($packages, $pkg, $otherOnly) = @_; #- base package are not unselectable, #- and already unselected package are no more unselectable. packageFlagBase($pkg) and return; packageFlagSelected($pkg) or return; #- dependancies may be used to propose package that may be not #- usefull for the user, since their counter is just one and #- they are not used any more by other packages. #- provides are closed and are taken into account to get possible #- unselection of package (value false on otherOnly) or strict #- unselection (value true on otherOnly). foreach my $provided ($pkg, packageProvides($packages, $pkg)) { packageFlagBase($provided) and die "a provided package cannot be a base package"; if (packageFlagSelected($provided)) { my $unselect_alone = 0; foreach (packageDepsId($provided)) { if (/\|/) { #- this package use a choice of other package, so we have to check #- if our package is not included in the choice, if this is the #- case, if must be checked one of the other package are selected. foreach (split '\|') { my $dep = packageById($packages, $_); $dep == $pkg and $unselect_alone |= 1; packageFlagBase($dep) || packageFlagSelected($dep) and $unselect_alone |= 2; } } } #- provided will not be unselect here if the two conditions are met. $unselect_alone == 3 and next; #- on the other hand, provided package have to be unselected. $otherOnly or packageSetFlagSelected($provided, 0); $otherOnly and $otherOnly->{packageName($provided)} = 1; }