diff options
Diffstat (limited to 'perl-install/network')
| -rw-r--r-- | perl-install/network/adsl.pm | 305 | ||||
| -rw-r--r-- | perl-install/network/drakfirewall.pm | 192 | ||||
| -rw-r--r-- | perl-install/network/ethernet.pm | 198 | ||||
| -rw-r--r-- | perl-install/network/isdn.pm | 271 | ||||
| -rw-r--r-- | perl-install/network/isdn_consts.pm | 329 | ||||
| -rw-r--r-- | perl-install/network/modem.pm | 276 | ||||
| -rw-r--r-- | perl-install/network/netconnect.pm | 370 | ||||
| -rw-r--r-- | perl-install/network/network.pm | 568 | ||||
| -rw-r--r-- | perl-install/network/nfs.pm | 63 | ||||
| -rw-r--r-- | perl-install/network/shorewall.pm | 138 | ||||
| -rw-r--r-- | perl-install/network/smb.pm | 181 | ||||
| -rw-r--r-- | perl-install/network/smbnfs.pm | 45 | ||||
| -rw-r--r-- | perl-install/network/tools.pm | 303 |
13 files changed, 0 insertions, 3239 deletions
diff --git a/perl-install/network/adsl.pm b/perl-install/network/adsl.pm deleted file mode 100644 index a576ccef8..000000000 --- a/perl-install/network/adsl.pm +++ /dev/null @@ -1,305 +0,0 @@ -package network::adsl; # $Id$ - -use common; -use run_program; -use network::tools; -use network::ethernet; -use modules; -use vars qw(@ISA @EXPORT); -use MDK::Common::Globals "network", qw($in $prefix); - -@ISA = qw(Exporter); -@EXPORT = qw(adsl_ask_info adsl_detect adsl_conf adsl_conf_backend); - -sub configure { - my ($netcnx, $netc, $intf, $first_time) = @_; - - conf_adsl_step1: - my %l = ( - 'pppoe' => N_("use pppoe"), - 'pptp' => N_("use pptp"), - 'dhcp' => N_("use dhcp"), - 'speedtouch' => N_("Alcatel speedtouch usb") . if_($netc->{autodetect}{adsl}{speedtouch}, " - detected"), - 'sagem' => N_("Sagem (using pppoa) usb") . if_($netc->{autodetect}{adsl}{sagem}, " - detected"), - ); - - my $type = $in->ask_from_list_(N("Connect to the Internet"), - N("The most common way to connect with adsl is pppoe. -Some connections use pptp, a few use dhcp. -If you don't know, choose 'use pppoe'"), - [ sort values %l ], - $l{ find { $netc->{autodetect}{adsl}{$_} } keys %l } - ) or return; - $type =~ s/use //; - if ($type eq 'pppoe') { - $in->do_pkgs->install("rp-$type"); - $netcnx->{type} = "adsl_$type"; - adsl_conf($netcnx->{"adsl_$type"}, $netc, $intf, $type) or goto conf_adsl_step1; - } - if ($type eq 'dhcp') { - $in->do_pkgs->install(qw(dhcpcd)); - go_ethernet($netc, $intf, 'dhcp', '', '', $first_time) or goto conf_adsl_step1; - } - if ($type eq 'pptp') { - $in->do_pkgs->install(qw(pptp-adsl)); - $netcnx->{type} = "adsl_$type"; - $netcnx->{"adsl_$type"} = {}; - adsl_conf($netcnx->{"adsl_$type"}, $netc, $intf, $type) or goto conf_adsl_step1; - } - if ($type =~ /Sagem/) { - $type = 'sagem'; - $in->do_pkgs->install(qw(adiusbadsl)); - $netcnx->{type} = "adsl_$type"; - $netcnx->{"adsl_$type"} = {}; - adsl_conf($netcnx->{"adsl_$type"}, $netc, $intf, $type) or goto conf_adsl_step1; - } - if ($type =~ /speedtouch/) { - $type = 'speedtouch'; - $in->do_pkgs->install(qw(speedtouch)); - $netcnx->{type} = "adsl_$type"; - $netcnx->{"adsl_$type"} = {}; - $netcnx->{"adsl_$type"}{vpivci} = ''; - adsl_conf($netcnx->{"adsl_$type"}, $netc, $intf, $type) or goto conf_adsl_step1; - } - # if ($type =~ /ECI/) { -# $type = 'eci'; -# $in->do_pkgs->install(qw(eciadsl)); -# $netcnx->{type} = "adsl_$type"; -# $netcnx->{"adsl_$type"} = {}; -# $netcnx->{"adsl_$type"}{vpivci} = ''; -# adsl_conf($netcnx->{"adsl_$type"}, $netc, $intf, $type) or goto conf_adsl_step1; -# } - $type =~ /speedtouch|eci/ or $netconnect::need_restart_network = 1; - 1; -} - -sub adsl_probe_info { - my ($adsl, $netc, $adsl_type) = @_; - my $pppoe_file = "$prefix/etc/ppp/pppoe.conf"; - my $pptp_file = "$prefix/etc/sysconfig/network-scripts/net_cnx_up"; - my %pppoe_conf; %pppoe_conf = getVarsFromSh($pppoe_file) if (! defined $adsl_type || $adsl_type =~ /pppoe/) && -f $pppoe_file; - my $login = $pppoe_conf{USER}; - foreach (qw(/etc/ppp/peers/adsl /etc/ppp/options /etc/ppp/options.adsl)) { - ($login) = map { if_(/^user\s+\"([^\"]+)\"/, $1) } cat_("$prefix/$_") if !$login && -r "$prefix/$_"; - } - ($login) = map { if_(/\sname\s+([^ \n]+)/, $1) } cat_($pptp_file) if (! defined $adsl_type || $adsl_type =~ /pptp/) && -r $pptp_file; - my $passwd = passwd_by_login($login); - $pppoe_conf{DNS1} ||= ''; - $pppoe_conf{DNS2} ||= ''; - add2hash($netc, { dnsServer2 => $pppoe_conf{DNS1}, dnsServer3 => $pppoe_conf{DNS2}, DOMAINNAME2 => '' }); - add2hash($adsl, { login => $login, passwd => $passwd, passwd2 => '' }); -} - -sub adsl_ask_info { - my ($adsl, $netc, $adsl_type) = @_; - adsl_probe_info($adsl, $netc, $adsl_type); - ask_info2($adsl, $netc); -} - -sub adsl_detect { - my ($adsl) = @_; - require detect_devices; - $adsl->{speedtouch} = detect_devices::getSpeedtouch(); - $adsl->{sagem} = detect_devices::getSagem(); - return $adsl if $adsl->{speedtouch} || $adsl->{sagem}; -} - -sub adsl_conf { - my ($adsl, $netc, $intf, $adsl_type) = @_; - - adsl_conf_step_1: - adsl_ask_info($adsl, $netc, $adsl_type) or return; - adsl_conf_step_2: - $adsl_type =~ /sagem|speedtouch|eci/ or conf_network_card($netc, $intf, 'static', '10.0.0.10') or goto adsl_conf_step_1; - adsl_conf_backend($adsl, $netc, $adsl_type) or goto adsl_conf_step_1; - 1; -} - -sub load_firmware_floppy { - my ($file, $destination) = @_; - my $floppy = detect_devices::floppy(); - my $failed; - - $in->ask_okcancel(N("Insert floppy"), - N("Insert a FAT formatted floppy in drive %s with %s in root directory and press %s", $floppy, $file, N("Next"))) or return; - - eval { fs::mount(devices::make($floppy), "/mnt", "vfat", 'readonly'); 1 } or $failed = N("Floppy access error, unable to mount device %s", $floppy); - my $_b = before_leaving { fs::umount("/mnt") }; - - if (-e "/mnt/$file") { - cp_af("/mnt/$file $destination"); - } else { $failed ||= N("Firmware copy failed, file %s not found", $file) } - - eval { $in->ask_warn('', $failed || N("Firmware copy succeeded")) }; $in->exit if $@ =~ /wizcancel/; - $failed and log::l($failed) && return; - - 1; -} - -sub adsl_conf_backend { - my ($adsl, $netc, $adsl_type, $o_netcnx) = @_; - defined $o_netcnx and $netc->{adsltype} = $o_netcnx->{type}; - $netc->{adsltype} ||= "adsl_$adsl_type"; - mkdir_p("$prefix/etc/ppp"); - output("$prefix/etc/ppp/options", -'lock -noipdefault -persist -noauth -usepeerdns -defaultroute -') if $adsl_type =~ /pptp|pppoe|speedtouch|eci/; - - write_secret_backend($adsl->{login}, $adsl->{passwd}); - - if ($adsl_type eq 'pppoe') { - substInFile { - s/ETH=.*\n/ETH=$netc->{NET_DEVICE}\n/; - s/USER=.*\n/USER=$adsl->{login}\n/; - s/DNS1=.*\n/DNS1=$netc->{dnsServer2}\n/; - s/DNS2=.*\n/DNS2=$netc->{dnsServer3}\n/; - } "$prefix/etc/ppp/pppoe.conf"; - } - - if ($adsl_type eq 'sagem') { - output("$prefix/etc/ppp/peers/adsl", -qq(noauth -noipdefault -pty "/usr/sbin/pppoa -I `/usr/sbin/adictrl -s; /usr/sbin/adictrl -i`" -mru 1492 -mtu 1492 -kdebug 1 -nobsdcomp -nodeflate -noaccomp -am -nopcomp -noccp -novj -novjccomp -holdoff 4 -maxfail 25 -persist -usepeerdns -defaultroute -user "$adsl->{login}" -)); - } - - if ($adsl_type eq 'speedtouch') { - my ($vpi, $vci) = $netc->{vpivci} =~ /(\d+)_(\d+)/ or return; - output("$prefix/etc/ppp/peers/adsl", -qq(noauth -noipdefault -pty "/usr/sbin/pppoa3 -e 1 -c -vpi $vpi -vci $vci" -sync -kdebug 1 -noaccomp -nopcomp -noccp -novj -holdoff 4 -maxfail 25 -persist -usepeerdns -defaultroute -user "$adsl->{login}" -)); - modules::add_alias($_->[0], $_->[1]) foreach ['char-major-108', 'ppp_generic'], - ['tty-ldisc-3', 'ppp_async'], - ['tty-ldisc-13', 'n_hdlc'], - ['tty-ldisc-14', 'ppp_synctty'], - ['ppp-compress-21', 'bsd_comp'], - ['ppp-compress-24', 'ppp_deflate'], - ['ppp-compress-26', 'ppp_deflate']; - $::isStandalone and modules::write_conf($prefix); - $in->do_pkgs->what_provides("speedtouch_mgmt") and $in->do_pkgs->install('speedtouch_mgmt'); - -e "/usr/share/speedtouch/mgmt.o" and return 1; - - firmware: - - my $l = [ N_("Use a floppy"), - N_("Use my Windows partition"), - N_("Do it later"), - ]; - - my $answer = $in->ask_from_list_(N("Firmware needed"), - N("You need the Alcatel microcode. -You can provide it now via a floppy or your windows partition, -or skip and do it later."), $l) or return; - - $answer eq "Use a floppy" and load_firmware_floppy("mgmt.o", "/usr/share/speedtouch/") || goto firmware; - $answer eq "Use my Windows partition" and goto firmware; # to be done - $answer eq "Do it later" and $in->ask_warn('', N("You need the Alcatel microcode. -Download it at: -%s -and copy the mgmt.o in /usr/share/speedtouch", 'http://prdownloads.sourceforge.net/speedtouch/speedtouch-20011007.tar.bz2')); - } - - if ($adsl_type eq 'eci') { - my ($vpi, $vci) = $netc->{vpivci} =~ /(\d+)_(\d+)/ or return; - output("$prefix/etc/ppp/peers/adsl", -qq(debug -kdebug 1 -noipdefault -defaultroute -pty "/usr/bin/pppoeci -v 1 -vpi $vpi -vci $vci" -sync -noaccomp -nopcomp -noccp -novj -holdoff 10 -user "$adsl->{login}" -linkname eciadsl -maxfail 10 -usepeerdns -noauth -lcp-echo-interval 0 -)); - modules::add_alias($_->[0], $_->[1]) foreach ['char-major-108', 'ppp_generic'], - ['tty-ldisc-14', 'ppp_synctty'], - ['tty-ldisc-13', 'n_hdlc']; - $::isStandalone and modules::write_conf($prefix); - } - - if ($adsl_type eq 'pptp') { - write_cnx_script($netc, "adsl", -"/sbin/route del default -/usr/bin/pptp 10.0.0.138 name $adsl->{login} -", -'/usr/bin/killall pptp pppd -', $netc->{adsltype}) } elsif ($adsl_type eq 'pppoe') { - write_cnx_script($netc, "adsl", -"/sbin/route del default -LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C /usr/sbin/adsl-start $netc->{NET_DEVICE} $adsl->{login} -", -'/usr/sbin/adsl-stop -/usr/bin/killall pppoe pppd -', $netc->{adsltype}) } elsif ($adsl_type eq 'speedtouch') { - write_cnx_script($netc, 'adsl', -'/sbin/route del default -/usr/share/speedtouch/speedtouch.sh start -', -'/usr/share/speedtouch/speedtouch.sh stop -', $netc->{adsltype}) } elsif ($adsl_type eq 'sagem') { - write_cnx_script($netc, 'adsl', -'/sbin/route del default -/usr/sbin/adictrl -s -INTERFACE=`/usr/sbin/adictrl -i` -/sbin/ifconfig $INTERFACE 192.168.60.30 netmask 255.255.255.0 up -/usr/sbin/pppd file /etc/ppp/peers/adsl -', -'/usr/sbin/stopadsl -', $netc->{adsltype}) } elsif ($adsl_type eq 'eci') { - write_cnx_script($netc, 'adsl', -'/sbin/route del default -/usr/bin/startmodem -', -"# et pour le stop on se touche c'est du beta... -echo 'not yet implemented, still beta software' -", $netc->{adsltype}) } - - $netc->{NET_INTERFACE} = 'ppp0'; -} - -1; diff --git a/perl-install/network/drakfirewall.pm b/perl-install/network/drakfirewall.pm deleted file mode 100644 index dc2dcc668..000000000 --- a/perl-install/network/drakfirewall.pm +++ /dev/null @@ -1,192 +0,0 @@ -package network::drakfirewall; # $Id$ - -use diagnostics; -use strict; - -use network::shorewall; -use common; - -my @all_servers = -( - { - name => N_("Web Server"), - pkg => 'apache apache-mod_perl boa', - ports => '80/tcp 443/tcp', - }, - { - name => N_("Domain Name Server"), - pkg => 'bind', - ports => '53/tcp 53/udp', - }, - { - name => "SSH", - pkg => 'openssh-server', - ports => '22/tcp', - }, - { - name => "FTP", - pkg => 'ftp-server-krb5 wu-ftpd proftpd pure-ftpd', - ports => '20/tcp 21/tcp', - }, - { - name => N_("Mail Server"), - pkg => 'sendmail postfix qmail', - ports => '25/tcp', - }, - { - name => N_("POP and IMAP Server"), - pkg => 'imap courier-imap-pop', - ports => '109/tcp 110/tcp 143/tcp', - }, - { - name => "Telnet", - pkg => 'telnet-server-krb5', - ports => '23/tcp', - hide => 1, - }, - { - name => "Samba", - pkg => 'samba-server', - ports => '137/tcp 137/udp 138/tcp 138/udp 139/tcp 139/udp ', - hide => 1, - }, - { - name => "CUPS", - pkg => 'cups', - ports => '631/tcp 631/udp', - hide => 1, - }, -); - -sub port2server { - my ($port) = @_; - find { - any { $port eq $_ } split(' ', $_->{ports}); - } @all_servers; -} - -sub check_ports_syntax { - my ($ports) = @_; - foreach (split ' ', $ports) { - my ($nb) = m!^(\d+)/(tcp|udp)$! or return $_; - 1 <= $nb && $nb <= 65535 or return $_; - } - ''; -} - -sub to_ports { - my ($servers, $unlisted) = @_; - my $ports = join(' ', (map { $_->{ports} } @$servers), if_($unlisted, $unlisted)); - \$ports; -} - -sub from_ports { - my ($ports) = @_; - - my @l; - my @unlisted; - foreach (split ' ', $$ports) { - if (my $s = port2server($_)) { - push @l, $s; - } else { - push @unlisted, $_; - } - } - [ uniq(@l) ], join(' ', @unlisted); -} - -sub default_from_pkgs { - my ($in) = @_; - my @pkgs = $in->do_pkgs->are_installed(map { split ' ', $_->{pkg} } @all_servers); - [ grep { - my $s = $_; - any { member($_, @pkgs) } (split ' ', $s->{pkg}); - } @all_servers ]; -} - -sub get_ports { - my ($_ports) = @_; - my $shorewall = network::shorewall::read() or return; - \$shorewall->{ports}; -} - -sub set_ports { - my ($in, $disabled, $ports) = @_; - - my $shorewall = network::shorewall::read() || network::shorewall::default_interfaces() or die \N("No network card"); - - if (!$disabled || -x "$::prefix/sbin/shorewall") { - $in->do_pkgs->ensure_is_installed('shorewall', '/sbin/shorewall', $::isInstall) or return; - - $shorewall->{disabled} = $disabled; - $shorewall->{ports} = $$ports; - network::shorewall::write($shorewall); - } -} - -sub get_conf { - my ($in, $disabled, $o_ports) = @_; - - my $possible_servers = default_from_pkgs($in); - $_->{hide} = 0 foreach @$possible_servers; - - if ($o_ports) { - $disabled, from_ports($o_ports); - } elsif (my $shorewall = network::shorewall::read()) { - $shorewall->{disabled}, from_ports(\$shorewall->{ports}); - } else { - $in->ask_okcancel('', N("drakfirewall configurator - -This configures a personal firewall for this Mandrake Linux machine. -For a powerful and dedicated firewall solution, please look to the -specialized MandrakeSecurity Firewall distribution."), 1) or return; - - $in->ask_okcancel('', N("drakfirewall configurator - -Make sure you have configured your Network/Internet access with -drakconnect before going any further."), 1) or return; - - $disabled, $possible_servers, ''; - } -} - -sub choose { - my ($in, $disabled, $servers, $unlisted) = @_; - - $_->{on} = 0 foreach @all_servers; - $_->{on} = 1 foreach @$servers; - my @l = grep { $_->{on} || !$_->{hide} } @all_servers; - - $in->ask_from_({ - messages => N("Which services would you like to allow the Internet to connect to?"), - advanced_messages => N("You can enter miscellaneous ports. -Valid examples are: 139/tcp 139/udp. -Have a look at /etc/services for information."), - callbacks => { - complete => sub { - if (my $invalid_port = check_ports_syntax($unlisted)) { - $in->ask_warn('', N("Invalid port given: %s. -The proper format is \"port/tcp\" or \"port/udp\", -where port is between 1 and 65535.", $invalid_port)); - return 1; - } - }, - } }, - [ - { text => N("Everything (no firewall)"), val => \$disabled, type => 'bool' }, - (map { { text => translate($_->{name}), val => \$_->{on}, type => 'bool', disabled => sub { $disabled } } } @l), - { label => N("Other ports"), val => \$unlisted, advanced => 1, disabled => sub { $disabled } } - ]) or return; - - $disabled, to_ports([ grep { $_->{on} } @l ], $unlisted); -} - -sub main { - my ($in, $disabled) = @_; - - ($disabled, my $servers, my $unlisted) = get_conf($in, $disabled) or return; - - ($disabled, my $ports) = choose($in, $disabled, $servers, $unlisted) or return; - - set_ports($in, $disabled, $ports); -} diff --git a/perl-install/network/ethernet.pm b/perl-install/network/ethernet.pm deleted file mode 100644 index 7eb54397e..000000000 --- a/perl-install/network/ethernet.pm +++ /dev/null @@ -1,198 +0,0 @@ -package network::ethernet; # $Id$ - - -use network::network; -use modules; -use modules::interactive; -use detect_devices; -use common; -use run_program; -use network::tools; -use vars qw(@ISA @EXPORT); - -use MDK::Common::Globals "network", qw($in $prefix); - -@ISA = qw(Exporter); -@EXPORT = qw(configureNetwork conf_network_card conf_network_card_backend go_ethernet); - -sub configure_cable { - my ($netcnx, $netc, $intf, $first_time) = @_; - - $netcnx->{type} = 'cable'; - - $in->ask_from(N("Connect to the Internet"), - N("Which dhcp client do you want to use ? (default is dhcp-client)"), - [ { val => \$netcnx->{dhcp_client}, list => ["dhcp-client", "dhcpcd", "dhcpxd"] } ], - ) or return; - - $in->do_pkgs->install($netcnx->{dhcp_client}); - - go_ethernet($netc, $intf, 'dhcp', '', '', $first_time); - write_cnx_script($netc, "cable", -qq( -/sbin/ifup $netc->{NET_DEVICE} -), -qq( -/sbin/ifdown $netc->{NET_DEVICE} -), $netcnx->{type}); - 1; -} - -sub configure_lan { - my ($netcnx, $netc, $intf, $first_time) = @_; - configureNetwork($netc, $intf, $first_time) or return; - configureNetwork2($in, $prefix, $netc, $intf); - $netc->{NETWORKING} = "yes"; - if ($netc->{GATEWAY} || any { $_->{BOOTPROTO} =~ /dhcp/ } values %$intf) { - $netcnx->{type} = 'lan'; - $netcnx->{NET_DEVICE} = $netc->{NET_DEVICE} = ''; - $netcnx->{NET_INTERFACE} = 'lan'; #$netc->{NET_INTERFACE}; - write_cnx_script($netc, "local network", -qq( -/etc/rc.d/init.d/network restart -), -qq( -/etc/rc.d/init.d/network stop -/sbin/ifup lo -), $netcnx->{type}); - } - $::isStandalone and modules::write_conf($prefix); - 1; -} - -sub conf_network_card { - my ($netc, $intf, $type, $ipadr, $o_netadr) = @_; - #-type =static or dhcp - modules::interactive::load_category($in, 'network/main|gigabit|usb', !$::expert, 1); - my @all_cards = conf_network_card_backend($netc, $intf, $type, undef, $ipadr, $o_netadr) or - $in->ask_warn('', N("No ethernet network adapter has been detected on your system. -I cannot set up this connection type.")), return; - - my $interface = $in->ask_from_listf(N("Choose the network interface"), - N("Please choose which network adapter you want to use to connect to Internet."), - sub { my ($e) = @_; $e->[0] . ($e->[1] ? " (using module $e->[1])" : "") }, - \@all_cards) or return; - - modules::write_conf($prefix) if $::isStandalone; - - my $_device = conf_network_card_backend($netc, $intf, $type, $interface->[0], $ipadr, $o_netadr); -# if ( $::isStandalone and !($type eq "dhcp")) { -# $in->ask_yesorno(N("Network interface"), -# N("I'm about to restart the network device:\n") . $device . N("\nDo you agree?"), 1) and configureNetwork2($in, $prefix, $netc, $intf) and system("$prefix/sbin/ifdown $device;$prefix/sbin/ifup $device"); -# } - 1; -} - -#- conf_network_card_backend : configure the network cards and return the list of them, or configure one specified interface : WARNING, you have to setup the ethernet cards, by calling load_category($in, 'network/main|gigabit|usb', !$::expert, 1) or load_category_backend before calling this function. Basically, you call this function in 2 times. -#- input -#- $prefix -#- $netc -#- $intf -#- $type : type of interface, must be given if $interface is : string : "static" or "dhcp" -#- $interface : facultative, if given, set this interface and return it in a proper form. If not, return @all_cards -#- $ipadr : facultative, ip address of the interface : string -#- $netadr : facultative, netaddress of the interface : string -#- when $interface is given, informations are written in $intf and $netc. If not, @all_cards is returned. -#- $intf output: $device is the result of -#- $intf->{$device}->{DEVICE} : which device is concerned : $device is the result of $interface =~ /(eth[0-9]+)/; my $device = $1;; -#- $intf->{$device}->{BOOTPROTO} : $type -#- $intf->{$device}->{NETMASK} : '255.255.255.0' -#- $intf->{$device}->{NETWORK} : $netadr -#- $intf->{$device}->{ONBOOT} : "yes" -#- $netc output: -#- $netc->{NET_DEVICE} : this is used to indicate that this eth card is used to connect to internet : $device -#- output: -#- $all_cards : a list of a list ( [eth1, module1], ... , [ethn, modulen]). Pass the ethx as $interface in further call. -#- $device : only returned in case $interface was given it's $interface, but filtered by /eth[0-9+]/ : string : /eth[0-9+]/ -sub conf_network_card_backend { - my ($netc, $intf, $o_type, $o_interface, $o_ipadr, $o_netadr) = @_; - #-type =static or dhcp - if (!$o_interface) { - my @all_cards = detect_devices::getNet(); - - my @devs = detect_devices::pcmcia_probe(); - modules::mergein_conf("$prefix/etc/modules.conf"); - my $saved_driver; - return map { - my $interface = $_; - my $interface_state = `LC_ALL=C LANG=C LANGUAGE=C LC_MESSAGES=C $::prefix/sbin/ifconfig "$interface"`; - my $a = modules::get_alias($interface); - my $b; - foreach (@devs) { - $_->{device} eq $interface and $b = $_->{driver}; - } - $a ||= $b; - $a and $saved_driver = $a; - if_($::isInstall || $interface_state =~ /inet addr|Bcast|Mask|Interrupt|Base address/ && $a, - [$interface, $saved_driver]); - } @all_cards; - } - $o_interface =~ /eth[0-9]+/ or die("the interface is not an ethx"); - - $netc->{NET_DEVICE} = $o_interface; #- one consider that there is only ONE Internet connection device.. - - @{$intf->{$o_interface}}{qw(DEVICE BOOTPROTO NETMASK NETWORK ONBOOT)} = ($o_interface, $o_type, '255.255.255.0', $o_netadr, 'yes'); - - $intf->{$o_interface}{IPADDR} = $o_ipadr if $o_ipadr; - $o_interface; -} - -sub go_ethernet { - my ($netc, $intf, $type, $ipadr, $netadr, $first_time) = @_; - conf_network_card($netc, $intf, $type, $ipadr, $netadr) or return; - $netc->{NET_INTERFACE} = $netc->{NET_DEVICE}; - configureNetwork($netc, $intf, $first_time) or return; - 1; -} - -sub configureNetwork { - my ($netc, $intf, $_first_time) = @_; - local $_; - modules::interactive::load_category($in, 'network/main|gigabit|usb|pcmcia', !$::expert, 1) or return; - my @all_cards = conf_network_card_backend($netc, $intf); - my @l = map { $_->[0] } @all_cards; - - foreach (@all_cards) { - modules::remove_alias($_->[0]); - modules::add_alias($_->[0], $_->[1]); - } - - configureNetwork_step_1: - $netc ||= {}; - my $last; foreach (@all_cards) { - my $intf2 = findIntf($intf ||= {}, $_->[0]); - add2hash($intf2, $last); - add2hash($intf2, { NETMASK => '255.255.255.0' }); - configureNetworkIntf($netc, $in, $intf2, $netc->{NET_DEVICE}, 0, $_->[1]) or return; - - $last = $intf2; - } - $last or return; - - configureNetwork_step_2: - if ($last->{BOOTPROTO} !~ /static/) { - $netc->{minus_one} = 1; - - $in->ask_from(N("Configuring network"), N(" - -Enter a Zeroconf host name without any dot if you don't -want to use the default host name."), - [ { label => N("Zeroconf Host name"), val => \$netc->{ZEROCONF_HOSTNAME} }, - { label => N("Host name"), val => \$netc->{HOSTNAME}, advanced => 1 } - ], - complete => sub { - if ($netc->{ZEROCONF_HOSTNAME} =~ /\./) { - $in->ask_warn('', N("Zeroconf host name must not contain a .")); - return 1; - } - 0; - } - ) or goto configureNetwork_step_1; - } else { - configureNetworkNet($in, $netc, $last ||= {}, @l) or goto configureNetwork_step_1; - } - network::network::miscellaneous_choose($in, $::o->{miscellaneous} ||= {}) or goto configureNetwork_step_2; - 1; -} - -1; diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm deleted file mode 100644 index 0b4449781..000000000 --- a/perl-install/network/isdn.pm +++ /dev/null @@ -1,271 +0,0 @@ -package network::isdn; # $Id$ - -use strict; -use network::isdn_consts; -use common; -use any; -use modules; -use run_program; -use log; -use network::tools; -use vars qw(@ISA @EXPORT); -use MDK::Common::Globals "network", qw($in $prefix); -use MDK::Common::File; - - -@ISA = qw(Exporter); -@EXPORT = qw(isdn_write_config isdn_write_config_backend get_info_providers_backend isdn_ask_info isdn_ask_protocol isdn_ask isdn_detect isdn_detect_backend isdn_get_list isdn_get_info); - -sub configure { - my ($netcnx, $netc, $_isdn) = @_; - isdn_step_1: - defined $netc->{autodetect}{isdn}{id} and goto intern_pci; - - my $e = $in->ask_from_list_(N("Network Configuration Wizard"), - N("What kind is your ISDN connection?"), [ N_("Internal ISDN card"), N_("External ISDN modem") ] - ) or return; - - if ($e =~ /card/) { - intern_pci: - $netc->{isdntype} = 'isdn_internal'; - $netcnx->{isdn_internal}{$_} = $netc->{autodetect}{isdn}{$_} foreach 'description', 'vendor', 'id', 'driver', 'card_type', 'type'; - $netcnx->{isdn_internal} = isdn_read_config($netcnx->{isdn_internal}); - isdn_detect($netcnx->{isdn_internal}, $netc) or goto isdn_step_1; - } else { - $netc->{isdntype} = 'isdn_external'; - $netcnx->{isdn_external}{device} = $netc->{autodetect}{modem}; - $netcnx->{isdn_external} = isdn_read_config($netcnx->{isdn_external}); - $netcnx->{isdn_external}{special_command} = 'AT&F&O2B40'; - require network::modem; - network::modem::ppp_choose($in, $netc, $netcnx->{isdn_external}) or goto isdn_step_1; - } - 1; -} - -sub isdn_write_config { - my ($isdn, $netc) = @_; - $in->do_pkgs->install('isdn4net', if_($isdn->{speed} =~ /128/, 'ibod'), 'isdn4k-utils'); - isdn_write_config_backend($isdn, $netc); - 1; -} - -sub isdn_write_config_backend { - my ($isdn, $netc, $o_netcnx) = @_; - defined $o_netcnx and $netc->{isdntype} = $o_netcnx->{type}; - - output_with_perm("$prefix/etc/isdn/profile/link/myisp", 0600, - qq( -I4L_USERNAME="$isdn->{login}" -I4L_SYSNAME="" -I4L_LOCALMSN="$isdn->{phone_in}" -I4L_REMOTE_OUT="$isdn->{phone_out}" -I4L_DIALMODE="$isdn->{dialing_mode}" -) . if_($isdn->{speed} =~ /128/, 'SLAVE="ippp1" -')); - output "$prefix/etc/isdn/profile/card/mycard", - qq( -I4L_MODULE="$isdn->{driver}" -I4L_TYPE="$isdn->{type}" -I4L_IRQ="$isdn->{irq}" -I4L_MEMBASE="$isdn->{mem}" -I4L_PORT="$isdn->{io}" -I4L_IO0="$isdn->{io0}" -I4L_IO1="$isdn->{io1}" -I4L_ID="HiSax" -I4L_FIRMWARE="$isdn->{firmware}" -); - - output "$prefix/etc/ppp/ioptions", - "lock -usepeerdns -defaultroute -"; - system "$prefix/etc/rc.d/init.d/isdn4linux restart"; - - substInFile { s/^FIRMWARE.*\n//; $_ .= qq(FIRMWARE="$isdn->{firmware}"\n) if eof } "$prefix/etc/sysconfig/network-scripts/ifcfg-ippp0"; - - # we start the virtual interface at boot (we dial only on demand. - substInFile { s/^ONBOOT.*\n//; $_ .= qq(ONBOOT=yes\n) if eof } "$prefix/etc/sysconfig/network-scripts/ifcfg-ippp0"; - - write_secret_backend($isdn->{login}, $isdn->{passwd}); - - write_cnx_script($netc, "isdn", -"#/sbin/route del default -#/sbin/ifup ippp0 -/usr/sbin/isdnctrl dial ippp0 -" . if_($isdn->{speed} =~ /128/, "service ibod restart -"), -"/usr/sbin/isdnctrl hangup ippp0 -#/sbin/ifdown ippp0 -" . if_($isdn->{speed} =~ /128/, "service ibod stop -"), $netc->{isdntype}); - 1; -} - -sub isdn_read_config { - my ($isdn) = @_; - - my %match = (I4L_USERNAME => 'login', - I4L_LOCALMSN => 'phone_in', - I4L_REMOTE_OUT => 'phone_out', - I4L_DIALMODE => 'dialing_mode', - I4L_MODULE => 'driver', - I4L_TYPE => 'type', - I4L_IRQ => 'irq', - I4L_MEMBASE => 'mem', - I4L_PORT => 'io', - I4L_IO0 => 'io0', - I4L_IO1 => 'io1', - I4L_FIRMWARE => 'firmware'); - foreach ('link/myisp', 'card/mycard') { - my %conf = getVarsFromSh("$prefix/etc/isdn/profile/$_"); - foreach (keys %conf) { - $isdn->{$match{$_}} = $conf{$_} if $match{$_}; - } - } - - $isdn->{passwd} = network::tools::passwd_by_login($isdn->{login}); - #$isdn->{description} = ''; - #$isdn->{vendor} = ''; - #$isdn->{passwd2} = ''; - $isdn; -} - -sub get_info_providers_backend { - my ($isdn, $_netc, $name, $file) = @_; - $name eq 'Unlisted - edit manually' and return; - foreach (catMaybeCompressed($file)) { - chop; - my ($name_, $phone, $real, $dns1, $dns2) = split '=>'; - if ($name eq $name_) { - @$isdn{qw(user_name phone_out DOMAINNAME2 dnsServer3 dnsServer2)} = - ((split(/\|/, $name_))[2], $phone, $real, $dns1, $dns2); - } - } -} - -sub isdn_ask_info { - my ($isdn, $netc) = @_; - my $f = "$ENV{SHARE_PATH}/ldetect-lst/isdn.db"; - $f = "$prefix$f" if !-e $f; - isdn_ask_info_step1: - my $str = $in->ask_from_treelist(N("ISDN Configuration"), N("Select your provider.\nIf it isn't listed, choose Unlisted."), - '|', ['Unlisted - edit manually', - read_providers_backend($f)], 'Unlisted - edit manually') - or return; - get_info_providers_backend($isdn, $netc, $str || 'Unlisted - edit manually', $f); - $isdn->{huptimeout} = 180; - $isdn->{$_} ||= '' foreach qw(phone_in phone_out dialing_mode login passwd passwd2 idl speed); - add2hash($netc, { dnsServer2 => '', dnsServer3 => '', DOMAINNAME2 => '' }); - ask_info2($isdn, $netc) or goto isdn_ask_info_step1; -} - -sub isdn_ask_protocol() { - my @toto = ( - { description => $::expert ? N("European protocol (EDSS1)") : N("European protocol"), - protokol => 2 }, - { description => $::expert ? N("Protocol for the rest of the world\nNo D-Channel (leased lines)") : N("Protocol for the rest of the world"), - protokol => 3 } - ); - my $e = $in->ask_from_listf(N("ISDN Configuration"), - N("Which protocol do you want to use?"), - sub { $_[0]{description} }, - \@toto) or return 0; - $e->{protokol}; -} - -sub isdn_ask { - my ($isdn, $netc, $label) = @_; - - #- ISDN card already detected - if (!$::expert && defined $netc->{autodetect}{isdn}{card_type}) { - $in->ask_yesorno(N("ISDN Configuration"), N("Found \"%s\" interface do you want to use it ?", $netc->{autodetect}{isdn}{description}), 1) or return; - $isdn->{$_} = $netc->{autodetect}{isdn}{$_} foreach qw(description vendor id card_type driver type mem io io0 io1 irq firmware); - goto isdn_ask_step_3; - } - - isdn_ask_step_1: - my $e = $in->ask_from_list_(N("ISDN Configuration"), - $label . "\n" . N("What kind of card do you have?"), - [ N_("ISA / PCMCIA"), N_("PCI"), N_("I don't know") ] - ) or return; - isdn_ask_step_1b: - if ($e =~ /PCI/) { - $isdn->{card_type} = 'pci'; - } else { - $in->ask_from_list_(N("ISDN Configuration"), - N(" -If you have an ISA card, the values on the next screen should be right.\n -If you have a PCMCIA card, you have to know the \"irq\" and \"io\" of your card. -"), - [ N_("Continue"), N_("Abort") ]) eq 'Continue' or goto isdn_ask_step_1; - $isdn->{card_type} = 'isa'; - } - - isdn_ask_step_2: - $e = $in->ask_from_listf(N("ISDN Configuration"), - N("Which of the following is your ISDN card?"), - sub { $_[0]{description} }, - [ grep { $_->{card} eq $isdn->{card_type} } @isdndata ]) or goto isdn_ask_step_1b; - $e->{$_} and $isdn->{$_} = $e->{$_} foreach qw(driver type mem io io0 io1 irq firmware); - - isdn_ask_step_3: - $isdn->{protocol} = isdn_ask_protocol() or goto isdn_ask_step_2; - isdn_ask_step_4: - isdn_ask_info($isdn, $netc) or goto isdn_ask_step_3; - isdn_write_config($isdn, $netc) or goto isdn_ask_step_4; - 1; -} - -sub isdn_detect { - my ($isdn, $netc) = @_; - if ($isdn->{id}) { - log::l("found isdn card : $isdn->{description}; vendor : $isdn->{vendor}; id : $isdn->{id}; driver : $isdn->{driver}\n"); - $isdn->{description} =~ s/\|/ -- /; - - isdn_detect_step_0: - defined $isdn->{type} and my $new = $in->ask_yesorno(N("ISDN Configuration"), N("Do you want to start a new configuration ?"), 1); - - if ($isdn->{type} eq '' || $new) { - isdn_ask($isdn, $netc, N("I have detected an ISDN PCI card, but I don't know its type. Please select a PCI card on the next screen.")) or goto isdn_detect_step_0; - } else { - isdn_detect_step_1: - $isdn->{protocol} = isdn_ask_protocol() or goto isdn_detect_step_0; - isdn_detect_step_2: - isdn_ask_info($isdn, $netc) or goto isdn_detect_step_1; - isdn_write_config($isdn, $netc) or goto isdn_detect_step_2; - } - } else { - isdn_ask($isdn, $netc, N("No ISDN PCI card found. Please select one on the next screen.")) or return; - } - $netc->{$_} = 'ippp0' foreach 'NET_DEVICE', 'NET_INTERFACE'; - 1; -} - -sub isdn_detect_backend { - my ($isdn) = @_; - if (my ($c) = modules::probe_category('network/isdn')) { - $isdn->{$_} = $c->{$_} foreach qw(description vendor id driver options firmware); - $isdn->{$_} = sprintf("%0x", $isdn->{$_}) foreach 'vendor', 'id'; - $isdn->{card_type} = 'pci'; - ($isdn->{type}) = $isdn->{options} =~ /type=(\d+)/; -# $c->{options} !~ /id=HiSax/ && $isdn->{driver} eq "hisax" and $c->{options} .= " id=HiSax"; - if ($c->{options} !~ /protocol=/ && $isdn->{protocol} =~ /\d/) { - modules::set_options($c->{driver}, $c->{options} . " protocol=" . $isdn->{protocol}); - } - $c->{options} =~ /protocol=(\d)/ and $isdn->{protocol} = $1; - } -} - -sub isdn_get_list() { - map { $_->{description} } @isdndata; -} - -sub isdn_get_info { - my ($desc) = @_; - foreach (@isdndata) { - return $_ if $_->{description} eq $desc; - } -} - -1; diff --git a/perl-install/network/isdn_consts.pm b/perl-install/network/isdn_consts.pm deleted file mode 100644 index b6ce7e1e1..000000000 --- a/perl-install/network/isdn_consts.pm +++ /dev/null @@ -1,329 +0,0 @@ -package network::isdn_consts; # $Id$ -use vars qw(@ISA @EXPORT); -@ISA = qw(Exporter); -@EXPORT = qw(@isdndata); - -our @isdndata = - ( - { description => "Teles 16.0 (ISA)", #1 irq, mem, io - driver => 'hisax', - type => '1', - irq => '5', - mem => '0xd000', - io => '0xd80', - card => 'isa', - }, - { description => "Teles 8.0 (ISA)", #2 irq, mem - driver => 'hisax', - type => '2', - irq => '9', - mem => '0xd800', - card => 'isa', - }, - { description => "Teles 16.3 (ISA non PnP)", #3 irq, io - driver => 'hisax', - type => '3', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Teles 16.3c (ISA PnP)", #14 irq, io - driver => 'hisax', - type => '14', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Creatix/Teles (ISA PnP)", #4 irq, io0 (ISAC), io1 (HSCX) - driver => 'hisax', - type => '4', - irq => '5', - io0 => '0x0000', - io1 => '0x0000', - card => 'isa', - }, - { description => "Teles generic (PCI)", #21 no parameter - driver => 'hisax', - type => '21', - card => 'pci', - }, - { description => "Teles 16.3 (PCMCIA)", #8 irq, io - driver => 'hisax', - type => '8', - irq => '', - io => '0x', - card => 'isa', - }, - { description => "Teles S0Box", #25 irq, io (of the used lpt port) - driver => 'hisax', - type => '25', - irq => '7', - io => '0x378', - card => 'isa', - }, - { description => "ELSA PCC/PCF cards (ISA)", #6 io or nothing for autodetect (the io is required only if you have n>1 ELSA card) - driver => 'hisax', - type => '6', - io => "", - card => 'isa', - }, - { description => "ELSA Quickstep 1000 (ISA)", #7 irq, io (from isapnp setup) - driver => 'hisax', - type => '7', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "ELSA Quickstep 1000 (PCI)", #18 no parameter - driver => 'hisax', - type => '18', - card => 'pci', - }, - { description => "ELSA Quickstep 3000 (PCI)", #18 no parameter - driver => 'hisax', - type => '18', - card => 'pci', - }, - { description => "ELSA generic (PCMCIA)", #10 irq, io (set with card manager) - driver => 'hisax', - type => '10', - irq => '', - io => '0x', - card => 'isa', - }, - { description => "ELSA MicroLink (PCMCIA)", #10 irq, io (set with card manager) - driver => 'elsa_cs', - card => 'isa', - }, - { description => "ITK ix1-micro Rev.2 (ISA)", #9 irq, io - driver => 'hisax', - type => '9', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Eicon.Diehl Diva (ISA PnP)", #11 irq, io - driver => 'hisax', - type => '11', - irq => '9', - io => '0x180', - card => 'isa', - }, - { description => "Eicon.Diehl Diva 20 (PCI)", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "Eicon.Diehl Diva 20PRO (PCI)", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "Eicon.Diehl Diva 20_U (PCI)", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "Eicon.Diehl Diva 20PRO_U (PCI)", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "ASUS COM ISDNLink (ISA)", #12 irq, io (from isapnp setup) - driver => 'hisax', - type => '12', - irq => '5', - io => '0x200', - card => 'isa', - }, - { description => "ASUS COM ISDNLink (PCI)", - driver => 'hisax', - type => '35', - card => 'pci', - }, - { description => "DynaLink (PCI)", - driver => 'hisax', - type => '12', - card => 'pci', - }, - { description => "DynaLink IS64PH, ASUSCOM (PCI)", #36 - driver => 'hisax', - type => '36', - card => 'pci', - }, - { description => "HFC-2BS0 based cards (ISA)", #13 irq, io - driver => 'hisax', - type => '13', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "HFC 2BDS0 (PCI)", #35 none - driver => 'hisax', - type => '35', - card => 'pci', - }, - { description => "HFC 2BDS0 S+, SP (PCMCIA)", #37 irq,io (pcmcia must be set with cardmgr) - driver => 'hisax', - type => '37', - card => 'isa', - }, - { description => "Sedlbauer Speed Card (ISA)", #15 irq, io - driver => 'hisax', - type => '15', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Sedlbauer PC/104 (ISA)", #15 irq, io - driver => 'hisax', - type => '15', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Sedlbauer Speed Card (PCI)", #15 no parameter - driver => 'hisax', - type => '15', - card => 'pci', - }, - { description => "Sedlbauer Speed Star (PCMCIA)", #22 irq, io (set with card manager) - driver => 'sedlbauer_cs', - card => 'isa', - }, - { description => "Sedlbauer Speed Fax+ (ISA Pnp)", #28 irq, io (from isapnp setup) - driver => 'hisax', - type => '28', - irq => '9', - io => '0xd80', - card => 'isa', - firmware => '/usr/lib/isdn/ISAR.BIN', - }, - { description => "Sedlbauer Speed Fax+ (PCI)", #28 no parameter - driver => 'hisax', - type => '28', - card => 'pci', - firmware => '/usr/lib/isdn/ISAR.BIN', - }, - { description => "USR Sportster internal (ISA)", #16 irq, io - driver => 'hisax', - type => '16', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "MIC card (ISA)", #17 irq, io - driver => 'hisax', - type => '17', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Compaq ISDN S0 card (ISA)", #19 irq, io0, io1, io (from isapnp setup io=IO2) - driver => 'hisax', - type => '19', - irq => '5', - io => '0x0000', - io0 => '0x0000', - io1 => '0x0000', - card => 'isa', - }, - { description => "NETjet card (PCI)", #20 no parameter - driver => 'hisax', - type => '20', - card => 'pci', - }, - { description => "Dr. Neuhaus Niccy (ISA PnP)", #24 irq, io0, io1 (from isapnp setup) - driver => 'hisax', - type => '24', - irq => '5', - io0 => '0x0000', - io1 => '0x0000', - card => 'isa', - }, - { description => "Dr. Neuhaus Niccy (PCI)", ##24 no parameter - driver => 'hisax', - type => '24', - card => 'pci', - }, - { description => "AVM A1 (Fritz) (ISA non PnP)", #5 irq, io - driver => 'hisax', - type => '5', - irq => '10', - io => '0x300', - card => 'isa', - }, - { description => "AVM (ISA Pnp)", #27 irq, io (from isapnp setup) - driver => 'hisax', - type => '27', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "AVM A1 (Fritz) (PCMCIA)", #26 irq, io (set with card manager) - driver => 'hisax', - type => '26', - irq => '', - card => 'isa', - }, - { description => "AVM PCI (Fritz!) (PCI)", #27 no parameter - driver => 'hisax', - type => '27', - card => 'pci', - }, - { description => "AVM B1 (PCI)", - driver => 'b1pci', - card => 'pci', - }, - { description => "Siemens I-Surf 1.0 (ISA Pnp)", #29 irq, io, memory (from isapnp setup) - driver => 'hisax', - type => '29', - irq => '9', - io => '0xd80', - mem => '0xd000', - card => 'isa', - }, - { description => "ACER P10 (ISA Pnp)", #30 irq, io (from isapnp setup) - driver => 'hisax', - type => '30', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "HST Saphir (ISA Pnp)", #31 irq, io - driver => 'hisax', - type => '31', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "Telekom A4T (PCI)", #32 none - driver => 'hisax', - type => '32', - card => 'pci', - }, - { description => "Scitel Quadro (PCI)", #33 subcontroller (4*S0, subctrl 1...4) - driver => 'hisax', - type => '33', - card => 'pci', - }, - { description => "Gazel ISDN cards (ISA)", #34 irq,io - driver => 'hisax', - type => '34', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "Gazel ISDN cards (PCI)", #34 none - driver => 'hisax', - type => '34', - card => 'pci', - }, - { description => "W6692 and Winbond based cards (PCI)", #36 none - driver => 'hisax', - type => '36', - card => 'pci', - }, - ); - -1; diff --git a/perl-install/network/modem.pm b/perl-install/network/modem.pm deleted file mode 100644 index a291e6dcf..000000000 --- a/perl-install/network/modem.pm +++ /dev/null @@ -1,276 +0,0 @@ -package network::modem; # $Id$ - -use strict; -use common; -use any; -use modules; -use detect_devices; -use mouse; -use network::tools; - -sub configure { - my ($in, $netcnx, $mouse, $netc) = @_; - $netcnx->{type} = 'modem'; - my $modem = $netcnx->{$netcnx->{type}}; - $modem->{device} = $netc->{autodetect}{modem}; - - foreach (cat_("/usr/share/config/kppprc")) { - /^DNS=(.*)$/ and ($modem->{dns1}, $modem->{dns2}) = split(',', $1); - } - foreach (cat_("/etc/sysconfig/network-scripts/chat-ppp0")) { - /.*ATDT(\d*)/ and $modem->{phone} = $1; - } - foreach (cat_("/etc/sysconfig/network-scripts/ifcfg-ppp0")) { - /NAME=(['"]?)(.*)\1/ and $modem->{login} = $2; - } - my $secret = network::tools::read_secret_backend(); - foreach (@$secret) { - $modem->{passwd} = $_->{passwd} if $_->{login} eq $modem->{login}; - } - - ppp_choose($in, $netc, $modem, $mouse) or return; - write_cnx_script($netc, "modem", - q( -/sbin/route del default -ifup ppp0 -), - q(ifdown ppp0 -killall pppd -), $netcnx->{type}); - 1; -} - -#-----modem conf -sub ppp_configure { - my ($in, $modem) = @_; - $modem or return; - $in->do_pkgs->install('ppp') if !$::testing; - $in->do_pkgs->install('kdenetwork-kppp') if $in->do_pkgs->is_installed('kdebase'); - ppp_configure_raw($modem); -} - -sub ppp_configure_raw { - my ($modem) = @_; - any::devfssymlinkf($modem, 'modem') if $modem->{device} ne "/dev/modem"; - - my %toreplace; - $toreplace{$_} = $modem->{$_} foreach qw(connection phone login passwd auth domain dns1 dns2); - $toreplace{kpppauth} = ${{ 'Script-based' => 0, 'PAP' => 1, 'Terminal-based' => 2, }}{$modem->{auth}}; - $toreplace{kpppauth} = ${{ 'Script-based' => 0, 'PAP' => 1, 'Terminal-based' => 2, 'CHAP' => 3 }}{$modem->{auth}}; - $toreplace{phone} =~ s/[a-zA-Z]//g; - $toreplace{dnsserver} = join ',', map { $modem->{$_} } "dns1", "dns2"; - $toreplace{dnsserver} .= $toreplace{dnsserver} && ','; - - #- using peerdns or dns1,dns2 avoid writing a /etc/resolv.conf file. - $toreplace{peerdns} = "yes"; - - $toreplace{connection} ||= 'DialupConnection'; - $toreplace{domain} ||= 'localdomain'; - $toreplace{intf} ||= 'ppp0'; - $toreplace{papname} = ($modem->{auth} eq 'PAP' || $modem->{auth} eq 'CHAP') && $toreplace{login}; - - #- build ifcfg-ppp0. - my $various = <<END; -DEVICE="$toreplace{intf}" -ONBOOT="no" -USERCTL="no" -MODEMPORT="/dev/modem" -LINESPEED="115200" -PERSIST="yes" -DEFABORT="yes" -DEBUG="yes" -INITSTRING="ATZ" -DEFROUTE="yes" -HARDFLOWCTL="yes" -ESCAPECHARS="no" -PPPOPTIONS="" -PAPNAME="$toreplace{papname}" -REMIP="" -NETMASK="" -IPADDR="" -MRU="" -MTU="" -DISCONNECTTIMEOUT="5" -RETRYTIMEOUT="60" -BOOTPROTO="none" -PEERDNS="$toreplace{peerdns}" -END - output("$::prefix/etc/sysconfig/network-scripts/ifcfg-ppp0", - $various, - map { qq(DNS$_=$toreplace{"dns$_"}\n) } grep { $toreplace{"dns$_"} } 1..2); - - #- build chat-ppp0. - my @chat = <<END; -'ABORT' 'BUSY' -'ABORT' 'ERROR' -'ABORT' 'NO CARRIER' -'ABORT' 'NO DIALTONE' -'ABORT' 'Invalid Login' -'ABORT' 'Login incorrect' -'' 'ATZ' -END - if ($modem->{special_command}) { - push @chat, <<END; -'OK' '$modem->{special_command}' -END - } - push @chat, <<END; -'OK' 'ATDT$toreplace{phone}' -'CONNECT' '' -END - if ($modem->{auth} eq 'Terminal-based' || $modem->{auth} eq 'Script-based') { - push @chat, <<END; -'ogin:--ogin:' '$toreplace{login}' -'ord:' '$toreplace{passwd}' -END - } - push @chat, <<END; -'TIMEOUT' '5' -'~--' '' -END - my $chat_file = "$::prefix/etc/sysconfig/network-scripts/chat-ppp0"; - output_with_perm($chat_file, 0600, @chat); - - if ($modem->{auth} eq 'PAP' || $modem->{auth} eq 'CHAP') { - #- need to create a secrets file for the connection. - my $secrets = "$::prefix/etc/ppp/" . lc($modem->{auth}) . "-secrets"; - my @l = cat_($secrets); - my $replaced = 0; - do { $replaced ||= 1 - if s/^\s*"?$toreplace{login}"?\s+ppp0\s+(\S+)/"$toreplace{login}" ppp0 "$toreplace{passwd}"/ } foreach @l; - if ($replaced) { - output($secrets, @l); - } else { - append_to_file($secrets, "$toreplace{login} ppp0 \"$toreplace{passwd}\"\n"); - } - #- restore access right to secrets file, just in case. - chmod 0600, $secrets; - } - - #- install kppprc file according to used configuration. - mkdir_p("$::prefix/usr/share/config"); - - output("$::prefix/usr/share/config/kppprc", c::to_utf8(<<END)); -# KDE Config File -[Account0] -ExDNSDisabled=0 -AutoName=0 -ScriptArguments= -AccountingEnabled=0 -DialString=ATDT -Phonenumber=$toreplace{phone} -IPAddr=0.0.0.0 -Domain=$toreplace{domain} -Name=$toreplace{connection} -VolumeAccountingEnabled=0 -pppdArguments= -Password=$toreplace{passwd} -BeforeDisconnect= -Command= -ScriptCommands= -Authentication=$toreplace{kpppauth} -DNS=$toreplace{dnsserver} -SubnetMask=0.0.0.0 -AccountingFile= -DefaultRoute=1 -Username=$toreplace{login} -Gateway=0.0.0.0 -StorePassword=1 -DisconnectCommand= -[Modem] -BusyWait=0 -Enter=CR -FlowControl=CRTSCTS -Volume=0 -Timeout=60 -UseCDLine=0 -UseLockFile=1 -Device=/dev/modem -Speed=115200 -[Graph] -InBytes=0,0,255 -Text=0,0,0 -Background=255,255,255 -Enabled=true -OutBytes=255,0,0 -[General] -QuitOnDisconnect=0 -ShowLogWindow=0 -DisconnectOnXServerExit=1 -DefaultAccount=$toreplace{connection} -iconifyOnConnect=1 -Hint_QuickHelp=0 -AutomaticRedial=0 -PPPDebug=0 -NumberOfAccounts=1 -ShowClock=1 -DockIntoPanel=0 -pppdTimeout=30 -END - network::network::proxy_configure($::o->{miscellaneous}); -} - -sub ppp_choose { - my ($in, $netc, $modem, $o_mouse) = @_; - $o_mouse ||= {}; - - $o_mouse->{device} ||= readlink "$::prefix/dev/mouse"; - my $need_to_ask = $modem->{device}; - step_1: - $need_to_ask and $modem->{device} = $in->ask_from_listf_raw({ messsages => N("Please choose which serial port your modem is connected to."), - interactive_help_id => 'selectSerialPort', - }, - \&mouse::serial_port2text, - [ grep { $_ ne $o_mouse->{device} } (if_(-e '/dev/modem', '/dev/modem'), mouse::serial_ports()) ]) || return; - - #my $secret = network::tools::read_secret_backend(); - #my @cnx_list = map { $_->{server} } @$secret; - $in->ask_from('', N("Dialup options"), [ - { label => N("Connection name"), val => \$modem->{connection} }, - { label => N("Phone number"), val => \$modem->{phone} }, - { label => N("Login ID"), val => \$modem->{login} }, - { label => N("Password"), val => \$modem->{passwd}, hidden => 1 }, - { label => N("Authentication"), val => \$modem->{auth}, list => [ N_("PAP"), N_("Terminal-based"), N_("Script-based"), N_("CHAP") ] }, - { label => N("Domain name"), val => \$modem->{domain} }, - { label => N("First DNS Server (optional)"), val => \$modem->{dns1} }, - { label => N("Second DNS Server (optional)"), val => \$modem->{dns2} }, - ]) or do { if ($need_to_ask) { goto step_1 } else { return } }; - $netc->{DOMAINNAME2} = $modem->{domain}; - ppp_configure($in, $modem); - $netc->{$_} = 'ppp0' foreach 'NET_DEVICE', 'NET_INTERFACE'; - 1; -} - -sub winmodemConfigure { - my ($in, $netcnx, $mouse, $netc) = @_; - my %relocations = (ltmodem => $in->do_pkgs->check_kernel_module_packages('ltmodem')); - my $type; - - $netc->{autodetect}{winmodem} or ($in->ask_warn(N("Warning"), N("You don't have any winmodem")) ? return 0 : $in->exit(0)); - - foreach (keys %{$netc->{autodetect}{winmodem}}) { - /Hcf/ and $type = "hcfpcimodem"; - /Hsf/ and $type = "hsflinmodem"; - /LT/ and $type = "ltmodem"; - $relocations{$type} || $type && $in->do_pkgs->what_provides($type) or $type = undef; - } - - $type or ($in->ask_warn(N("Warning"), N("Your modem isn't supported by the system. -Take a look at http://www.linmodems.org")) ? return 0 : $in->exit(0)); - my $e = $in->ask_from_list(N("Title"), N("\"%s\" based winmodem detected, do you want to install needed software ?", $type), [N("Install rpm"), N("Do nothing")]) or return 0; - if ($e =~ /rpm/) { - if ($in->do_pkgs->install($relocations{$type} ? @{$relocations{$type}} : $type)) { - unless ($::isInstall) { - #- fallback to modem configuration (beware to never allow test it). - $netcnx->{type} = 'modem'; - #$type eq 'ltmodem' and $netc->{autodetect}{modem} = '/dev/ttyS14'; - return configure($in, $netcnx, $mouse, $netc); - } - } else { - return 0; - } - } - return 1; -} - -1; diff --git a/perl-install/network/netconnect.pm b/perl-install/network/netconnect.pm deleted file mode 100644 index e154db1fe..000000000 --- a/perl-install/network/netconnect.pm +++ /dev/null @@ -1,370 +0,0 @@ -package network::netconnect; # $Id$ - -use strict; -use common; -use log; -use detect_devices; -use run_program; -use modules; -use any; -use mouse; -use network; -use network::tools; -use MDK::Common::Globals "network", qw($in $prefix $connect_file $disconnect_file $connect_prog); - -my %conf; - -sub detect { - my ($auto_detect, $net_install) = @_; - my $isdn = {}; - require network::isdn; - network::isdn->import; - isdn_detect_backend($isdn); - $auto_detect->{isdn}{$_} = $isdn->{$_} foreach qw(description vendor id driver card_type type); - $auto_detect->{isdn}{description} =~ s/.*\|//; - - modules::load_category('network/main|gigabit|usb'); - require network::ethernet; - network::ethernet->import; - my @all_cards = conf_network_card_backend(); - map { $auto_detect->{lan}{$_->[0]} = $_->[1] } @all_cards if !$net_install; - - my $adsl = {}; - require network::adsl; - network::adsl->import; - $auto_detect->{adsl} = adsl_detect($adsl); - - require network::modem; - network::modem->import; - my ($modem, @pci_modems) = detect_devices::getModem(); - $modem->{device} and $auto_detect->{modem} = $modem->{device}; - @pci_modems and $auto_detect->{winmodem}{$_->{driver}} = $_->{description} foreach @pci_modems; -} - -sub init_globals { - my ($in, $prefix) = @_; - MDK::Common::Globals::init( - in => $in, - prefix => $prefix, - connect_file => "/etc/sysconfig/network-scripts/net_cnx_up", - disconnect_file => "/etc/sysconfig/network-scripts/net_cnx_down", - connect_prog => "/etc/sysconfig/network-scripts/net_cnx_pg"); -} - -sub main { - my ($prefix, $netcnx, $in, $o_netc, $o_mouse, $o_intf, $o_first_time, $o_noauto) = @_; - my $netc = $o_netc || {}; - my $mouse = $o_mouse || {}; - my $intf = $o_intf || {}; - my $first_time = $o_first_time || 0; - - init_globals($in, $prefix); - $netc->{minus_one} = 0; #When one configure an eth in dhcp without gateway - $::isStandalone and read_net_conf($prefix, $netcnx, $netc); - $netc->{NET_DEVICE} = $netcnx->{NET_DEVICE} if $netcnx->{NET_DEVICE}; # REDONDANCE with read_conf. FIXME - $netc->{NET_INTERFACE} = $netcnx->{NET_INTERFACE} if $netcnx->{NET_INTERFACE}; # REDONDANCE with read_conf. FIXME - network::network::read_all_conf($prefix, $netc, $intf); - - modules::mergein_conf("$prefix/etc/modules.conf"); - - my $direct_net_install; - if ($first_time && $::isInstall && ($in->{method} eq "ftp" || $in->{method} eq "http" || $in->{method} eq "nfs")) { - !$::expert && !$o_noauto || $in->ask_okcancel(N("Network Configuration"), - N("Because you are doing a network installation, your network is already configured. -Click on Ok to keep your configuration, or cancel to reconfigure your Internet & Network connection. -"), 1) and do { - $netcnx->{type} = 'lan'; - output_with_perm("$prefix$connect_file", 0755, - qq( -ifup eth0 -)); - output("$prefix$disconnect_file", 0755, - qq( -ifdown eth0 -)); - $direct_net_install = 1; - goto step_5; -}; - } - - $netc->{autodetection} = 1; - $netc->{autodetect} = {}; - - step_1: - $::Wizard_no_previous = 1; - my @profiles = get_profiles(); - eval { $in->ask_from_({ title => N("Network Configuration Wizard"), - messages => N("Welcome to The Network Configuration Wizard. - -We are about to configure your internet/network connection. -If you don't want to use the auto detection, deselect the checkbox. -"), - interactive_help_id => 'configureNetwork', - }, - [ - if_(@profiles > 1, { label => N("Choose the profile to configure"), val => \$netcnx->{PROFILE}, list => \@profiles }), - { text => N("Use auto detection"), val => \$netc->{autodetection}, type => 'bool' }, - { text => N("Expert Mode"), val => \$::expert, type => 'bool' }, - ] - ) or goto step_5 }; $in->exit(0) if $@ =~ /wizcancel/; - undef $::Wizard_no_previous; - set_profile($netcnx); - if ($netc->{autodetection}) { - my $_w = $in->wait_message(N("Network Configuration Wizard"), N("Detecting devices...")); - detect($netc->{autodetect}, $::isInstall && ($in->{method} eq "ftp" || $in->{method} eq "http" || $in->{method} eq "nfs")); - } - - my %net_conf_callbacks = (adsl => sub { require network::adsl; network::adsl::configure($netcnx, $netc, $intf, $first_time) }, - cable => sub { require network::ethernet; network::ethernet::configure_cable($netcnx, $netc, $intf, $first_time) }, - isdn => sub { require network::isdn; network::isdn::configure($netcnx, $netc, undef) }, - lan => sub { require network::ethernet; network::ethernet::configure_lan($netcnx, $netc, $intf, $first_time) }, - modem => sub { require network::modem; network::modem::configure($in, $netcnx, $mouse, $netc) }, - winmodem => sub { require network::modem; network::modem::winmodemConfigure($in, $netcnx, $mouse, $netc) }, - ); - - - $conf{$_} = $netc->{autodetect}{$_} ? 1 : 0 foreach 'modem', 'winmodem', 'adsl', 'cable', 'lan'; - $conf{isdn} = $netc->{autodetect}{isdn}{driver} ? 1 : 0; - step_2: - - my @l = ( - [ join('', N("Normal modem connection"), if_($netc->{autodetect}{modem}, " - " . N("detected on port %s", $netc->{autodetect}{modem}))), \$conf{modem} ], - [ join('', N("Winmodem connection"), if_($netc->{autodetect}{winmodem}, " - " . N("detected"))), \$conf{winmodem} ], - [ join('', N("ISDN connection"), if_($netc->{autodetect}{isdn}{description}, " - " . N("detected %s", $netc->{autodetect}{isdn}{description}))), \$conf{isdn} ], - [ join('', N("ADSL connection"), if_($netc->{autodetect}{adsl}, " - " . N("detected"))), \$conf{adsl} ], - [ join('', N("Cable connection"), if_($netc->{autodetect}{cable}, " - " . N("cable connection detected"))), \$conf{cable} ], - [ join('', N("LAN connection"), if_($netc->{autodetect}{lan}, " - " . N("ethernet card(s) detected"))), \$conf{lan} ] - ); - eval { $in->ask_from_({ title => N("Network Configuration Wizard"), - messages => N("Choose the connection you want to configure"), - interactive_help_id => 'configureNetwork', - }, - [ map { { text => $_->[0], val => $_->[1], type => 'bool' } } @l ], - changed => sub { - return if !$netc->{autodetection}; - my $c = 0; - #- $conf{adsl} and $c++; - $conf{cable} and $c++; - my $a = keys(%{$netc->{autodetect}{lan}}); - 0 < $a && $a <= $c and $conf{lan} = undef; - } - ) or goto step_1; - load_conf($netcnx, $netc, $intf); - foreach my $type (qw(modem winmodem isdn adsl cable lan)) { - $conf{$type} and do { - #-PO here, "forward" is the standard gtk+ button for "next"; check what is displayed in your language - $in->ask_okcancel(N("Network Configuration Wizard"), N("We are now going to configure the %s connection.\n\n\nPress \"%s\" to continue.", translate($type), N("Next")), 1) or goto step_2; - &{$net_conf_callbacks{$type}} or goto step_2; - $netconnect::need_restart_network = 1 if $type =~ /lan|cable/; - } - } - }; - $in->exit(0) if $@ =~ /wizcancel/; - - step_2_1: - my $nb = keys %{$netc->{internet_cnx}}; - - if ($nb > 1) { - # BUG: remember to remove reference to profiles in mcc if we do not restore this feature - eval { $in->ask_from(N("Network Configuration Wizard"), - N("You have configured multiple ways to connect to the Internet.\nChoose the one you want to use.\n\n") . if_(!$::isStandalone, "You may want to configure some profiles after the installation, in the Mandrake Control Center"), - [ { label => N("Internet connection"), val => \$netc->{internet_cnx_choice}, list => [ keys %{$netc->{internet_cnx}} ] } ] - ) or goto step_2 }; $in->exit(0) if $@ =~ /wizcancel/; - } elsif ($nb == 1) { - $netc->{internet_cnx_choice} = (keys %{$netc->{internet_cnx}})[0]; - } - - eval { $in->ask_yesorno(N("Network configuration"), N("Configuration is complete, do you want to apply settings ?"), 1) or goto step_2_2 }; - $in->exit(0) if $@ =~ /wizcancel/; - - member($netc->{internet_cnx_choice}, ('adsl', 'isdn')) and $netc->{at_boot} = $in->ask_yesorno(N("Network Configuration Wizard"), N("Do you want to start the connection at boot?")); - - if ($netc->{internet_cnx_choice}) { - write_cnx_script($netc); - $netcnx->{type} = $netc->{internet_cnx}{$netc->{internet_cnx_choice}}{type}; - } else { - unlink "$prefix/etc/sysconfig/network-scripts/net_cnx_up"; - unlink "$prefix/etc/sysconfig/network-scripts/net_cnx_down"; - undef $netc->{NET_DEVICE}; - } - - my $success = 1; - network::configureNetwork2($in, $prefix, $netc, $intf); - my $network_configured = 1; - - step_2_2: - eval { if ($netconnect::need_restart_network && $::isStandalone && (!$::expert || $in->ask_yesorno(N("Network configuration"), - N("The network needs to be restarted. Do you want to restart it ?"), 1))) { - if (!run_program::rooted($prefix, "/etc/rc.d/init.d/network restart")) { - $success = 0; - $in->ask_okcancel(N("Network Configuration"), - N("A problem occured while restarting the network: \n\n%s", `/etc/rc.d/init.d/network restart`), 0); - } - } - }; $in->exit(0) if $@ =~ /wizcancel/; - - write_initscript(); - $::isStandalone && member($netc->{internet_cnx_choice}, ('modem', 'adsl', 'isdn')) and - $success = ask_connect_now($netc->{internet_cnx_choice}); - - step_3: - my $m = $success ? join('', N("Congratulations, the network and Internet configuration is finished. - -"), if_($::isStandalone && $in->isa('interactive::gtk'), -N("After this is done, we recommend that you restart your X environment to avoid any hostname-related problems."))) : - N("Problems occured during configuration. -Test your connection via net_monitor or mcc. If your connection doesn't work, you might want to relaunch the configuration."); - $::Wizard_no_previous = 1; - $::Wizard_finished = 1; - eval { $in->ask_okcancel(N("Network Configuration"), $m, 1) }; $in->exit(0) if $@ =~ /wizcancel/; - undef $::Wizard_no_previous; - undef $::Wizard_finished; - - step_5: - $network_configured or network::configureNetwork2($in, $prefix, $netc, $intf); - - my $connect_cmd; - if ($netcnx->{type} =~ /modem/ || $netcnx->{type} =~ /isdn_external/) { - $connect_cmd = qq( -#!/bin/bash -if [ -n "\$DISPLAY" ]; then -if [ -e /usr/bin/kppp ]; then -/sbin/route del default -/usr/bin/kppp & -else -/usr/sbin/net_monitor --connect -fi -else -$connect_file -fi -); - } elsif ($netcnx->{type}) { - $connect_cmd = qq( -#!/bin/bash -if [ -n "\$DISPLAY" ]; then -/usr/sbin/net_monitor --connect -else -$connect_file -fi -); - } else { - $connect_cmd = qq( -#!/bin/bash -/usr/sbin/drakconnect -); - } - if ($direct_net_install) { - $connect_cmd = qq( -#!/bin/bash -if [ -n "\$DISPLAY" ]; then -/usr/sbin/net_monitor --connect -else -$connect_file -fi -); - } - output_with_perm("$prefix$connect_prog", 0755, $connect_cmd) if $connect_cmd; - $netcnx->{$_} = $netc->{$_} foreach qw(NET_DEVICE NET_INTERFACE); - $netcnx->{type} =~ /adsl/ or system("/sbin/chkconfig --del adsl 2> /dev/null"); - save_conf($netcnx); - - if ($::isInstall && $::o->{security} >= 3) { - require network::drakfirewall; - network::drakfirewall::main($in, $::o->{security} <= 3); - } -} - -sub save_conf { - my ($netcnx) = @_; - my $string = "# Connection type reminder -type=$netcnx->{type} -"; - output_with_perm("$prefix/etc/sysconfig/drakconnect", 0600, $string); -} - -sub set_profile { - my ($netcnx, $profile) = @_; - $netcnx->{PROFILE} = $profile; - system("/sbin/set-netprofile $netcnx->{PROFILE}"); - -} - -sub del_profile { - my ($_netcnx, $profile) = @_; - return if !$profile || $profile eq "default"; - rm_rf("$::prefix/etc/netprofile/profiles/$profile"); -} - -sub add_profile { - my ($netcnx, $profile) = @_; - return if !$profile || $profile eq "default" || member($profile, get_profiles()); - system("/sbin/clone-netprofile $netcnx->{PROFILE} $profile"); -} - -sub get_profiles() { - map { if_(m!([^/]*)/$!, $1) } glob("$::prefix/etc/netprofile/profiles/*/"); -} - -sub load_conf { - my ($netcnx, $netc, $intf) = @_; - my $type = { getVarsFromSh("$prefix/etc/sysconfig/drakconnect") }; - - $type->{type} and $netcnx->{type} = $type->{type}; - network::read_all_conf($prefix, $netc, $intf); -} - -sub get_net_device() { - my $connect_file = "/etc/sysconfig/network-scripts/net_cnx_up"; - my $network_file = "/etc/sysconfig/network"; - if (cat_("$prefix$connect_file") =~ /network/) { - ${{ getVarsFromSh("$prefix$network_file") }}{GATEWAYDEV}; - } elsif (cat_("$prefix$connect_file") =~ /isdn/) { - "ippp+"; - } else { - "ppp+"; - }; -} - -sub read_net_conf { - my ($_prefix, $netcnx, $netc) = @_; - $netc->{$_} = $netcnx->{$_} foreach 'NET_DEVICE', 'NET_INTERFACE'; - $netcnx->{$netcnx->{type}} ||= {}; -} - -sub start_internet { - my ($o) = @_; - init_globals($o, $o->{prefix}); - run_program::rooted($prefix, $connect_file); -} - -sub stop_internet { - my ($o) = @_; - init_globals($o, $o->{prefix}); - run_program::rooted($prefix, $disconnect_file); -} - -my @connection_types = (N_("modem"), N_(" isdn"), N_(" adsl"), N_(" cable"), N_(" local network")); - -#--------------------------------------------- -# WONDERFULL pad -#--------------------------------------------- -1; - -=head1 network::netconnect::detect() - -=head2 example of usage - -use lib qw(/usr/lib/libDrakX); -use network::netconnect; -use Data::Dumper; - -use class_discard; - -local $in = class_discard->new; - -network::netconnect::init_globals($in); -my %i; -&network::netconnect::detect(\%i); -print Dumper(\%i),"\n"; - -=cut diff --git a/perl-install/network/network.pm b/perl-install/network/network.pm deleted file mode 100644 index 2b1f5c944..000000000 --- a/perl-install/network/network.pm +++ /dev/null @@ -1,568 +0,0 @@ -package network::network; # $Id$wir - -#-###################################################################################### -#- misc imports -#-###################################################################################### - -use strict; - -use Socket; -use common; -use detect_devices; -use run_program; -use any; -use vars qw(@ISA @EXPORT); -use log; - -@ISA = qw(Exporter); -@EXPORT = qw(resolv configureNetworkIntf netmask dns is_ip masked_ip findIntf addDefaultRoute read_all_conf dnsServers guessHostname configureNetworkNet read_resolv_conf read_interface_conf add2hosts gateway configureNetwork2 write_conf sethostname down_it read_conf write_resolv_conf up_it); - -#-###################################################################################### -#- Functions -#-###################################################################################### -sub read_conf { - my ($file) = @_; - +{ getVarsFromSh($file) }; -} - - -sub read_resolv_conf_raw { - my ($file) = @_; - $file ||= "$::prefix/etc/resolv.conf"; - { nameserver => [ cat_($file) =~ /^\s*nameserver\s+(\S+)/mg ], - search => [ if_(cat_($file) =~ /^\s*search\s+(.*)/m, split(' ', $1)) ] }; -} - -sub read_resolv_conf { - my ($file) = @_; - my $resolv_conf = read_resolv_conf_raw($file); - +{ - (mapn { $_[0] => $_[1] } [ qw(dnsServer dnsServer2 dnsServer3) ], $resolv_conf->{nameserver}), - (mapn { $_[0] => $_[1] } [ qw(DOMAINNAME DOMAINNAME2 DOMAINNAME3) ], $resolv_conf->{search}), - }; -} - -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 read_dhcpd_conf { - my ($file) = @_; - $file ||= "$::prefix/etc/dhcpd.conf"; - { option_routers => [ cat_($file) =~ /^\s*option routers\s+(\S+);/mg ], - subnet_mask => [ if_(cat_($file) =~ /^\s*option subnet-mask\s+(.*);/mg, split(' ', $1)) ], - domain_name => [ if_(cat_($file) =~ /^\s*option domain-name\s+\"(.*)\";/mg, split(' ', $1)) ], - domain_name_servers => [ if_(cat_($file) =~ /^\s*option domain-name-servers\s+(.*);/m, split(' ', $1)) ], - dynamic_bootp => [ if_(cat_($file) =~ /^\s*range dynamic-bootp\s+\S+\.(\d+)\s+\S+\.(\d+)\s*;/m, split(' ', $1)) ], - default_lease_time => [ if_(cat_($file) =~ /^\s*default-lease-time\s+(.*);/m, split(' ', $1)) ], - max_lease_time => [ if_(cat_($file) =~ /^\s*max-lease-time\s+(.*);/m, split(' ', $1)) ] }; -} - -sub read_tmdns_conf { - my ($file) = @_; - local *F; open F, $file or die "cannot open file $file: $!"; - local $_; - my %outf; - - while (<F>) { - ($outf{ZEROCONF_HOSTNAME}) = /^\s*hostname\s*=\s*(\w+)/ and return \%outf; - } - - \%outf; -} - -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) = @_; - - if ($netc->{HOSTNAME} && $netc->{HOSTNAME} =~ /\.(.+)$/) { - $netc->{DOMAINNAME} = $1; - } - $netc->{NETWORKING} = 'yes'; - - setVarsInSh($file, $netc, qw(HOSTNAME NETWORKING GATEWAY GATEWAYDEV NISDOMAIN)); -} - -sub write_zeroconf { - my ($file, $zhostname) = @_; - eval { substInFile { s/^\s*(hostname)\s*=.*/$1 = $zhostname/ } $file }; -} - -sub write_resolv_conf { - my ($file, $netc) = @_; - - my %new = ( - search => [ grep { $_ } uniq(@$netc{'DOMAINNAME', 'DOMAINNAME2', 'DOMAINNAME3'}) ], - nameserver => [ grep { $_ } uniq(@$netc{'dnsServer', 'dnsServer2', 'dnsServer3'}) ], - ); - - my (%prev, @unknown); - foreach (cat_($file)) { - s/\s+$//; - s/^[#\s]*//; - - if (my ($key, $val) = /^(search|nameserver)\s+(.*)$/) { - push @{$prev{$key}}, $val; - } elsif (/^ppp temp entry$/) { - } elsif (/\S/) { - push @unknown, $_; - } - } - unlink $file; #- workaround situation when /etc/resolv.conf is an absolute link to /etc/ppp/resolv.conf or whatever - - if (@{$new{search}} || @{$new{nameserver}}) { - $prev{$_} = [ difference2($prev{$_} || [], $new{$_}) ] foreach keys %new; - - my @search = do { - my @new = if_(@{$new{search}}, "search " . join(' ', @{$new{search}}) . "\n"); - my @old = if_(@{$prev{search}}, "# search " . join(' ', @{$prev{search}}) . "\n"); - @new, @old; - }; - my @nameserver = do { - my @new = map { "nameserver $_\n" } @{$new{nameserver}}; - my @old = map { "# nameserver $_\n" } @{$prev{nameserver}}; - @new, @old; - }; - output_with_perm($file, 0644, @search, @nameserver, (map { "# $_\n" } @unknown), "\n# ppp temp entry\n"); - - #-res_init(); # reinit the resolver so DNS changes take affect - 1; - } else { - log::l("neither domain name nor dns server are configured"); - 0; - } -} - -sub write_interface_conf { - my ($file, $intf, $_netc, $prefix) = @_; - - if ($intf->{HWADDR} && -e "$prefix/sbin/ip") { - $intf->{HWADDR} = undef; - if (my $s = `LC_ALL= LANG= $prefix/sbin/ip -o link show $intf->{DEVICE} 2>/dev/null`) { - if ($s =~ m|.*link/ether\s([0-9a-z:]+)\s|) { - $intf->{HWADDR} = $1; - } - } - } - 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::pcmcia_probe())), - }); - - $intf->{BOOTPROTO} =~ s/dhcp.*/dhcp/; - - setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT HWADDR MII_NOT_SUPPORTED), if_($intf->{wireless_eth}, qw(WIRELESS_MODE WIRELESS_ESSID WIRELESS_NWID WIRELESS_FREQ WIRELESS_SENS WIRELESS_RATE WIRELESS_ENC_KEY WIRELESS_RTS WIRELESS_FRAG WIRELESS_IWCONFIG WIRELESS_IWSPY WIRELESS_IWPRIV)), if_($intf->{BOOTPROTO} eq "dhcp", qw(DHCP_HOSTNAME NEEDHOSTNAME))); -} - -sub add2hosts { - my ($file, $hostname, @ips) = @_; - - my %l = map { if_(/\s*(\S+)(.*)/, $1 => $2) } - grep { !/\s+\Q$hostname\E\s*$/ } cat_($file); - - my $sub_hostname = $hostname =~ /(.*?)\./ ? " $1" : ''; - $l{$_} = "\t\t$hostname$sub_hostname" foreach grep { $_ } @ips; - - log::l("writing host information to $file"); - output($file, map { "$_$l{$_}\n" } keys %l); -} - -# 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}), Socket::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; - $intf->{$device}; -} - -my $ip_regexp = qr/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/; - -sub is_ip { - my ($ip) = @_; - my @fields = $ip =~ $ip_regexp or return; - every { 0 <= $_ && $_ <= 255 } @fields or return; - @fields; -} - -sub ip_compare { - my ($ip1, $ip2) = @_; - my (@ip1_fields) = $ip1 =~ $ip_regexp; - my (@ip2_fields) = $ip2 =~ $ip_regexp; - - every { $ip1_fields[$_] eq $ip2_fields[$_] } (0 .. 3); -} - -sub is_ip_forbidden { - my ($ip) = @_; - my @forbidden = ('127.0.0.1', '255.255.255.255'); - - any { ip_compare($ip, $_) } @forbidden; -} - -sub is_domain_name { - my ($name) = @_; - my @fields = split /\./, $name; - $name !~ /\.$/ && @fields > 0 && @fields == grep { /^[[:alnum:]](?:[\-[:alnum:]]{0,61}[[:alnum:]])?$/ } @fields; -} - -sub netmask { - my ($ip) = @_; - return "255.255.255.0" unless is_ip($ip); - $ip =~ $ip_regexp or warn "IP_regexp failed\n" and return "255.255.255.0"; - if ($1 >= 1 && $1 < 127) { - "255.0.0.0"; #-1.0.0.0 to 127.0.0.0 - } elsif ($1 >= 128 && $1 <= 191) { - "255.255.0.0"; #-128.0.0.0 to 191.255.0.0 - } elsif ($1 >= 192 && $1 <= 223) { - "255.255.255.0"; - } else { - "255.255.255.255"; #-experimental classes - } -} - -sub masked_ip { - my ($ip) = @_; - my @ip = is_ip($ip) or return ''; - my @mask = netmask($ip) =~ $ip_regexp; - for (my $i = 0; $i < @ip; $i++) { - $ip[$i] &= int $mask[$i]; - } - join(".", @ip); -} - -sub dns { - my ($ip) = @_; - my @masked = masked_ip($ip) =~ $ip_regexp; - $masked[3] = 2; - join(".", @masked); - -} - -sub gateway { - my ($ip) = @_; - my @masked = masked_ip($ip) =~ $ip_regexp; - $masked[3] = 1; - join(".", @masked); - -} - -sub configureNetworkIntf { - my ($netc, $in, $intf, $net_device, $skip, $module) = @_; - my $text; - my @wireless_modules = qw(aironet_cs aironet4500_cs hermes airo orinoco_cs orinoco airo_cs netwave_cs ray_cs wavelan_cs wvlan_cs airport); - my $flag = 0; - foreach (@wireless_modules) { - $module =~ /$_/ and $flag = 1; - } - if ($flag) { - $intf->{wireless_eth} = 1; - $netc->{wireless_eth} = 1; - $intf->{WIRELESS_MODE} = "Managed"; - $intf->{WIRELESS_ESSID} = "any"; - } - if ($net_device eq $intf->{DEVICE}) { - $skip and return 1; - $text = N("WARNING: this device has been previously configured to connect to the Internet. -Simply accept to keep this device configured. -Modifying the fields below will override this configuration."); - } - else { - $text = N("Please enter the IP configuration for this machine. -Each item should be entered as an IP address in dotted-decimal -notation (for example, 1.2.3.4)."); - } - my $auto_ip = $intf->{BOOTPROTO} !~ /static/; - my $onboot = $intf->{ONBOOT} ? $intf->{ONBOOT} =~ /yes/ : bool2yesno(!member($intf->{DEVICE}, map { $_->{device} } detect_devices::pcmcia_probe())); - my $needhostname = $intf->{NEEDHOSTNAME} !~ /no/; - my $hotplug = $::isStandalone && !$intf->{MII_NOT_SUPPORTED} or 1; - my $track_network_id = $::isStandalone && $intf->{HWADDR} or detect_devices::isLaptop(); - delete $intf->{NETWORK}; - delete $intf->{BROADCAST}; - my @fields = qw(IPADDR NETMASK); - - $in->ask_from(N("Configuring network device %s", $intf->{DEVICE}), - (N("Configuring network device %s", $intf->{DEVICE}) . ($module ? N(" (driver %s)", $module) : '') . "\n\n") . - $text, - [ { label => N("Automatic IP"), val => \$auto_ip, type => "bool", text => N("(bootp/dhcp/zeroconf)") }, - { label => N("IP address"), val => \$intf->{IPADDR}, disabled => sub { $auto_ip } }, - { label => N("Netmask"), val => \$intf->{NETMASK}, disabled => sub { $auto_ip } }, - - { label => N("DHCP host name"), val => \$intf->{DHCP_HOSTNAME}, disabled => sub { ! ($auto_ip && $needhostname) }, advanced => 1 }, - { text => N("Track network card id (useful for laptops)"), val => \$track_network_id, type => "bool", advanced => 1 }, - { text => N("Network Hotplugging"), val => \$hotplug, type => "bool", advanced => 1 }, - { text => N("Assign host name from DHCP address"), val => \$needhostname, type => "bool", disabled => sub { ! $auto_ip }, advanced => 1 }, - { text => N("Start at boot"), val => \$onboot, type => "bool", advanced => 1 }, - if_($intf->{wireless_eth}, - { label => "WIRELESS_MODE", val => \$intf->{WIRELESS_MODE}, list => [ "Ad-hoc", "Managed", "Master", "Repeater", "Secondary", "Auto" ] }, - { label => "WIRELESS_ESSID", val => \$intf->{WIRELESS_ESSID} }, - { label => "WIRELESS_NWID", val => \$intf->{WIRELESS_NWID} }, - { label => "WIRELESS_FREQ", val => \$intf->{WIRELESS_FREQ} }, - { label => "WIRELESS_SENS", val => \$intf->{WIRELESS_SENS} }, - { label => "WIRELESS_RATE", val => \$intf->{WIRELESS_RATE} }, - { label => "WIRELESS_ENC_KEY", val => \$intf->{WIRELESS_ENC_KEY} }, - { label => "WIRELESS_RTS", val => \$intf->{WIRELESS_RTS} }, - { label => "WIRELESS_FRAG", val => \$intf->{WIRELESS_FRAG} }, - { label => "WIRELESS_IWCONFIG", val => \$intf->{WIRELESS_IWCONFIG} }, - { label => "WIRELESS_IWSPY", val => \$intf->{WIRELESS_IWSPY} }, - { label => "WIRELESS_IWPRIV", val => \$intf->{WIRELESS_IWPRIV} } - ), - ], - complete => sub { - - $intf->{BOOTPROTO} = $auto_ip ? join('', if_($auto_ip, "dhcp")) : "static"; - $netc->{DHCP} = $auto_ip; - return 0 if $auto_ip; - - if (my @bad = map_index { if_(!is_ip($intf->{$_}), $::i) } @fields) { - $in->ask_warn('', N("IP address should be in format 1.2.3.4")); - return 1, $bad[0]; - } - - if (is_ip_forbidden($intf->{IPADDR})) { - $in->ask_warn('', N("Warning : IP address %s is usually reserved !", $intf->{IPADDR})); - } - - return 0 if !$intf->{WIRELESS_FREQ}; - if ($intf->{WIRELESS_FREQ} !~ /[0-9.]*[kGM]/) { - $in->ask_warn('', N("Freq should have the suffix k, M or G (for example, \"2.46G\" for 2.46 GHz frequency), or add enough '0' (zeroes).")); - return 1,6; - } - if ($intf->{WIRELESS_RATE} !~ /[0-9.]*[kGM]/) { - $in->ask_warn('', N("Rate should have the suffix k, M or G (for example, \"11M\" for 11M), or add enough '0' (zeroes).")); - return 1,8; - } - }, - focus_out => sub { - $intf->{NETMASK} ||= netmask($intf->{IPADDR}) unless $_[0] - } - ) or return; - $intf->{ONBOOT} = bool2yesno($onboot); - $intf->{NEEDHOSTNAME} = bool2yesno($needhostname); - $intf->{MII_NOT_SUPPORTED} = !$hotplug && bool2yesno(!$hotplug) or delete $intf->{MII_NOT_SUPPORTED}; - $intf->{HWADDR} = $track_network_id or delete $intf->{HWADDR}; - 1; -} - -sub configureNetworkNet { - my ($in, $netc, $intf, @devices) = @_; - - $netc->{dnsServer} ||= dns($intf->{IPADDR}); - my $gateway_ex = gateway($intf->{IPADDR}); -#- $netc->{GATEWAY} ||= gateway($intf->{IPADDR}); - - $in->ask_from(N("Configuring network"), -N("Please enter your host name. -Your host name should be a fully-qualified host name, -such as ``mybox.mylab.myco.com''. -You may also enter the IP address of the gateway if you have one.") . N(" - -Enter a Zeroconf host name without any dot if you don't -want to use the default host name."), - [ { label => N("Host name"), val => \$netc->{HOSTNAME} }, - { label => N("Zeroconf Host name"), val => \$netc->{ZEROCONF_HOSTNAME} }, - { label => N("DNS server"), val => \$netc->{dnsServer} }, - { label => N("Gateway (e.g. %s)", $gateway_ex), val => \$netc->{GATEWAY} }, - if_(@devices > 1, - { label => N("Gateway device"), val => \$netc->{GATEWAYDEV}, list => \@devices }, - ), - ], - complete => sub { - if ($netc->{dnsServer} && !is_ip($netc->{dnsServer})) { - $in->ask_warn('', N("DNS server address should be in format 1.2.3.4")); - return 1; - } - if ($netc->{GATEWAY} && !is_ip($netc->{GATEWAY})) { - $in->ask_warn('', N("Gateway address should be in format 1.2.3.4")); - return 1; - } - if ($netc->{ZEROCONF_HOSTNAME} && $netc->{ZEROCONF_HOSTNAME} =~ /\./) { - $in->ask_warn('', N("Zeroconf host name must not contain a .")); - return 1; - } - 0; - } - ); -} - -sub miscellaneous_choose { - my ($in, $u) = @_; - - $in->ask_from('', - N("Proxies configuration"), - [ { label => N("HTTP proxy"), val => \$u->{http_proxy} }, - { label => N("FTP proxy"), val => \$u->{ftp_proxy} }, - ], - complete => sub { - $u->{http_proxy} =~ m,^($|http://), or $in->ask_warn('', N("Proxy should be http://...")), return 1,0; - $u->{ftp_proxy} =~ m,^($|ftp://|http://), or $in->ask_warn('', N("URL should begin with 'ftp:' or 'http:'")), return 1,1; - 0; - } - ) or return; - 1; -} - -sub proxy_configure { - my ($u) = @_; - setExportedVarsInSh("$::prefix/etc/profile.d/proxy.sh", $u, qw(http_proxy ftp_proxy)); - setExportedVarsInCsh("$::prefix/etc/profile.d/proxy.csh", $u, qw(http_proxy ftp_proxy)); -} - -sub read_all_conf { - my ($prefix, $netc, $intf, $o_netcnx) = @_; - $netc ||= {}; $intf ||= {}; - my $netcnx = $o_netcnx || {}; - add2hash($netc, read_conf("$prefix/etc/sysconfig/network")) if -r "$prefix/etc/sysconfig/network"; - add2hash($netc, read_resolv_conf()); - add2hash($netc, read_tmdns_conf("$prefix/etc/tmdns.conf")) if -r "$prefix/etc/tmdns.conf"; - foreach (all("$prefix/etc/sysconfig/network-scripts")) { - if (/ifcfg-(\w+)/ && $1 ne 'lo') { - my $intf = findIntf($intf, $1); - add2hash($intf, { getVarsFromSh("$prefix/etc/sysconfig/network-scripts/$_") }); - } - } - $netcnx->{type} or probe_netcnx_type($prefix, $netc, $intf, $netcnx); -} - -sub probe_netcnx_type { - my ($prefix, $_netc, $intf, $netcnx) = @_; - #- try to probe $netcnx->{type} which is used almost everywhere. - unless ($netcnx->{type}) { - #- ugly hack to determine network type (avoid saying not configured in summary). - -e "$prefix/etc/ppp/peers/adsl" and $netcnx->{type} ||= 'adsl'; # enough ? - -e "$prefix/etc/ppp/ioptions1B" || -e "$prefix/etc/ppp/ioptions2B" and $netcnx->{type} ||= 'isdn'; # enough ? - $intf->{ppp0} and $netcnx->{type} ||= 'modem'; - $intf->{eth0} and $netcnx->{type} ||= 'lan'; - } -} - -sub easy_dhcp { - my ($netc, $intf) = @_; - - return if text2bool($netc->{NETWORKING}); - - require modules; - require network::ethernet; - modules::load_category('network/main|gigabit|usb'); - my @all_cards = network::ethernet::conf_network_card_backend(); - - #- only for a single network card - (any { $_->[0] eq 'eth0' } @all_cards) && (every { $_->[0] ne 'eth1' } @all_cards) or return; - - log::l("easy_dhcp: found eth0"); - - network::ethernet::conf_network_card_backend($netc, $intf, 'dhcp', 'eth0'); - - put_in_hash($netc, { - NETWORKING => "yes", - DHCP => "yes", - }); - 1; -} - -#- configureNetwork2 : configure the network interfaces. -#- input -#- $prefix -#- $netc -#- $intf -#- $netc input -#- NETWORKING : networking flag : string : "yes" by default -#- FORWARD_IPV4 : forward IP flag : string : "false" by default -#- HOSTNAME : hostname : string : "localhost.localdomain" by default -#- DOMAINNAME : domainname : string : $netc->{HOSTNAME} =~ /\.(.*)/ by default -#- DOMAINNAME2 : well it's another domainname : have to look further why we used 2 -#- The following are facultatives -#- DHCP_HOSTNAME : If you have a dhcp and want to set the hostname -#- GATEWAY : gateway -#- GATEWAYDEV : gateway interface -#- NISDOMAIN : nis domain -#- $netc->{dnsServer} : dns server 1 -#- $netc->{dnsServer2} : dns server 2 -#- $netc->{dnsServer3} : dns server 3 : note that we uses the dns1 for the LAN, and the 2 others for the internet conx -#- $intf input: for each $device (for example ethx) -#- $intf->{$device}{IPADDR} : IP address -#- $intf->{$device}{NETMASK} : netmask -#- $intf->{$device}{DEVICE} : DEVICE = $device -#- $intf->{$device}{BOOTPROTO} : boot prototype : "bootp" or "dhcp" or "pump" or ... -sub configureNetwork2 { - my ($in, $prefix, $netc, $intf) = @_; - my $etc = "$prefix/etc"; - - $netc->{wireless_eth} and $in->do_pkgs->install(qw(wireless-tools)); - write_conf("$etc/sysconfig/network", $netc); - write_resolv_conf("$etc/resolv.conf", $netc) if ! $netc->{DHCP}; - write_interface_conf("$etc/sysconfig/network-scripts/ifcfg-$_->{DEVICE}", $_, $netc, $prefix) foreach grep { $_->{DEVICE} } values %$intf; - add2hosts("$etc/hosts", $netc->{HOSTNAME}, map { $_->{IPADDR} } values %$intf) if $netc->{HOSTNAME} && !$netc->{DHCP}; - add2hosts("$etc/hosts", "localhost", "127.0.0.1"); - - any { $_->{BOOTPROTO} eq "dhcp" } values %$intf and $in->do_pkgs->install($netc->{dhcp_client} || 'dhcp-client'); - $in->do_pkgs->install(qw(tmdns)) if !$in->do_pkgs->is_installed('bind'); - $in->do_pkgs->install(qw(zcip)); - $netc->{ZEROCONF_HOSTNAME} and write_zeroconf("$etc/tmdns.conf", $netc->{ZEROCONF_HOSTNAME}); - any { $_->{BOOTPROTO} =~ /^(pump|bootp)$/ } values %$intf and $in->do_pkgs->install('pump'); - - proxy_configure($::o->{miscellaneous}); -} - -1; diff --git a/perl-install/network/nfs.pm b/perl-install/network/nfs.pm deleted file mode 100644 index d257f5346..000000000 --- a/perl-install/network/nfs.pm +++ /dev/null @@ -1,63 +0,0 @@ -package network::nfs; # $Id$ - -use strict; -use diagnostics; - -use common; -use network::network; -use network::smbnfs; -use log; - -our @ISA = 'network::smbnfs'; - -sub to_fstab_entry { - my ($class, $e) = @_; - $class->to_fstab_entry_raw($e, 'nfs'); -} -sub comment_to_string { - my ($_class, $comment) = @_; - member($comment, qw(* 0.0.0.0/0.0.0.0 (everyone))) ? '' : $comment; -} -sub from_dev { - my ($_class, $dev) = @_; - $dev =~ m|(.*?):(.*)|; -} -sub to_dev_raw { - my ($_class, $server, $name) = @_; - $server . ':' . $name; -} - -sub check { - my ($_class, $in) = @_; - $in->do_pkgs->ensure_is_installed('nfs-utils-clients', '/usr/sbin/showmount') or return; - system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0; - 1; -} - -sub find_servers { - my $pid = open(my $F, "rpcinfo-flushed -b mountd 2 |"); - $SIG{ALRM} = sub { kill(15, $pid) }; - alarm 1; - - my $domain = chomp_(`domainname`); - my @servers; - local $_; - while (<$F>) { - my ($ip, $name) = /(\S+)\s+(\S+)/ or log::l("bad line in rpcinfo output"), next; - $name =~ s/\Q.$domain//; - $name =~ s/\.$//; - push @servers, { ip => $ip, if_($name ne '(unknown)', name => $name) }; - } - @servers; -} - -sub find_exports { - my ($_class, $server) = @_; - - my @l; - run_program::raw({ timeout => 1 }, "showmount", '>', \@l, "--no-headers", "-e", $server->{ip} || $server->{name}); - - map { if_(/(\S+(\s*\S+)*)\s+(\S+)/, { name => $1, comment => $3, server => $server }) } @l; -} - -1; diff --git a/perl-install/network/shorewall.pm b/perl-install/network/shorewall.pm deleted file mode 100644 index b41bb636a..000000000 --- a/perl-install/network/shorewall.pm +++ /dev/null @@ -1,138 +0,0 @@ -package network::shorewall; # $Id$ - - - - -use detect_devices; -use network::netconnect; -use run_program; -use common; -use log; - -my @drakgw_ports = qw(domain bootps http https 631 imap pop3 smtp nntp ntp); -# Ports for CUPS (631), LPD/LPRng (515), SMB (137, 138, 139) -my @internal_ports = qw(631 515 137 138 139); - -sub check_iptables { - my ($in) = @_; - - my $existing_config = -f "$::prefix/etc/sysconfig/iptables"; - - $existing_config ||= $::isStandalone && do { - system('modprobe iptable_nat'); - -x '/sbin/iptables' && listlength(`/sbin/iptables -t nat -nL`) > 8; - }; - - !$existing_config || $in->ask_okcancel(N("Firewalling configuration detected!"), - N("Warning! An existing firewalling configuration has been detected. You may need some manual fixes after installation.")); -} - -sub set_config_file { - my ($file, @l) = @_; - - my $done; - substInFile { - if (!$done && (/^#LAST LINE/ || eof)) { - $_ = join('', map { join("\t", @$_) . "\n" } @l) . $_; - $done = 1; - } else { - $_ = '' if /^[^#]/; - } - } "$::prefix/etc/shorewall/$file"; -} - -sub get_config_file { - my ($file) = @_; - map { [ split ' ' ] } grep { !/^#/ } cat_("$::prefix/etc/shorewall/$file"); -} - -sub default_interfaces() { - my %conf; - - my @l = detect_devices::getNet() or return; - if (@l == 1) { - $conf{net_interface} = $l[0]; - } else { - $conf{net_interface} = network::netconnect::get_net_device() || $l[0]; - $conf{loc_interface} = [ grep { $_ ne $conf{net_interface} } @l ]; - } - \%conf; -} - -sub read() { - my %conf; - - $conf{disabled} = !glob_("$::prefix/etc/rc3.d/S*shorewall"); - - $conf{ports} = - join(' ', map { - my $e = $_; - map { "$_/$e->[3]" } split(',', $e->[4]); - } grep { $_->[0] eq 'ACCEPT' && $_->[1] eq 'net' } get_config_file('rules')); - - if (my ($e) = get_config_file('masq')) { - $conf{masquerade}{subnet} = $e->[1] if $e->[1]; - } - put_in_hash(\%conf, default_interfaces()); - foreach (get_config_file('interfaces')) { - my ($name, $interface) = @$_; - if ($name eq 'masq') { - $conf{masquerade}{interface} = $interface; - $conf{loc_interface} = [ difference2($conf{loc_interface}, [$interface]) ]; - } - } - $conf{net_interface} && \%conf; -} - -sub write { - my ($conf) = @_; - my $connect_file = "/etc/sysconfig/network-scripts/net_cnx_up"; - - my %ports_by_proto; - foreach (split ' ', $conf->{ports}) { - m!^(\d+)/(udp|tcp)$! or die "bad port $_\n"; - push @{$ports_by_proto{$2}}, $1; - } - - set_config_file("zones", - [ 'net', 'Net', 'Internet zone' ], - if_($conf->{masquerade}, [ 'masq', 'Masquerade', 'Masquerade Local' ]), - if_($conf->{loc_interface}, [ 'loc', 'Local', 'Local' ]), - ); - set_config_file('interfaces', - [ 'net', $conf->{net_interface}, 'detect' ], - $conf->{masquerade} ? [ 'masq', $conf->{masquerade}{interface}, 'detect' ] : (), - (map { [ 'loc', $_, 'detect' ] } @{$conf->{loc_interface} || []}), - ); - set_config_file('policy', - if_($conf->{masquerade}, [ 'masq', 'net', 'ACCEPT' ]), - if_($conf->{loc_interface}, [ 'loc', 'net', 'ACCEPT' ]), - [ 'fw', 'net', 'ACCEPT' ], - [ 'net', 'all', 'DROP', 'info' ], - [ 'all', 'all', 'REJECT', 'info' ], - ); - set_config_file('rules', - if_(cat_("$::prefix$connect_file") =~ /pptp/, [ 'ACCEPT', 'fw', 'loc:10.0.0.138', 'tcp', '1723' ]), - if_(cat_("$::prefix$connect_file") =~ /pptp/, [ 'ACCEPT', 'fw', 'loc:10.0.0.138', 'gre' ]), - (map { - map_each { [ 'ACCEPT', $_, 'fw', $::a, join(',', @$::b), '-' ] } %ports_by_proto - } ('net', if_($conf->{masquerade}, 'masq'), if_($conf->{loc_interface}, 'loc'))), - if_($conf->{masquerade}, map { [ 'ACCEPT', 'masq', 'fw', $_, join(',', @drakgw_ports), '-' ] } 'tcp', 'udp'), - if_($conf->{masquerade}, map { [ 'ACCEPT', 'fw', 'masq', $_, join(',', @internal_ports), '-' ] } 'tcp', 'udp'), - ); - set_config_file('masq', - $conf->{masquerade} ? [ $conf->{net_interface}, $conf->{masquerade}{subnet} ] : (), - ); - - if ($conf->{disabled}) { - run_program::rooted($::prefix, 'chkconfig', '--del', 'shorewall'); - run_program::run('service', '>', '/dev/null', 'shorewall', 'stop') if $::isStandalone; - run_program::run('service', '>', '/dev/null', 'shorewall', 'clear') if $::isStandalone; - } else { - run_program::rooted($::prefix, 'chkconfig', '--add', 'shorewall'); - run_program::run('service', '>', '/dev/null', 'shorewall', 'restart') if $::isStandalone; - } -} - -1; - diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm deleted file mode 100644 index d8c3024fd..000000000 --- a/perl-install/network/smb.pm +++ /dev/null @@ -1,181 +0,0 @@ -package network::smb; # $Id$ - -use strict; -use diagnostics; - -use common; -use fs; -use network::network; -use network::smbnfs; - - -our @ISA = 'network::smbnfs'; - -sub to_fstab_entry { - my ($class, $e) = @_; - my $part = $class->to_fstab_entry_raw($e, 'smbfs'); - if ($e->{server}{username}) { - my ($options, $unknown) = fs::mount_options_unpack($part); - $options->{"$_="} = $e->{server}{$_} foreach qw(username password domain); - fs::mount_options_pack($part, $options, $unknown); - } - $part; -} -sub from_dev { - my ($_class, $dev) = @_; - $dev =~ m|//(.*?)/(.*)|; -} -sub to_dev_raw { - my ($_class, $server, $name) = @_; - '//' . $server . '/' . $name; -} - -sub check { - my ($_class, $in) = @_; - $in->do_pkgs->ensure_is_installed('samba-client', '/usr/bin/nmblookup'); -} - -sub smbclient { - my ($server) = @_; - my $name = $server->{name} || $server->{ip}; - my $ip = $server->{ip} ? "-I $server->{ip}" : ''; - my $group = $server->{group} ? " -W $server->{group}" : ''; - - my $U = $server->{username} ? sprintf("%s/%s%%%s", @$server{'domain', 'username', 'password'}) : '%'; - `smbclient -U $U -L $name $ip$group`; -} - -sub find_servers { - my (undef, @l) = `nmblookup "*"`; - s/\s.*\n// foreach @l; - my @servers = grep { network::network::is_ip($_) } @l; - my %servers; - $servers{$_}{ip} = $_ foreach @servers; - my ($ip, $browse); - foreach (`nmblookup -A @servers`) { - my $nb = /^Looking up status of (\S+)/ .. /^$/ or next; - if ($nb == 1) { - $ip = $1; - } elsif (/<00>/) { - $servers{$ip}{/<GROUP>/ ? 'group' : 'name'} ||= lc first(/(\S+)/); - } elsif (/__MSBROWSE__/) { - $browse ||= $servers{$ip}; - } - } - if ($browse) { - my %l; - foreach (smbclient($browse)) { - my $nb = /^\s*Workgroup/ .. /^$/; - $nb > 2 or next; - my ($group, $name) = split(' ', lc($_)); - - # already done - next if any { $group eq $_->{group} } values %servers; - - $l{$name} = $group; - } - if (my @l = keys %l) { - foreach (`nmblookup @l`) { - $servers{$1} = { name => $2, group => $l{$2} } if /(\S+)\s+([^<]+)<00>/; - } - } - } - values %servers; -} - -sub find_exports { - my ($_class, $server) = @_; - my @l; - - foreach (smbclient($server)) { - chomp; - s/^\t//; - /NT_STATUS_/ and die $_; - my ($name, $type, $comment) = unpack "A15 A10 A*", $_; - if (($name eq '---------' && $type eq '----' && $comment eq '-------') .. /^$/) { - push @l, { name => $name, type => $type, comment => $comment, server => $server } - if $type eq 'Disk' && $name !~ /\$$/ && $name !~ /NETLOGON|SYSVOL/; - } - } - @l; -} - -sub authentifications_available { - my ($server) = @_; - map { if_(/^auth.\Q$server->{name}.\E(.*)/, $1) } all("/etc/samba"); -} - -sub to_credentials { - my ($server_name, $username) = @_; - $username or die 'to_credentials'; - "/etc/samba/auth.$server_name.$username"; -} - -sub fstab_entry_to_credentials { - my ($part) = @_; - - my ($server_name) = network::smb->from_dev($part->{device}) or return; - - my ($options, $unknown) = fs::mount_options_unpack($part); - $options->{'username='} && $options->{'password='} or return; - my %h = map { $_ => delete $options->{"$_="} } qw(username domain password); - $h{file} = $options->{'credentials='} = to_credentials($server_name, $h{username}); - fs::mount_options_pack_($part, $options, $unknown), \%h; -} - -sub remove_bad_credentials { - my ($server) = @_; - unlink to_credentials($server->{name}, $server->{username}); -} - -sub save_credentials { - my ($credentials) = @_; - my $file = $credentials->{file}; - output_with_perm("$::prefix$file", 0640, map { "$_ = $credentials->{$_}\n" } qw(username domain password)); -} - - -sub read_credentials_raw { - my ($file) = @_; - my %h = map { /(.*?)\s*=\s*(.*)/ } cat_("$::prefix$file"); - \%h; -} - -sub read_credentials { - my ($server, $username) = @_; - put_in_hash($server, read_credentials_raw(to_credentials($server->{name}, $username))); -} - - -sub write_smb_conf { - my ($domain) = @_; - - #- was going to just have a canned config in samba-winbind - #- and replace the domain, but sylvestre/buchan didn't bless it yet - - my $f = "$::prefix/etc/samba/smb.conf"; - rename $f, "$f.orig"; - output($f, " -[global] - workgroup = $domain - server string = Samba Server %v - security = domain - encrypt passwords = Yes - password server = * - log file = /var/log/samba/log.%m - max log size = 50 - socket options = TCP_NODELAY SO_RCVBUF=8192 SO_SNDBUF=8192 - character set = ISO8859-15 - os level = 18 - local master = No - dns proxy = No - winbind uid = 10000-20000 - winbind gid = 10000-20000 - winbind separator = + - template homedir = /home/%D/%U - template shell = /bin/bash - winbind use default domain = yes -"); -} - -1; diff --git a/perl-install/network/smbnfs.pm b/perl-install/network/smbnfs.pm deleted file mode 100644 index 528a87be2..000000000 --- a/perl-install/network/smbnfs.pm +++ /dev/null @@ -1,45 +0,0 @@ -package network::smbnfs; # $Id$ - -use strict; -use diagnostics; - -use fs; - - -sub new { - my ($class, $v) = @_; - bless($v || {}, $class); -} - -sub server_to_string { - my ($_class, $server) = @_; - $server->{name} || $server->{ip}; -} -sub comment_to_string { - my ($_class, $comment) = @_; - $comment; -} -sub to_dev { - my ($class, $e) = @_; - $class->to_dev_raw($class->server_to_string($e->{server}), $e->{name} || $e->{ip}); -} -sub to_string { - my ($class, $e) = @_; - my $comment = $class->comment_to_string($e->{comment}); - ($e->{name} || $e->{ip}) . ($comment ? " ($comment)" : ''); -} - -sub to_fullstring { - my ($class, $e) = @_; - my $comment = $class->comment_to_string($e->{comment}); - $class->to_dev($e) . ($comment ? " ($comment)" : ''); -} -sub to_fstab_entry_raw { - my ($class, $e, $type) = @_; - my $fs_entry = { device => $class->to_dev($e), type => $type }; - fs::set_default_options($fs_entry); - $fs_entry; -} - -1; - diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm deleted file mode 100644 index b40ed0860..000000000 --- a/perl-install/network/tools.pm +++ /dev/null @@ -1,303 +0,0 @@ -package network::tools; # $Id$ - -use strict; -use common; -use run_program; -use c; -use vars qw(@ISA @EXPORT @EXPORT_OK); -use MDK::Common::Globals "network", qw($in $prefix $disconnect_file $connect_prog $connect_file); -use MDK::Common::System qw(getVarsFromSh); - -@ISA = qw(Exporter); -@EXPORT = qw(write_cnx_script write_secret_backend read_secret_backend passwd_by_login write_initscript ask_connect_now connect_backend disconnect_backend read_providers_backend ask_info2 type2interface connected connected_bg test_connected connected2 disconnected); -@EXPORT_OK = qw($in); - -sub write_cnx_script { - my ($netc, $o_type, $o_up, $o_down, $o_type2) = @_; - if ($o_type) { - $netc->{internet_cnx}{$o_type}{$_->[0]} = $_->[1] foreach [$connect_file, $o_up], [$disconnect_file, $o_down]; - $netc->{internet_cnx}{$o_type}{type} = $o_type2; - } else { - foreach ($connect_file, $disconnect_file) { - output_with_perm("$prefix$_", 0755, -'#!/bin/bash -' . if_(!$netc->{at_boot}, 'if [ "x$1" == "x--boot_time" ]; then exit; fi -') . $netc->{internet_cnx}{$netc->{internet_cnx_choice}}{$_}); - } - } -} - -sub write_secret_backend { - my ($a, $b) = @_; - foreach my $i ("pap-secrets", "chap-secrets") { - substInFile { s/^'$a'.*\n//; $_ .= "\n'$a' * '$b' * \n" if eof } "$prefix/etc/ppp/$i"; - } -} - -sub unquotify { - my ($word) = @_; - $$word =~ s/^(['"]?)(.*)\1$/$2/; -} - -sub read_secret_backend() { - my $conf; - foreach my $i ("pap-secrets", "chap-secrets") { - foreach (cat_("$prefix/etc/ppp/$i")) { - my ($login, $server, $passwd) = split(' '); - if ($login && $passwd) { - unquotify \$passwd; - unquotify \$login; - unquotify \$server; - push @$conf, {login => $login, - passwd => $passwd, - server => $server }; - } - } - } - $conf; -} - -sub passwd_by_login { - my ($login) = @_; - - unquotify \$login; - my $secret = read_secret_backend(); - foreach (@$secret) { - return $_->{passwd} if $_->{login} eq $login; - } -} - -sub ask_connect_now { - my ($type) = @_; - $::Wizard_no_previous = 1; - my $up = 1; - #- FIXME : code the exception to be generated by ask_yesorno, to be able to remove the $::Wizard_no_previous=1; - if ($in->ask_yesorno(N("Internet configuration"), - N("Do you want to try to connect to the Internet now?") - )) { - { - my $_w = $in->wait_message('', N("Testing your connection..."), 1); - connect_backend(); - my $s = 30; - $type =~ /modem/ and $s = 50; - $type =~ /adsl/ and $s = 35; - $type =~ /isdn/ and $s = 20; - sleep $s; - $up = connected(); - } - my $m = $up ? N("The system is now connected to the Internet.") . - if_($::isInstall, N("For security reasons, it will be disconnected now.")) : - N("The system doesn't seem to be connected to the Internet. -Try to reconfigure your connection."); - $::Wizard_no_previous = 1; - $::Wizard_finished = 1; - $in->ask_okcancel(N("Network Configuration"), $m, 1); - undef $::Wizard_no_previous; - undef $::Wizard_finished; - $::isInstall and disconnect_backend(); - } - undef $::Wizard_no_previous; - $up; -} - -sub connect_backend() { run_program::rooted($prefix, "$connect_file &") } - -sub disconnect_backend() { run_program::rooted($prefix, "$disconnect_file &") } - -sub read_providers_backend { my ($file) = @_; map { /(.*?)=>/ } catMaybeCompressed($file) } - -sub ask_info2 { - my ($cnx, $netc) = @_; - - $in->ask_from(N("Connection Configuration"), - N("Please fill or check the field below"), - [ - if__($cnx->{irq}, { label => N("Card IRQ"), val => \$cnx->{irq} }), - if__($cnx->{mem}, { label => N("Card mem (DMA)"), val => \$cnx->{mem} }), - if__($cnx->{io}, { label => N("Card IO"), val => \$cnx->{io} }), - if__($cnx->{io0}, { label => N("Card IO_0"), val => \$cnx->{io0} }), - if__($cnx->{io1}, { label => N("Card IO_1"), val => \$cnx->{io1} }), - if__($cnx->{phone_in}, { label => N("Your personal phone number"), val => \$cnx->{phone_in} }), - if__($netc->{DOMAINNAME2}, { label => N("Provider name (ex provider.net)"), val => \$netc->{DOMAINNAME2} }), - if__($cnx->{phone_out}, { label => N("Provider phone number"), val => \$cnx->{phone_out} }), - if__($netc->{dnsServer2}, { label => N("Provider dns 1 (optional)"), val => \$netc->{dnsServer2} }), - if__($netc->{dnsServer3}, { label => N("Provider dns 2 (optional)"), val => \$netc->{dnsServer3} }), - if__($cnx->{vpivci}, { label => N("Choose your country"), val => \$netc->{vpivci}, list => detect_timezone() }), - if__($cnx->{dialing_mode}, { label => N("Dialing mode"), val => \$cnx->{dialing_mode},list => ["auto", "manual"] }), - if__($cnx->{speed}, { label => N("Connection speed"), val => \$cnx->{speed}, list => ["64 Kb/s", "128 Kb/s"] }), - if__($cnx->{huptimeout}, { label => N("Connection timeout (in sec)"), val => \$cnx->{huptimeout} }), - { label => N("Account Login (user name)"), val => \$cnx->{login} }, - { label => N("Account Password"), val => \$cnx->{passwd}, hidden => 1 }, - ] - ) or return; - if ($netc->{vpivci}) { - foreach ([N("Netherlands"), '8_48'], [N("France"), '8_35'], [N("Belgium"), '8_35'], [N("Italy"), '8_35'], [N("United Kingdom"), '0_38'], [N("United States"), '8_35']) { - $netc->{vpivci} eq $_->[0] and $netc->{vpivci} = $_->[1]; - } - } - 1; -} - -sub detect_timezone() { - my %tmz2country = ( - 'Europe/Paris' => N("France"), - 'Europe/Amsterdam' => N("Netherlands"), - 'Europe/Rome' => N("Italy"), - 'Europe/Brussels' => N("Belgium"), - 'America/New_York' => N("United States"), - 'Europe/London' => N("United Kingdom") - ); - my %tm_parse = MDK::Common::System::getVarsFromSh('/etc/sysconfig/clock'); - my @country; - foreach (keys %tmz2country) { - if ($_ eq $tm_parse{ZONE}) { - unshift @country, $tmz2country{$_}; - } else { push @country, $tmz2country{$_} }; - } - \@country; -} - -sub type2interface { - my ($i) = @_; - $i =~ /$_->[0]/ and return $_->[1] foreach [ modem => 'ppp' ], - [ isdn_internal => 'ippp' ], - [ isdn_external => 'ppp' ], - [ adsl => 'ppp' ], - [ cable => 'eth' ], - [ lan => 'eth' ]; -} - -sub connected() { gethostbyname("mandrakesoft.com") ? 1 : 0 } - -my $kid_pipe; -sub connected_bg { - local $| = 1; - my ($ref) = @_; - if (defined $kid_pipe) { - fcntl($kid_pipe, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!"; - my $a; - if (defined($a = <$kid_pipe>)) { - close($kid_pipe) or warn "kid exited $?"; - undef $kid_pipe; - $$ref = $a; - } - } else { $kid_pipe = connected2() } - 1; -} - -# test if connected; -# cmd = 0 : ask current status -# return : 0 : not connected; 1 : connected; -1 : no test ever done; -2 : test in progress -# cmd = 1 : start new connection test -# return : -2 -# cmd = 2 : cancel current test -# return : nothing -# cmd = 3 : return current status even if a test is in progress -my $kid_pipe_connect; -my $kid_pid; -my $current_connection_status; - -sub test_connected { - local $| = 1; - my ($cmd) = @_; - - if (!defined $current_connection_status) { $current_connection_status = -1 } - - if ($cmd == 0) { - if (defined $kid_pipe_connect) { - fcntl($kid_pipe_connect, c::F_SETFL(), c::O_NONBLOCK()) or die "can't fcntl F_SETFL: $!"; - my $a; - if (defined($a = <$kid_pipe_connect>)) { - close($kid_pipe_connect) or warn "kid exited $?"; - undef $kid_pipe_connect; - undef $kid_pid; - $current_connection_status = $a; - } - } - return $current_connection_status; - } - - if ($cmd == 1) { - if ($current_connection_status != -2) { - $current_connection_status = -2; - $kid_pipe_connect = connected2(); - } - } - if ($cmd == 2) { - if (defined($kid_pid)) { - kill -9, $kid_pid; - undef $kid_pid; - } - } - return $current_connection_status; -} - -sub connected2() { - if ($kid_pid = open(my $kid_to_read, "-|")) { - #- parent - $kid_to_read; - } else { - #- child - my $a = gethostbyname("mandrakesoft.com") ? 1 : 0; - print $a; - c::_exit(0); - } -} - -sub disconnected() {} - - -sub write_initscript() { - $::testing and return; - output_with_perm("$prefix/etc/rc.d/init.d/internet", 0755, - sprintf(<<'EOF', $connect_file, $connect_file, $disconnect_file, $disconnect_file)); -#!/bin/bash -# -# internet Bring up/down internet connection -# -# chkconfig: 2345 11 89 -# description: Activates/Deactivates the internet interfaces -# -# dam's (damien@mandrakesoft.com) - -# Source function library. -. /etc/rc.d/init.d/functions - - case "$1" in - start) - if [ -e %s ]; then - action "Checking internet connections to start at boot" "%s --boot_time" - else - action "No connection to start" "true" - fi - touch /var/lock/subsys/internet - ;; - stop) - if [ -e %s ]; then - action "Stopping internet connection if needed: " "%s --boot_time" - else - action "No connection to stop" "true" - fi - rm -f /var/lock/subsys/internet - ;; - restart) - $0 stop - echo "Waiting 10 sec before restarting the internet connection." - sleep 10 - $0 start - ;; - status) - ;; - *) - echo "Usage: internet {start|stop|status|restart}" - exit 1 -esac -exit 0 -EOF - $::isStandalone ? system("/sbin/chkconfig --add internet") : do { - symlinkf("../init.d/internet", "$prefix/etc/rc.d/rc$_") foreach - '0.d/K11internet', '1.d/K11internet', '2.d/K11internet', '3.d/S89internet', '5.d/S89internet', '6.d/K11internet'; - }; -} - -1; |
