summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
authordamien <damien@mandriva.com>2001-10-30 20:11:31 +0000
committerdamien <damien@mandriva.com>2001-10-30 20:11:31 +0000
commit22d58ed5438fde649c05c3397e577c98e9b8e0c5 (patch)
tree36ebf3e101943920fdeb1541c17f99b818893630 /perl-install
parent72cdfb169816a60385535eceb9f40292e7e383e7 (diff)
downloaddrakx-backup-do-not-use-22d58ed5438fde649c05c3397e577c98e9b8e0c5.tar
drakx-backup-do-not-use-22d58ed5438fde649c05c3397e577c98e9b8e0c5.tar.gz
drakx-backup-do-not-use-22d58ed5438fde649c05c3397e577c98e9b8e0c5.tar.bz2
drakx-backup-do-not-use-22d58ed5438fde649c05c3397e577c98e9b8e0c5.tar.xz
drakx-backup-do-not-use-22d58ed5438fde649c05c3397e577c98e9b8e0c5.zip
corrected ref($in) =~ /gtk/
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/my_gtk.pm2
-rwxr-xr-xperl-install/standalone/drakautoinst5
-rwxr-xr-xperl-install/standalone/drakproxy5
-rwxr-xr-xperl-install/standalone/mousedrake4
-rwxr-xr-xperl-install/standalone/tinyfirewall2
5 files changed, 12 insertions, 6 deletions
diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm
index f845d1de6..acdbe9977 100644
--- a/perl-install/my_gtk.pm
+++ b/perl-install/my_gtk.pm
@@ -94,7 +94,7 @@ sub new {
$::WizardWindow->show_all;
flush();
}
- $::WizardTable->attach($o->{window}, 1, 2, 1, 2, {'fill', 'expand'}, {'fill', 'expand'}, 0, 0);
+ $::WizardTable->attach($o->{window}, 1, 2, 1, 2, [-fill, -expand], [-fill, -expand], 0, 0);
}
$::isEmbedded && !$my_gtk::pop_it or return $o;
diff --git a/perl-install/standalone/drakautoinst b/perl-install/standalone/drakautoinst
index e77ad99d3..985f91492 100755
--- a/perl-install/standalone/drakautoinst
+++ b/perl-install/standalone/drakautoinst
@@ -88,7 +88,7 @@ my $cfgfile = "$mountdir/auto_inst.cfg";
eval(cat_($cfgfile));
my $o_old = $o;
-if (ref($in) =~ /gtk/) {
+if (!$::isEmbedded && $in->isa('interactive_gtk')) {
require Gtk;
init Gtk;
require my_gtk;
@@ -359,6 +359,9 @@ sub control_buttons {
#-------------------------------------------------
#- $Log$
+#- Revision 1.13 2001/10/30 20:11:31 damien
+#- corrected ref($in) =~ /gtk/
+#-
#- Revision 1.12 2001/10/30 17:00:05 damien
#- updated
#-
diff --git a/perl-install/standalone/drakproxy b/perl-install/standalone/drakproxy
index 426d73b9c..acfc159ba 100755
--- a/perl-install/standalone/drakproxy
+++ b/perl-install/standalone/drakproxy
@@ -34,7 +34,7 @@ $::Wizard_title = _("Proxy handling");
my $in = 'interactive'->vnew('su', 'default');
-if ($::isWizard || ($::isEmbedded && ref($in) =~ /gtk/)) {
+if ($::isWizard || ($::isEmbedded && $in->isa('interactive_gtk'))) {
proxy::main('', $in);
$in->exit(0);
}
@@ -67,6 +67,9 @@ Gtk->exit(0);
#-------------------------------------------------
#- $Log$
+#- Revision 1.8 2001/10/30 20:11:31 damien
+#- corrected ref($in) =~ /gtk/
+#-
#- Revision 1.7 2001/08/09 09:35:37 gc
#- use vnew the right way everywhere
#-
diff --git a/perl-install/standalone/mousedrake b/perl-install/standalone/mousedrake
index 177f7489a..f3609b936 100755
--- a/perl-install/standalone/mousedrake
+++ b/perl-install/standalone/mousedrake
@@ -37,7 +37,7 @@ $mouse->{XMOUSETYPE} eq $curr_env->{mouse}{XMOUSETYPE} ||
$::isEmbedded and kill USR2, $::CCPID;
if (!$mouse || !$::auto) {
$mouse ||= mouse::fullname2mouse("serial|Generic 2 Button Mouse");
- if ($::isEmbedded && ref($in) =~ /gtk/) {
+ if ($::isEmbedded && $in->isa('interactive_gtk')) {
require my_gtk;
my $time_tag = Gtk->timeout_add(100, sub {
defined $::Plug && defined $::Plug->child or return 1;
@@ -49,7 +49,7 @@ if (!$mouse || !$::auto) {
sub { join '|', map { translate($_) } split '\|', $_[0] },
[ mouse::fullnames ],
$mouse->{type} . '|' . $mouse->{name});
- Gtk->timeout_remove($time_tag2) if $::isEmbedded && ref($in) =~ /gtk/;
+ Gtk->timeout_remove($time_tag2) if $::isEmbedded && $in->isa('interactive_gtk');
$name or $::isEmbedded ? do { kill(USR1, $::CCPID); goto begin } : $in->exit(0);
my $mouse_chosen = mouse::fullname2mouse($name);
$mouse->{type} eq $mouse_chosen->{type} && $mouse->{name} eq $mouse_chosen->{name} or $mouse = $mouse_chosen;
diff --git a/perl-install/standalone/tinyfirewall b/perl-install/standalone/tinyfirewall
index 86f59e5cb..df01e76e9 100755
--- a/perl-install/standalone/tinyfirewall
+++ b/perl-install/standalone/tinyfirewall
@@ -32,7 +32,7 @@ local $_ = join '', @ARGV;
my $in = 'interactive'->vnew('su', 'default');
-$::isEmbedded && ref($in) =~ /gtk/ or goto dd;
+$::isEmbedded && $in->isa('interactive_gtk') or goto dd;
require Gtk;
init Gtk;
392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435
package network; # $Id$

use diagnostics;
use strict;

#-######################################################################################
#- misc imports
#-######################################################################################
use Socket;

use common qw(:common :file :system :functional);
use detect_devices;
use run_program;
use any;
use log;

#-######################################################################################
#- Functions
#-######################################################################################
sub read_conf {
    my ($file) = @_;
    my %netc = getVarsFromSh($file);
    $netc{dnsServer} = delete $netc{NS0};
    $netc{dnsServer2} = delete $netc{NS1};
    $netc{dnsServer3} = delete $netc{NS2};
    \%netc;
}

sub read_resolv_conf {
    my ($file) = @_;
    my @l = qw(dnsServer dnsServer2 dnsServer3);
    my %netc;

    local *F; open F, $file or die "cannot open $file: $!";
    local $_;
    while (<F>) {
	/^\s*nameserver\s+(\S+)/ and $netc{shift @l} = $1;
    }
    \%netc;
}

sub read_interface_conf {
    my ($file) = @_;
    my %intf = getVarsFromSh($file) or die "cannot open file $file: $!";

    $intf{BOOTPROTO} ||= 'static';
    $intf{isPtp} = $intf{NETWORK} eq '255.255.255.255';
    $intf{isUp} = 1;
    \%intf;
}

sub up_it {
    my ($prefix, $intfs) = @_;
    $_->{isUp} and return foreach values %$intfs;
    my $f = "/etc/resolv.conf"; symlink "$prefix/$f", $f;
    run_program::rooted($prefix, "/etc/rc.d/init.d/network", "start");
    $_->{isUp} = 1 foreach values %$intfs;
}
sub down_it {
    my ($prefix, $intfs) = @_;
    run_program::rooted($prefix, "/etc/rc.d/init.d/network", "stop");
    $_->{isUp} = 1 foreach values %$intfs;
}

sub write_conf {
    my ($file, $netc) = @_;

    add2hash($netc, {
		     NETWORKING => "yes",
		     FORWARD_IPV4 => "false",
		     HOSTNAME => "localhost.localdomain",
		    });
    add2hash($netc, { DOMAINNAME => $netc->{HOSTNAME} =~ /\.(.*)/ });

    setVarsInSh($file, $netc, qw(NETWORKING FORWARD_IPV4 DHCP_HOSTNAME HOSTNAME DOMAINNAME GATEWAY GATEWAYDEV NISDOMAIN));
}

sub write_resolv_conf {
    my ($file, $netc) = @_;

    #- get the list of used dns.
    my %used_dns; @used_dns{$netc->{dnsServer}, $netc->{dnsServer2}, $netc->{dnsServer3}} = (1, 2, 3);

    unless ($netc->{DOMAINNAME} || $netc->{DOMAINNAME2} || keys %used_dns > 0) {
	unlink($file);
	log::l("neither domain name nor dns server are configured");
	return 0;
    }

    my (%search, %dns, @unknown);
    local *F; open F, $file;
    local $_;
    while (<F>) {
	/^[#\s]*search\s+(.*?)\s*$/ and $search{$1} = $., next;
	/^[#\s]*nameserver\s+(.*?)\s*$/ and $dns{$1} = $., next;
	/^.*# ppp temp entry\s*$/ and next;
	/^[#\s]*(\S.*?)\s*$/ and push @unknown, $1;
    }

    close F; open F, ">$file" or die "cannot write $file: $!";
    print F "# search $_\n" foreach grep { $_ ne "$netc->{DOMAINNAME} $netc->{DOMAINNAME2}" } sort { $search{$a} <=> $search{$b} } keys %search;
    print F "search $netc->{DOMAINNAME} $netc->{DOMAINNAME2}\n\n" if ($netc->{DOMAINNAME} || $netc->{DOMAINNAME2});
    print F "# nameserver $_\n" foreach grep { ! exists $used_dns{$_} } sort { $dns{$a} <=> $dns{$b} } keys %dns;
    print F "nameserver $_\n" foreach  sort { $used_dns{$a} <=> $used_dns{$b} } grep { $_ } keys %used_dns;
    print F "\n";
    print F "# $_\n" foreach @unknown;
    print F "\n";
    print F "# ppp temp entry\n";

    #-res_init();		# reinit the resolver so DNS changes take affect
    1;
}

sub write_interface_conf {
    my ($file, $intf) = @_;

    my @ip = split '\.', $intf->{IPADDR};
    my @mask = split '\.', $intf->{NETMASK};
    add2hash($intf, {
		     BROADCAST => join('.', mapn { int $_[0] | ~int $_[1] & 255 } \@ip, \@mask),
		     NETWORK   => join('.', mapn { int $_[0] &      $_[1]       } \@ip, \@mask),
		     ONBOOT => bool2yesno(!member($intf->{DEVICE}, map { $_->{device} } detect_devices::probeall())),
		    });
    setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT));
}

sub add2hosts {
    my ($file, $hostname, @ips) = @_;
    my %l;
    $l{$_} = $hostname foreach @ips;

    local *F;
    if (-e $file) {
	open F, $file or die "cannot open $file: $!";
	/\s*(\S+)(.*)/ and $l{$1} ||= $2 foreach <F>;
    }
    log::l("writing host information to $file");
    open F, ">$file" or die "cannot write $file: $!";
    while (my ($ip, $v) = each %l) {
	$ip or next;
	print F "$ip";
	if ($v =~ /^\s/) {
	    print F $v;
	} else {
	    print F "\t\t$v";
	    print F " $1" if $v =~ /(.*?)\./;
	}
	print F "\n";
    }
}

# The interface/gateway needs to be configured before this will work!
sub guessHostname {
    my ($prefix, $netc, $intf) = @_;

    $intf->{isUp} && dnsServers($netc) or return 0;
    $netc->{HOSTNAME} && $netc->{DOMAINNAME} and return 1;

    write_resolv_conf("$prefix/etc/resolv.conf", $netc);

    my $name = gethostbyaddr(Socket::inet_aton($intf->{IPADDR}), AF_INET) or log::l("reverse name lookup failed"), return 0;

    log::l("reverse name lookup worked");

    add2hash($netc, { HOSTNAME => $name });
    1;
}

sub addDefaultRoute {
    my ($netc) = @_;
    c::addDefaultRoute($netc->{GATEWAY}) if $netc->{GATEWAY};
}

sub sethostname {
    my ($netc) = @_;
    syscall_('sethostname', $netc->{HOSTNAME}, length $netc->{HOSTNAME}) or log::l("sethostname failed: $!");
}

sub resolv($) {
    my ($name) = @_;
    is_ip($name) and return $name;
    my $a = join(".", unpack "C4", (gethostbyname $name)[4]);
    #-log::l("resolved $name in $a");
    $a;
}

sub dnsServers {
    my ($netc) = @_;
    my %used_dns; @used_dns{$netc->{dnsServer}, $netc->{dnsServer2}, $netc->{dnsServer3}} = (1, 2, 3);
    sort { $used_dns{$a} <=> $used_dns{$b} } grep { $_ } keys %used_dns;
}

sub findIntf {
    my ($intf, $device) = @_;
    $intf->{$device} ||= { DEVICE => $device };
}
#PAD \s* a la fin
my $ip_regexp = qr/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
sub is_ip {
    my ($ip) = @_;
    return 0 unless $ip =~ $ip_regexp;
    my @fields = ($1, $2, $3, $4);
    foreach (@fields) {
	return 0 if $_ < 0 || $_ > 255;
    }
    return 1;
}

sub netmask {