diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 12:26:16 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2007-04-25 12:26:16 +0000 |
commit | 126777bc019a54afb4ec51299f2cf9d2841698aa (patch) | |
tree | 97f76e571902ead55ba138f1156a4b4f00b9b779 /perl-install/network | |
parent | f1f67448efc714873378dfeb8279fae68054a90a (diff) | |
download | drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.gz drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.bz2 drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.tar.xz drakx-126777bc019a54afb4ec51299f2cf9d2841698aa.zip |
re-sync after the big svn loss
Diffstat (limited to 'perl-install/network')
24 files changed, 0 insertions, 7917 deletions
diff --git a/perl-install/network/adsl.pm b/perl-install/network/adsl.pm deleted file mode 100644 index 3768c171b..000000000 --- a/perl-install/network/adsl.pm +++ /dev/null @@ -1,336 +0,0 @@ -package network::adsl; # $Id$ - -use common; -use run_program; -use network::tools; -use modules; -use vars qw(@ISA @EXPORT); - -@ISA = qw(Exporter); -@EXPORT = qw(adsl_conf_backend); - -sub adsl_probe_info { - my ($net) = @_; - my $pppoe_file = "$::prefix/etc/ppp/pppoe.conf"; - my $login; - foreach (qw(/etc/ppp/peers/ppp0 /etc/ppp/options /etc/ppp/options.adsl)) { - ($login) = map { if_(/^user\s+"([^"]+)"/, $1) } cat_("$::prefix/$_") if !$login && -r "$::prefix/$_"; - } - my %pppoe_conf; %pppoe_conf = getVarsFromSh($pppoe_file) if (!exists $net->{adsl}{method} || $net->{adsl}{method} eq 'pppoe') && -f $pppoe_file; - $login ||= $pppoe_conf{USER}; - my $passwd = network::tools::passwd_by_login($login); - if (!$net->{adsl}{vpi} && !$net->{adsl}{vci}) { - ($net->{adsl}{vpi}, $net->{adsl}{vci}) = - (map { if_(/^.*-vpi\s+(\d+)\s+-vci\s+(\d+)/, map { sprintf("%x", $_) } $1, $2) } cat_("$::prefix/etc/ppp/peers/ppp0")); - } - $pppoe_conf{DNS1} ||= ''; - $pppoe_conf{DNS2} ||= ''; - add2hash($net->{resolv}, { dnsServer2 => $pppoe_conf{DNS1}, dnsServer3 => $pppoe_conf{DNS2}, DOMAINNAME2 => '' }); - add2hash($net->{adsl}, { login => $login, passwd => $passwd }); -} - -sub adsl_detect() { - require list_modules; - require detect_devices; - my @modules = list_modules::category2modules('network/usb_dsl'); - # return an hash compatible with what drakconnect expect us to return: - my %compat = ( - 'speedtch' => 'speedtouch', - 'eagle-usb' => 'sagem', - ); - - return { - bewan => [ detect_devices::getBewan() ], - eci => [ detect_devices::getECI() ], - map { $compat{$_} || $_ => [ detect_devices::matching_driver($_) ] } @modules, - }; -} - -sub sagem_set_parameters { - my ($net) = @_; - my %l = map { $_ => sprintf("%08s", $net->{adsl}{$_}) } qw(vci vpi Encapsulation); - - my $static_ip = $net->{adsl}{method} eq 'static' && $net->{ifcfg}{sagem}{IPADDR}; - foreach my $cfg_file (qw(/etc/analog/adiusbadsl.conf /etc/eagle-usb/eagle-usb.conf)) { - substInFile { - s/Linetype=.*\n/Linetype=0000000A\n/; #- use CMVs - s/VCI=.*\n/VCI=$l{vci}\n/; - s/VPI=.*\n/VPI=$l{vpi}\n/; - s/Encapsulation=.*\n/Encapsulation=$l{Encapsulation}\n/; - s/ISP=.*\n/ISP=$net->{adsl}{provider_id}\n/; - s/STATIC_IP=.*\n//; - s!</eaglectrl>!STATIC_IP=$static_ip\n</eaglectrl>! if $static_ip; - } "$::prefix$cfg_file"; - } - #- create CMV symlinks for both POTS and ISDN lines - foreach my $type (qw(p i)) { - my $cmv; - my ($country) = $net->{adsl}{provider_id} =~ /^([a-zA-Z]+)\d+$/; - #- try to find a CMV for this specific ISP - $cmv = "$::prefix/etc/eagle-usb/CMVe${type}$net->{adsl}{provider_id}.txt" if $net->{adsl}{provider_id}; - #- if not found, try to found a CMV for the country - -f $cmv or $cmv = "$::prefix/etc/eagle-usb/CMVe${type}${country}.txt"; - #- fallback on the generic CMV if no other matched - -f $cmv or $cmv = "$::prefix/etc/eagle-usb/CMVe${type}WO.txt"; - symlinkf($cmv, "$::prefix/etc/eagle-usb/CMVe${type}.txt"); - } - #- remove this otherwise eaglectrl won't start - unlink("$::prefix/etc/eagle-usb/eagle-usb_must_be_configured"); -} - -sub adsl_conf_backend { - my ($in, $modules_conf, $net) = @_; - - my $bewan_module; - $bewan_module = $net->{adsl}{bus} eq 'PCI' ? 'unicorn_pci_atm' : 'unicorn_usb_atm' if $net->{adsl}{device} eq "bewan"; - - my $adsl_type = $net->{adsl}{method}; - my $adsl_device = $net->{adsl}{device}; - - # all supported modems came with their own pppoa module, so no need for "plugin pppoatm.so" - my %modems = - ( - bewan => - { - start => qq( -# ActivationMode=1 -modprobe $bewan_module -# wait for the modem to be set up: -sleep 10 -), - stop => qq(modprobe -r $bewan_module), - plugin => { - pppoa => "pppoatm.so " . join('.', hex($net->{adsl}{vpi}), hex($net->{adsl}{vci})) - }, - ppp_options => qq( -default-asyncmap -hide-password -noaccomp -nobsdcomp -nodeflate -novj novjccomp -lcp-echo-interval 20 -lcp-echo-failure 3 -sync -), - }, - - speedtouch => - { - modules => [ qw(speedtch) ], - start => '/usr/bin/speedtouch-start --nocall', - overide_script => 1, - server => { - pppoa => qq("/usr/sbin/pppoa3 -c") - }, - plugin => { - pppoa => "pppoatm.so " . join('.', hex($net->{adsl}{vpi}), hex($net->{adsl}{vci})), - }, - ppp_options => qq( -sync -noaccomp), - aliases => [ - ['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'] - ], - }, - - sagem => - { - modules => [ qw(eagle-usb) ], - start => '/sbin/eaglectrl -i >/dev/null 2>/dev/null || /sbin/eaglectrl -d', - stop => "/usr/bin/killall pppoa", - get_intf => '/sbin/eaglectrl -i', - server => { - pppoa => q("/sbin/fctStartAdsl -t 1 -i"), - }, - ppp_options => qq( -mru 1492 -mtu 1492 -nobsdcomp -nodeflate -noaccomp -am -novjccomp), - aliases => [ - ['char-major-108', 'ppp_generic'], - ['tty-ldisc-3', 'ppp_async'], - ['tty-ldisc-13', 'n_hdlc'], - ['tty-ldisc-14', 'ppp_synctty'] - ], - }, - - eci => - { - start => '/usr/bin/startmodem', - server => { - pppoe => qq("/usr/bin/pppoeci -v 1 -vpi $net->{adsl}{vpi} -vci $net->{adsl}{vci}"), - }, - ppp_options => qq( -noipdefault -sync -noaccomp -linkname eciadsl -lcp-echo-interval 0) - }, - - pptp_modem => - { - server => { - pptp => qq("/usr/sbin/pptp 10.0.0.138 --nolaunchpppd"), - }, - }, - - capi_modem => - { - ppp_options => qq( -connect /bin/true -ipcp-accept-remote -ipcp-accept-local - -sync -noauth -lcp-echo-interval 5 -lcp-echo-failure 3 -lcp-max-configure 50 -lcp-max-terminate 2 - -noccp -noipx -mru 1492 -mtu 1492), - plugin => { - capi => qq(capiplugin.so -avmadsl) - }, - }, - ); - - my %generic = - ( - pppoe => - { - server => '"pppoe -I ' . (exists $modems{$adsl_device}{get_intf} ? "`$modems{$adsl_device}{get_intf}`" : $net->{adsl}{ethernet_device}) . '"', - ppp_options => qq(default-asyncmap -mru 1492 -mtu 1492 -noaccomp -noccp -nobsdcomp -novjccomp -nodeflate -lcp-echo-interval 20 -lcp-echo-failure 3 -), - } - ); - - if ($adsl_type =~ /^pp|^capi$/) { - mkdir_p("$::prefix/etc/ppp"); - $in->do_pkgs->install('ppp'); - my %packages = ( - pppoa => [ qw(ppp-pppoatm) ], - pppoe => [ qw(ppp-pppoe rp-pppoe) ], - pptp => [ qw(pptp-linux) ], - capi => [ qw(isdn4k-utils) ], #- capi4linux service - ); - $in->do_pkgs->install(@{$packages{$adsl_type}}); - - my $pty_option = - exists $modems{$adsl_device}{server}{$adsl_type} ? "pty $modems{$adsl_device}{server}{$adsl_type}" : - exists $generic{$adsl_type}{server} ? "pty $generic{$adsl_type}{server}" : - ""; - my $plugin = exists $modems{$adsl_device}{plugin}{$adsl_type} && "plugin $modems{$adsl_device}{plugin}{$adsl_type}"; - my $noipdefault = $adsl_type eq 'pptp' ? '' : 'noipdefault'; - my $ppp_options = - exists $modems{$adsl_device}{ppp_options} ? $modems{$adsl_device}{ppp_options} : - exists $generic{$adsl_type}{ppp_options} ? $generic{$adsl_type}{ppp_options} : - ""; - output("$::prefix/etc/ppp/peers/ppp0", -qq(lock -persist -noauth -usepeerdns -defaultroute -$noipdefault -$ppp_options -kdebug 1 -nopcomp -noccp -novj -holdoff 4 -maxfail 25 -$pty_option -$plugin -user "$net->{adsl}{login}" -)); - - network::tools::write_secret_backend($net->{adsl}{login}, $net->{adsl}{passwd}); - - my $ethernet_device = $net->{adsl}{ethernet_device}; - if ($ethernet_device =~ /^eth/) { - $net->{ifcfg}{$ethernet_device} = { - DEVICE => $ethernet_device, - BOOTPROTO => 'none', - NETMASK => '255.255.255.0', - NETWORK => '10.0.0.0', - BROADCAST => '10.0.0.255', - MII_NOT_SUPPORTED => 'yes', - ONBOOT => 'yes', - }; - } - } - - #- FIXME: ppp0 and ippp0 are hardcoded - my $metric = network::tools::get_default_metric("adsl"); #- FIXME, do not override if already set - put_in_hash($net->{ifcfg}{ppp0} ||= {}, { - DEVICE => 'ppp0', - TYPE => 'ADSL', - METRIC => $metric, - }) unless member($adsl_type, qw(static dhcp)); - #- don't overwrite ONBOOT setting, it may have been handled earlier in netconnect - $net->{ifcfg}{ppp0}{ONBOOT} ||= 'yes'; - - #- remove file used with sagem for dhcp/static connections - unlink("$::prefix/etc/sysconfig/network-scripts/ifcfg-sagem"); - - #- set vpi, vci and encapsulation parameters for sagem - $adsl_device eq 'sagem' and sagem_set_parameters($net); - - #- set aliases - if (exists $modems{$adsl_device}{aliases}) { - $modules_conf->set_alias($_->[0], $_->[1]) foreach @{$modems{$adsl_device}{aliases}}; - $::isStandalone and $modules_conf->write; - } - #- remove the "speedtch off" alias that was written by Mandrakelinux 10.0 - $adsl_device eq 'speedtouch' and $modules_conf->remove_alias('speedtch'); - - if ($adsl_type eq "capi") { - require network::isdn; - network::isdn::setup_capi_conf($in, $net->{adsl}{capi_card}); - services::disable('isdn4linux'); - services::enable('capi4linux'); - - #- install and run drdsl for dsl connections, once capi driver is loaded - $in->do_pkgs->ensure_is_installed_if_available("drdsl", "/usr/sbin/drdsl"); - run_program::rooted($::prefix, "/usr/sbin/drdsl"); - } - - #- load modules and run modem-specific start programs - #- useful during install, or in case the packages have been installed after the device has been plugged - my @modules = (@{$modems{$adsl_device}{modules}}, map { $_->[1] } @{$modems{$adsl_device}{aliases}}); - @modules or @modules = qw(ppp_synctty ppp_async ppp_generic n_hdlc); #- required for pppoe/pptp connections - #- pppoa connections need the pppoatm module - #- pppd should run "modprobe pppoatm", but it will fail during install - push @modules, 'pppoatm' if $adsl_type eq 'pppoa'; - foreach (@modules) { - eval { modules::load($_) } or log::l("failed to load $_ module: $@"); - } - $modems{$adsl_device}{start} and run_program::rooted($::prefix, $modems{$adsl_device}{start}); -} - -1; diff --git a/perl-install/network/adsl_consts.pm b/perl-install/network/adsl_consts.pm deleted file mode 100644 index c3cc03b1c..000000000 --- a/perl-install/network/adsl_consts.pm +++ /dev/null @@ -1,979 +0,0 @@ -package network::adsl_consts; # $Id$ - -# This should probably be splitted out into ldetect-lst as some provider db - -use vars qw(@ISA @EXPORT); -use common; -use utf8; - -@ISA = qw(Exporter); -@EXPORT = qw(@adsl_data); - -# Originally from : -# http://www.eagle-usb.org/article.php3?id_article=23 -# http://www.sagem.com/web-modems/download/support-fast1000-fr.htm -# http://perso.wanadoo.fr/michel-m/protocolesfai.htm - -our %adsl_data = ( - ## format chosen is the following : - # country|provider => { VPI, VCI_hexa, ... } all parameters - # country is automagically translated into LANG with N function - # provider is kept "as-is", not translated - # provider_id is used by eagleconfig to identify an ISP (I use ISO_3166-1) - # see http://en.wikipedia.org/wiki/ISO_3166-1 - # url_tech : technical URL providing info about ISP - # vpi : virtual path identifier - # vci : virtual channel identifier (in hexa below !!) - # Encapsulation: - # 1=PPPoE LLC, 2=PPPoE VCmux (never used ?) - # 3=RFC1483/2684 Routed IP LLC, - # 4=RFC1483/2684 Routed IP (IPoA VCmux) - # 5 RFC2364 PPPoA LLC, - # 6 RFC2364 PPPoA VCmux - # see http://faq.eagle-usb.org/wakka.php?wiki=AdslDescription - # dns are provided for when !usepeerdns in peers config file - # dnsServer2 dnsServer3 : main DNS - # dnsServers_text : string with any valid DNS (when more than 2) - # DOMAINNAME2 : used for search key in /etc/resolv.conf - # method : PPPoA, pppoe, static or dhcp - # methods_all : all methods for connection with this ISP (when more than 1) - # modem : model of modem provided by ISP or tested with ISP - # please forward updates to http://forum.eagle-usb.org - # try to order alphabetically by country (in English) / ISP (local language) - - N("Algeria") . "|Wanadoo" => - { - provider_id => 'DZ01', - vpi => 0, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - dnsServer2 => '82.101.136.29', - dnsServer3 => '82.101.136.206', - }, - - N("Argentina") . "|Speedy" => - { - provider_id => 'AR01', - vpi => 1, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - dnsServer2 => '200.51.254.238', - dnsServer3 => '200.51.209.22', - }, - - N("Austria") . "|Any" => - { - provider_id => 'AT00', - vpi => 8, - vci => 30, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Austria") . "|AON" => - { - provider_id => 'AT01', - vpi => 1, - vci => 20, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Austria") . "|Telstra" => - { - provider_id => 'AT02', - vpi => 8, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Belgium") . "|ADSL Office" => - { - provider_id => 'BE04', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("Belgium") . "|Tiscali BE" => - { - provider_id => 'BE01', - vpi => 8, - vci => 23, - Encapsulation => 6, - method => 'pppoa', - dnsServer2 => '212.35.2.1', - dnsServer3 => '212.35.2.2', - DOMAINNAME2 => 'tiscali.be', - }, - - N("Belgium") . "|Belgacom" => - { - provider_id => 'BE03', - vpi => 8, - vci => 23, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Belgium") . "|Turboline" => - { - provider_id => 'BE02', - vpi => 8, - vci => 23, - Encapsulation => 5, - method => 'pppoa', - }, - - N("Brazil") . "|Speedy/Telefonica" => - { - provider_id => 'BR01', - vpi => 8, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - dnsServer2 => '200.204.0.10', - dnsServer3 => '200.204.0.138', - }, - - N("Brazil") . "|Velox/Telemar" => - { - provider_id => 'BR02', - vpi => 0, - vci => 21, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Brazil") . "|Turbo/Brasil Telecom" => - { - provider_id => 'BR03', - vpi => 0, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Brazil") . "|Rio Grande do Sul (RS)" => - { - provider_id => 'BR04', - vpi => 1, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Bulgaria") . "|BTK ISDN" => - { - provider_id => 'BG02', - vpi => 1, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Bulgaria") . "|BTK POTS" => - { - provider_id => 'BG01', - vpi => 0, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Beijing" => - { - provider_id => 'CN01', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Changchun" => - { - provider_id => 'CN02', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Harbin" => - { - provider_id => 'CN03', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Jilin" => - { - provider_id => 'CN04', - vpi => 0, - vci => 27, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Lanzhou" => - { - provider_id => 'CN05', - vpi => 0, - vci => 20, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Tianjin" => - { - provider_id => 'CN06', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Xi'an" => - { - provider_id => 'CN07', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Chongqing" => - { - provider_id => 'CN08', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Fujian" => - { - provider_id => 'CN09', - vpi => 0, - vci => 0xc8, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Guangxi" => - { - provider_id => 'CN10', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Guangzhou" => - { - provider_id => 'CN11', - vpi => 8, - vci => 20, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Hangzhou" => - { - provider_id => 'CN12', - vpi => 0, - vci => 20, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Netcom|Hunan" => - { - provider_id => 'CN13', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Nanjing" => - { - provider_id => 'CN14', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Shanghai" => - { - provider_id => 'CN15', - vpi => 8, - vci => 51, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Shenzhen" => - { - provider_id => 'CN16', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Urumqi" => - { - provider_id => 'CN17', - vpi => 0, - vci => 20, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Wuhan" => - { - provider_id => 'CN18', - vpi => 0, - vci => 20, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Yunnan" => - { - provider_id => 'CN19', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("China") . "|China Telecom|Zhuhai" => - { - provider_id => 'CN20', - vpi => 0, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("Czech Republic") . "|Cesky Telecom" => - { - provider_id => 'CZ01', - url_tech => 'http://www.telecom.cz/domacnosti/internet/pristupove_sluzby/broadband/vse_o_kz_a_moznostech_instalace.php', - vpi => 8, - vci => 48, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Denmark") . "|Any" => - { - provider_id => 'DK01', - vpi => 0, - vci => 65, - method => 'pppoe', - Encapsulation => 3, - }, - - N("Finland") . "|Sonera" => - { - provider_id => 'FI01', - vpi => 0, - vci => 64, - Encapsulation => 3, - method => 'pppoe', - }, - - N("France") . "|Free non dégroupé 512/128 & 1024/128" => - { - provider_id => 'FR01', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '213.228.0.23', - dnsServer3 => '212.27.32.176', - method => 'pppoa', - DOMAINNAME2 => 'free.fr', - }, - - N("France") . "|Free dégroupé 1024/256 (mini)" => - { - provider_id => 'FR04', - vpi => 8, - vci => 24, - Encapsulation => 4, - dnsServer2 => '213.228.0.23', - dnsServer3 => '212.27.32.176', - method => 'dhcp', - DOMAINNAME2 => 'free.fr', - }, - - N("France") . "|n9uf tel9com 512 & dégroupé 1024" => - { - provider_id => 'FR05', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '212.30.93.108', - dnsServer3 => '212.203.124.146', - method => 'pppoa', - }, - - N("France") . "|Cegetel non dégroupé 512 IP/ADSL et dégroupé" => - { - provider_id => 'FR08', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '212.94.174.85', - dnsServer3 => '212.94.174.86', - method => 'pppoa', - }, - - N("France") . "|Club-Internet" => - { - provider_id => 'FR06', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '194.117.200.10', - dnsServer3 => '194.117.200.15', - method => 'pppoa', - DOMAINNAME2 => 'club-internet.fr', - }, - - N("France") . "|Wanadoo" => - { - provider_id => 'FR09', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '80.10.246.2', - dnsServer3 => '80.10.246.129', - method => 'pppoa', - DOMAINNAME2 => 'wanadoo.fr', - }, - - N("France") . "|Télé2" => - { - provider_id => 'FR02', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '212.151.136.242', - dnsServer3 => '130.244.127.162', - method => 'pppoa', - }, - - N("France") . "|Tiscali.fr 128k" => - { - provider_id => 'FR03', - vpi => 8, - vci => 23, - Encapsulation => 5, - dnsServer2 => '213.36.80.1', - dnsServer3 => '213.36.80.2', - method => 'pppoa', - }, - - N("France") . "|Tiscali.fr 512k" => - { - provider_id => 'FR07', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '213.36.80.1', - dnsServer3 => '213.36.80.2', - method => 'pppoa', - }, - - N("Germany") . "|Deutsche Telekom (DT)" => - { - provider_id => 'DE01', - vpi => 1, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Germany") . "|1&1" => - { - provider_id => 'DE02', - vpi => 1, - vci => 20, - Encapsulation => 1, - dnsServer2 => '195.20.224.234', - dnsServer3 => '194.25.2.129', - method => 'pppoe', - }, - - N("Greece") . "|Any" => - { - provider_id => 'GR01', - vpi => 8, - vci => 23, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Hungary") . "|Matav" => - { - provider_id => 'HU01', - vpi => 1, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Ireland") . "|Any" => - { - provider_id => 'IE01', - vpi => 8, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Israel") . "|Bezeq" => - { - provider_id => 'IL01', - vpi => 8, - vci => 30, - Encapsulation => 6, - dnsServer2 => '192.115.106.10', - dnsServer3 => '192.115.106.11', - method => 'pppoa', - }, - - N("Italy") . "|Libero.it" => - { - provider_id => 'IT04', - url_tech => 'http://internet.libero.it/assistenza/adsl/installazione_ass.phtml', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '193.70.192.25', - dnsServer3 => '193.70.152.25', - method => 'pppoa', - }, - - N("Italy") . "|Telecom Italia" => - { - provider_id => 'IT01', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '195.20.224.234', - dnsServer3 => '194.25.2.129', - method => 'pppoa', - }, - - N("Italy") . "|Telecom Italia/Office Users (ADSL Smart X)" => - { - provider_id => 'IT02', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'static', - }, - - N("Italy") . "|Tiscali.it, Alice" => - { - provider_id => 'IT03', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '195.20.224.234', - dnsServer3 => '194.25.2.129', - method => 'pppoa', - }, - - N("Lithuania") . "|Lietuvos Telekomas" => - { - provider_id => 'LT01', - vpi => 8, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Morocco") . "|Maroc Telecom" => - { - provider_id => 'MA01', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '212.217.0.1', - dnsServer3 => '212.217.0.12', - method => 'pppoa', - }, - - N("Netherlands") . "|KPN" => - { - provider_id => 'NL01', - vpi => 8, - vci => 30, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Netherlands") . "|Eager Telecom" => - { - provider_id => 'NL02', - vpi => 0, - vci => 21, - Encapsulation => 3, - method => 'dhcp', - }, - - N("Netherlands") . "|Tiscali" => - { - provider_id => 'NL03', - vpi => 0, - vci => 22, - Encapsulation => 3, - method => 'dhcp', - }, - - N("Netherlands") . "|Versatel" => - { - provider_id => 'NL04', - vpi => 0, - vci => 20, - Encapsulation => 3, - method => 'dhcp', - }, - - N("Norway") . "|Bluecom" => - { - method => 'dhcp', - }, - - N("Norway") . "|Firstmile" => - { - method => 'dhcp', - }, - - N("Norway") . "|NextGenTel" => - { - method => 'dhcp', - }, - - N("Norway") . "|SSC" => - { - method => 'dhcp', - }, - - N("Norway") . "|Tele2" => - { - method => 'dhcp', - }, - - N("Norway") . "|Telenor ADSL" => - { - method => 'PPPoE', - }, - - N("Norway") . "|Tiscali" => - { - vpi => 8, - vci => 35, - method => 'dhcp', - }, - - N("Poland") . "|Telekomunikacja Polska (TPSA/neostrada)" => - { - provider_id => 'PL01', - vpi => 0, - vci => 23, - Encapsulation => 6, - dnsServer2 => '194.204.152.34', - dnsServer3 => '217.98.63.164', - method => 'pppoa', - }, - - N("Poland") . "|Netia neostrada" => - { - provider_id => 'PL02', - url_tech => 'http://www.netia.pl/?o=d&s=210', - vpi => 8, - vci => 23, - Encapsulation => 1, - dnsServer2 => '195.114.181.130', - dnsServer3 => '195.114.161.61', - method => 'pppoe', - }, - - N("Portugal") . "|PT" => - { - provider_id => 'PT01', - vpi => 0, - vci => 23, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Russia") . "|MTU-Intel" => - { - provider_id => 'RU01', - url_tech => 'http://stream.ru/s-requirements', - vpi => 1, - vci => 50, - Encapsulation => 1, - dnsServer2 => '212.188.4.10', - dnsServer3 => '195.34.32.116', - method => 'pppoe', - }, - - N("Senegal") . "|Sonatel Multimedia Sentoo" => - { - provider_id => 'SN01', - vpi => 0, - vci => 35, - Encapsulation => 6, - method => 'pppoa', - DOMAINNAME2 => 'sentoo.sn', - }, - - N("Slovenia") . "|SiOL" => - { - provider_id => 'SL01', - vpi => 1, - vci => 20, - method => 'pppoe', - Encapsulation => 1, - dnsServer2 => '193.189.160.11', - dnsServer3 => '193.189.160.12', - DOMAINNAME2 => 'siol.net', - }, - - N("Spain") . "|Telefónica IP dinámica" => - { - provider_id => 'ES01', - vpi => 8, - vci => 20, - Encapsulation => 1, - dnsServer2 => '80.58.32.33', - dnsServer3 => '80.58.0.97', - method => 'pppoe', - }, - - N("Spain") . "|Telefónica ip fija" => - { - provider_id => 'ES02', - vpi => 8, - vci => 20, - Encapsulation => 3, - method => 'static', - dnsServer2 => '80.58.32.33', - dnsServer3 => '80.58.0.97', - }, - - N("Spain") . "|Wanadoo/Eresmas Retevision" => - { - provider_id => 'ES03', - vpi => 8, - vci => 23, - Encapsulation => 6, - dnsServer2 => '80.58.0.33', - dnsServer3 => '80.58.32.97', - method => 'pppoa', - }, - - N("Spain") . "|Wanadoo PPPoE" => - { - provider_id => 'ES04', - vpi => 8, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Spain") . "|Wanadoo ip fija" => - { - provider_id => 'ES05', - vpi => 8, - vci => 20, - Encapsulation => 3, - method => 'static', - }, - - N("Spain") . "|Tiscali" => - { - provider_id => 'ES06', - vpi => 1, - vci => 20, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Spain") . "|Arrakis" => - { - provider_id => 'ES07', - vpi => 0, - vci => 23, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Spain") . "|Auna" => - { - provider_id => 'ES08', - vpi => 0, - vci => 23, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Spain") . "|Communitel" => - { - provider_id => 'ES09', - vpi => 0, - vci => 21, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Spain") . "|Euskatel" => - { - provider_id => 'ES10', - vpi => 8, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Spain") . "|Uni2" => - { - provider_id => 'ES11', - vpi => 1, - vci => 21, - Encapsulation => 6, - method => 'pppoa', - }, - - N("Spain") . "|Ya.com PPPoE" => - { - provider_id => 'ES12', - vpi => 8, - vci => 20, - Encapsulation => 1, - method => 'pppoe', - }, - - N("Spain") . "|Ya.com static" => - { - provider_id => 'ES13', - vpi => 8, - vci => 20, - Encapsulation => 3, - method => 'static', - }, - - N("Sweden") . "|Telia" => - { - provider_id => 'SE01', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("Switzerland") . "|Any" => - { - provider_id => 'CH01', - vpi => 8, - vci => 23, - Encapsulation => 3, - method => 'pppoe', - }, - - N("Switzerland") . "|BlueWin / Swisscom" => - { - provider_id => 'CH02', - vpi => 8, - vci => 23, - Encapsulation => 5, - dnsServer2 => '195.186.4.108', - dnsServer3 => '195.186.4.109', - method => 'pppoa', - }, - - N("Switzerland") . "|Tiscali.ch" => - { - provider_id => 'CH03', - vpi => 8, - vci => 23, - Encapsulation => 1, - method => 'pppoa', - }, - - N("Thailand") . "|Asianet" => - { - provider_id => 'TH01', - vpi => 0, - vci => 64, - Encapsulation => 1, - dnsServer2 => '203.144.225.242', - dnsServer3 => '203.144.225.72', - method => 'pppoe', - }, - - N("Tunisia") . "|Planet.tn" => - { - provider_id => 'TH01', - url_tech => 'http://www.planet.tn/', - vpi => 0, - vci => 23, - Encapsulation => 5, - dnsServer2 => '193.95.93.77', - dnsServer3 => '193.95.66.10', - method => 'pppoe', - }, - - N("United Arab Emirates") . "|Etisalat" => - { - provider_id => 'AE01', - vpi => 0, - vci => 32, - Encapsulation => 5, - dnsServer2 => '213.42.20.20', - dnsServer3 => '195.229.241.222', - method => 'pppoa', - }, - - N("United Kingdom") . "|Tiscali UK " => - { - provider_id => 'UK01', - vpi => 0, - vci => 26, - Encapsulation => 6, - dnsServer2 => '212.74.112.66', - dnsServer3 => '212.74.112.67', - method => 'pppoa', - }, - - N("United Kingdom") . "|British Telecom " => - { - provider_id => 'UK02', - vpi => 0, - vci => 26, - Encapsulation => 6, - dnsServer2 => '194.74.65.69', - dnsServer3 => '194.72.9.38', - method => 'pppoa', - }, - - ); - - -1; diff --git a/perl-install/network/dhcpd.pm b/perl-install/network/dhcpd.pm deleted file mode 100644 index 8cf30d5fc..000000000 --- a/perl-install/network/dhcpd.pm +++ /dev/null @@ -1,50 +0,0 @@ -package network::dhcpd; - -use strict; -use common; - -my $sysconf_dhcpd = "$::prefix/etc/sysconfig/dhcpd"; -my $dhcpd_conf_file = "$::prefix/etc/dhcpd.conf"; -my $update_dhcp = "/usr/sbin/update_dhcp.pl"; - -sub read_dhcpd_conf { - my ($o_file) = @_; - my $s = cat_($o_file || $dhcpd_conf_file); - { option_routers => [ $s =~ /^\s*option routers\s+(\S+);/mg ], - subnet_mask => [ if_($s =~ /^\s*option subnet-mask\s+(.*);/mg, split(' ', $1)) ], - domain_name => [ if_($s =~ /^\s*option domain-name\s+"(.*)";/mg, split(' ', $1)) ], - domain_name_servers => [ if_($s =~ /^\s*option domain-name-servers\s+(.*);/m, split(' ', $1)) ], - dynamic_bootp => [ if_($s =~ /^\s*range dynamic-bootp\s+\S+\.(\d+)\s+\S+\.(\d+)\s*;/m, split(' ', $1)) ], - default_lease_time => [ if_($s =~ /^\s*default-lease-time\s+(.*);/m, split(' ', $1)) ], - max_lease_time => [ if_($s =~ /^\s*max-lease-time\s+(.*);/m, split(' ', $1)) ] }; -} - -sub write_dhcpd_conf { - my ($dhcpd_conf, $device) = @_; - - my ($lan) = $dhcpd_conf->{option_routers}[0] =~ /^(.*)\.\d+$/; - log::explanations("Configuring a DHCP server on $lan.0"); - - renamef($dhcpd_conf_file, "$dhcpd_conf_file.old"); - output($dhcpd_conf_file, qq(subnet $lan.0 netmask $dhcpd_conf->{subnet_mask}[0] { - # default gateway - option routers $dhcpd_conf->{option_routers}[0]; - option subnet-mask $dhcpd_conf->{subnet_mask}[0]; - - option domain-name "$dhcpd_conf->{domain_name}[0]"; - option domain-name-servers $dhcpd_conf->{domain_name_servers}[0]; - - range dynamic-bootp $lan.$dhcpd_conf->{dynamic_bootp}[0] $lan.$dhcpd_conf->{dynamic_bootp}[1]; - default-lease-time $dhcpd_conf->{default_lease_time}[0]; - max-lease-time $dhcpd_conf->{max_lease_time}[0]; -} -)); - - #- put the interface for the dhcp server in the sysconfig-dhcp config, for the /etc/init.d script of dhcpd - log::explanations("Update network interfaces list for dhcpd server"); - substInFile { s/^INTERFACES\n//; $_ .= qq(INTERFACES="$device"\n) if eof } $sysconf_dhcpd if !$::testing; - run_program::rooted($::prefix, $update_dhcp); -} - - -1; diff --git a/perl-install/network/drakfirewall.pm b/perl-install/network/drakfirewall.pm deleted file mode 100644 index e67da229b..000000000 --- a/perl-install/network/drakfirewall.pm +++ /dev/null @@ -1,283 +0,0 @@ -package network::drakfirewall; # $Id$ - -use strict; -use diagnostics; - -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 => N_("SSH server"), - pkg => 'openssh-server', - ports => '22/tcp', - }, - { - name => N_("FTP server"), - 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 => N_("Telnet server"), - pkg => 'telnet-server-krb5', - ports => '23/tcp', - hide => 1, - }, - { - name => N_("Windows Files Sharing (SMB)"), - pkg => 'samba-server', - ports => '137/tcp 137/udp 138/tcp 138/udp 139/tcp 139/udp 445/tcp 445/udp 1024:1100/tcp 1024:1100/udp', - hide => 1, - }, - { - name => N_("CUPS server"), - pkg => 'cups', - ports => '631/tcp 631/udp', - hide => 1, - }, - { - name => N_("Echo request (ping)"), - ports => '8/icmp', - force_default_selection => 0, - }, - { - name => N_("BitTorrent"), - ports => '6881:6999/tcp', - hide => 1, - pkg => 'bittorrent bittorrent-shadowsclient', - }, -); - -my @ifw_rules = ( - { - name => N_("Port scan detection"), - ifw_rule => 'psd', - }, -); - -sub port2server { - my ($port) = @_; - find { - any { $port eq $_ } split(' ', $_->{ports}); - } @all_servers; -} - -sub check_ports_syntax { - my ($ports) = @_; - foreach (split ' ', $ports) { - my ($nb, $range, $nb2) = m!^(\d+)(:(\d+))?/(tcp|udp|icmp)$! or return $_; - foreach my $port ($nb, if_($range, $nb2)) { - 1 <= $port && $port <= 65535 or return $_; - } - $nb < $nb2 or return $_ if $range; - } - ''; -} - -sub to_ports { - my ($servers, $unlisted) = @_; - join(' ', (map { $_->{ports} } @$servers), if_($unlisted, $unlisted)); -} - -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 ($do_pkgs) = @_; - my @pkgs = $do_pkgs->are_installed(map { split ' ', $_->{pkg} } @all_servers); - [ grep { - my $s = $_; - exists $s->{force_default_selection} ? - $s->{force_default_selection} : - any { member($_, @pkgs) } split(' ', $s->{pkg}); - } @all_servers ]; -} - -sub default_ports { - my ($do_pkgs) = @_; - to_ports(default_from_pkgs($do_pkgs), ''); -} - -sub get_ports() { - my $shorewall = network::shorewall::read() or return; - $shorewall->{ports}; -} - -sub set_ports { - my ($do_pkgs, $disabled, $ports, $o_in) = @_; - - my $shorewall = network::shorewall::read($o_in) or return; - - if (!$disabled || -x "$::prefix/sbin/shorewall") { - $do_pkgs->ensure_binary_is_installed('shorewall', 'shorewall', $::isInstall) or return; - - $shorewall->{disabled} = $disabled; - $shorewall->{ports} = $ports; - log::l($disabled ? "disabling shorewall" : "configuring shorewall to allow ports: $ports"); - network::shorewall::write($shorewall); - } -} - -sub get_conf { - my ($in, $disabled, $o_ports) = @_; - - my $possible_servers = default_from_pkgs($in->do_pkgs); - $_->{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 Mandriva Linux machine. -For a powerful and dedicated firewall solution, please look to the -specialized Mandriva Security 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_allowed_services { - 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?"), - title => N("Firewall"), - icon => 'banner-security', - advanced_messages => N("You can enter miscellaneous ports. -Valid examples are: 139/tcp 139/udp 600:610/tcp 600:610/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. - -You can also give a range of ports (eg: 24300:24350/udp)", $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, [ grep { $_->{on} } @l ], $unlisted; -} - -sub set_ifw { - my ($do_pkgs, $enabled, $rules, $ports) = @_; - if ($enabled) { - $do_pkgs->ensure_is_installed('mandi-ifw', '/etc/ifw/start', $::isInstall) or return; - - my $ports_by_proto = network::shorewall::ports_by_proto($ports); - output_with_perm("$::prefix/etc/ifw/rules", 0644, map { "$_\n" } ( - (map { "source /etc/ifw/rules.d/$_" } @$rules), - map { - my $proto = $_; - map { - my $multiport = /:/ && " -m multiport"; - "iptables -A Ifw -m state --state NEW -p $proto$multiport --dport $_ -j IFWLOG --log-prefix NEW\n"; - } @{$ports_by_proto->{$proto}}; - } keys %$ports_by_proto, - )); - } - - my $set_in_file = sub { - my ($file, @list) = @_; - substInFile { - foreach my $l (@list) { s|^$l\n|| } - $_ .= join("\n", @list) . "\n" if eof && $enabled; - } "$::prefix/etc/shorewall/$file"; - }; - $set_in_file->('start', "INCLUDE /etc/ifw/start", "INCLUDE /etc/ifw/rules", "iptables -I INPUT 2 -j Ifw"); - $set_in_file->('stop', "iptables -D INPUT -j Ifw", "INCLUDE /etc/ifw/stop"); -} - -sub choose_watched_services { - my ($in, $servers, $unlisted) = @_; - - my @l = (@ifw_rules, @$servers, map { { ports => $_ } } split(' ', $unlisted)); - my $enabled = 1; - $_->{ifw} = 1 foreach @l; - - $in->ask_from_({ - messages => - N("Interactive Firewall") . "\n\n" . - N("You can be warned when someone accesses to a service or tries to intrude into your computer. -Please select which network activity should be watched."), - title => N("Interactive Firewall"), - }, - [ - { text => N("Use Interactive Firewall"), val => \$enabled, type => 'bool' }, - map { { - text => (exists $_->{name} ? translate($_->{name}) : $_->{ports}), - val => \$_->{ifw}, - type => 'bool', disabled => sub { !$enabled }, - } } @l, - ]) or return; - my ($rules, $ports) = partition { exists $_->{ifw_rule} } grep { $_->{ifw} } @l; - set_ifw($in->do_pkgs, $enabled, [ map { $_->{ifw_rule} } @$rules ], to_ports($ports)); -} - -sub main { - my ($in, $disabled) = @_; - - ($disabled, my $servers, my $unlisted) = get_conf($in, $disabled) or return; - - ($disabled, $servers, $unlisted) = choose_allowed_services($in, $disabled, $servers, $unlisted) or return; - - choose_watched_services($in, $servers, $unlisted) unless $disabled; - - my $ports = to_ports($servers, $unlisted); - set_ports($in->do_pkgs, $disabled, $ports, $in) or return; - - ($disabled, $ports); -} diff --git a/perl-install/network/ethernet.pm b/perl-install/network/ethernet.pm deleted file mode 100644 index c97f45f1c..000000000 --- a/perl-install/network/ethernet.pm +++ /dev/null @@ -1,162 +0,0 @@ -package network::ethernet; # $Id$ - -use c; -use detect_devices; -use common; -use run_program; - -our @dhcp_clients = qw(dhclient dhcpcd pump dhcpxd); - -sub install_dhcp_client { - my ($in, $client) = @_; - my %packages = ( - "dhclient" => "dhcp-client", - ); - #- use default dhcp client if none is provided - $client ||= $dhcp_clients[0]; - $client = $packages{$client} if exists $packages{$client}; - $in->do_pkgs->install($client); -} - -sub mapIntfToDevice { - my ($interface) = @_; - my $hw_addr = c::getHwIDs($interface); - return {} if $hw_addr =~ /^usb/; - my ($bus, $slot, $func) = map { hex($_) } ($hw_addr =~ /([0-9a-f]+):([0-9a-f]+)\.([0-9a-f]+)/); - $hw_addr && (every { defined $_ } $bus, $slot, $func) ? - grep { $_->{pci_bus} == $bus && $_->{pci_device} == $slot && $_->{pci_function} == $func } detect_devices::probeall() : {}; -} - - -# return list of [ intf_name, module, device_description ] tuples such as: -# [ "eth0", "3c59x", "3Com Corporation|3c905C-TX [Fast Etherlink]" ] -# -# this function try several method in order to get interface's driver and description in order to support both: -# - hotplug managed devices (USB, firewire) -# - special interfaces (IP aliasing, VLAN) -sub get_eth_cards { - my ($modules_conf) = @_; - my @all_cards = detect_devices::getNet(); - - my @devs = detect_devices::pcmcia_probe(); - my $saved_driver; - # compute device description and return (interface, driver, description) tuples: - return map { - my $interface = $_; - my $description; - # 1) get interface's driver through ETHTOOL ioctl: - my ($a, $detected_through_ethtool); - $a = c::getNetDriver($interface); - if ($a) { - $detected_through_ethtool = 1; - } else { - # 2) get interface's driver through module aliases: - $a = $modules_conf->get_alias($interface); - } - - # workaround buggy drivers that returns a bogus driver name for the GDRVINFO command of the ETHTOOL ioctl: - my %fixes = ( - "p80211_prism2_cs" => 'prism2_cs', - "p80211_prism2_pci" => 'prism2_pci', - "p80211_prism2_usb" => 'prism2_usb', - "ip1394" => "eth1394", - "DL2K" => "dl2k", - "orinoco" => undef, #- should be orinoco_{cs,nortel,pci,plx,tmd} - "hostap" => undef, #- should be hostap_{cs,pci,plx} - ); - if (exists $fixes{$a}) { - $a = $fixes{$a}; - $a or undef $detected_through_ethtool; - } - - # 3) try to match a PCMCIA device for device description: - if (my $b = find { $_->{device} eq $interface } @devs) { # PCMCIA case - $a = $b->{driver}; - $description = $b->{description}; - } else { - # 4) try to lookup a device by hardware address for device description: - # maybe should have we try sysfs first for robustness? - ($description) = (mapIntfToDevice($interface))[0]->{description}; - } - # 5) try to match a device through sysfs for driver & device description: - # (eg: ipw2100 driver for intel centrino do not support ETHTOOL) - if (!$description || !$a) { - my $dev_path = "/sys/class/net/$interface/device"; - my $drv = readlink("$dev_path/driver"); - if ($drv && $drv =~ s!.*/!!) { - $a = $drv unless $detected_through_ethtool; - my $sysfs_fields = detect_devices::get_sysfs_device_id_map($dev_path); - my %l = map { $_ => hex(chomp_(cat_("$dev_path/" . $sysfs_fields->{$_}))) } keys %$sysfs_fields; - my @cards = grep { my $dev = $_; every { $dev->{$_} eq $l{$_} } keys %l } detect_devices::probeall(); - $description ||= $cards[0]{description} if @cards == 1; - } elsif (!$a && -e "/sys/class/net/$interface/wireless") { - # probably a rt2400/rt2500 device (PCI or PCMCIA CardBus) or zd1201 (USB) - # these broken drivers don't create the "device" link - # try to see if rt2400/rt2500/zd1201 is loaded, and assume current wireless device uses it - # FIXME: remove this code as soon as the drivers are fixed - $a = find { -e "/sys/bus/pci/drivers/$_" } qw(rt2400 rt2500); - $a ||= find { -e "/sys/bus/usb/drivers/$_" } qw(zd1201); - } - } - # 6) try to match a device by driver for device description: - # (eg: madwifi, ndiswrapper, ...) - if (!$description) { - my @cards = grep { $_->{driver} eq ($a || $saved_driver) } detect_devices::probeall(); - $description = $cards[0]{description} if @cards == 1; - } - $a and $saved_driver = $a; # handle multiple cards managed by the same driver - [ $interface, $saved_driver, if_($description, $description) ]; - } @all_cards; -} - -sub get_eth_cards_names { - my (@all_cards) = @_; - map { $_->[0] => join(': ', $_->[0], $_->[2]) } @all_cards; -} - -#- returns (link_type, mac_address) -sub get_eth_card_mac_address { - my ($intf) = @_; - #- don't look for 6 bytes addresses only because of various non-standard MAC addresses - `$::prefix/sbin/ip -o link show $intf 2>/dev/null` =~ m|.*link/(\S+)\s((?:[0-9a-f]{2}:?)+)\s|; -} - -#- write interfaces MAC address in iftab -sub update_iftab() { - #- skip aliases interfaces - foreach my $intf (grep { !/:\d+$/ } detect_devices::getNet()) { - my ($link_type, $mac_address) = get_eth_card_mac_address($intf) or next; - #- do not write zeroed MAC addresses in iftab, it confuses ifrename - $mac_address =~ /^[0:]+$/ and next; - # ifrename supports alsa IEEE1394, EUI64 and IRDA - member($link_type, 'ether', 'ieee1394', 'irda', '[27]') or next; - substInFile { - s/^$intf\s+.*\n//; - s/^.*\s+$mac_address\n//; - $_ .= qq($intf mac $mac_address\n) if eof; - } "$::prefix/etc/iftab"; - } -} - -# automatic net aliases configuration -sub configure_eth_aliases { - my ($modules_conf) = @_; - my @pcmcia_interfaces = map { $_->{device} } detect_devices::pcmcia_probe(); - foreach my $card (get_eth_cards($modules_conf)) { - if (member($card->[0], @pcmcia_interfaces)) { - #- do not write aliases for pcmcia cards, or cardmgr will not be loaded - $modules_conf->remove_alias($card->[0]); - } else { - $modules_conf->set_alias($card->[0], $card->[1]); - } - } - $::isStandalone and $modules_conf->write; - update_iftab(); -} - -sub is_ifplugd_blacklisted { - my ($module) = @_; - member($module, qw(forcedeth via-velocity)); -} - -1; diff --git a/perl-install/network/ifw.pm b/perl-install/network/ifw.pm deleted file mode 100644 index 40ff0ac6d..000000000 --- a/perl-install/network/ifw.pm +++ /dev/null @@ -1,141 +0,0 @@ -package network::ifw; - -use Socket; -use common; - -our @ISA = qw(dbus_object); - -sub new { - my ($type, $bus, $filter) = @_; - - my $con = $bus->{connection}; - $con->add_filter($filter); - $con->add_match("type='signal',interface='com.mandriva.monitoring.ifw'"); - - require dbus_object; - my $o = dbus_object::new($type, - $bus, - "com.mandriva.monitoring", - "/com/mandriva/monitoring/ifw", - "com.mandriva.monitoring.ifw"); - dbus_object::set_gtk2_watch($o); - $o; -} - -sub set_blacklist_verdict { - my ($o, $seq, $blacklist) = @_; - $o->call_method('SetBlacklistVerdict', Net::DBus::dbus_uint32($seq), Net::DBus::dbus_uint32($blacklist)); -} - -sub unblacklist { - my ($o, $addr) = @_; - $o->call_method('UnBlacklist', Net::DBus::dbus_uint32($addr)); -} - -sub whitelist { - my ($o, $addr) = @_; - $o->call_method('Whitelist', Net::DBus::dbus_uint32($addr)); -} - -sub unwhitelist { - my ($o, $addr) = @_; - $o->call_method('UnWhitelist', Net::DBus::dbus_uint32($addr)); -} - -sub get_interactive { - my ($o) = @_; - $o->call_method('GetMode'); -} - -sub set_interactive { - my ($o, $mode) = @_; - $o->call_method('SetMode', Net::DBus::dbus_uint32($mode)); -} - -sub get_reports { - my ($o, $o_include_processed) = @_; - $o->call_method('GetReports', Net::DBus::dbus_uint32(to_bool($o_include_processed))); -} - -sub get_blacklist { - my ($o) = @_; - $o->call_method('GetBlacklist'); -} - -sub get_whitelist { - my ($o) = @_; - $o->call_method('GetWhitelist'); -} - -sub clear_processed_reports { - my ($o) = @_; - $o->call_method('ClearProcessedReports'); -} - -sub send_alert_ack { - my ($o) = @_; - $o->call_method('SendAlertAck'); -} - -sub send_manage_request { - my ($o) = @_; - $o->call_method('SendManageRequest'); -} - -sub format_date { - my ($timestamp) = @_; - require c; - c::strftime("%c", localtime($timestamp)); -} - -sub get_service { - my ($port) = @_; - getservbyport($port, undef) || $port; -} - -sub get_protocol { - my ($protocol) = @_; - getprotobynumber($protocol) || $protocol; -} - -sub get_ip_address { - my ($addr) = @_; - inet_ntoa(pack('L', $addr)); -} - -sub resolve_address { - my ($ip_addr) = @_; - #- try to resolve address, timeout after 2 seconds - my $hostname; - eval { - local $SIG{ALRM} = sub { die "ALARM" }; - alarm 2; - $hostname = gethostbyaddr(inet_aton($ip_addr), AF_INET); - alarm 0; - }; - $hostname || $ip_addr; -} - -sub attack_to_hash { - my ($args) = @_; - my $attack = { mapn { $_[0] => $_[1] } [ 'timestamp', 'indev', 'prefix', 'sensor', 'protocol', 'addr', 'port', 'icmp_type', 'seq', 'processed' ], $args }; - $attack->{port} = unpack('S', pack('n', $attack->{port})); - $attack->{date} = format_date($attack->{timestamp}); - $attack->{ip_addr} = get_ip_address($attack->{addr}); - $attack->{hostname} = resolve_address($attack->{ip_addr}); - $attack->{protocol} = get_protocol($attack->{protocol}); - $attack->{service} = get_service($attack->{port}); - $attack->{type} = - $attack->{prefix} eq 'SCAN' ? N("Port scanning") - : $attack->{prefix} eq 'SERV' ? N("Service attack") - : $attack->{prefix} eq 'PASS' ? N("Password cracking") - : N(qq("%s" attack), $attack->{prefix}); - $attack->{msg} = - $attack->{prefix} eq "SCAN" ? N("A port scanning attack has been attempted by %s.", $attack->{hostname}) - : $attack->{prefix} eq "SERV" ? N("The %s service has been attacked by %s.", $attack->{service}, $attack->{hostname}) - : $attack->{prefix} eq "PASS" ? N("A password cracking attack has been attempted by %s.", $attack->{hostname}) - : N(qq(A "%s" attack has been attempted by %s), $attack->{prefix}, $attack->{hostname}); - $attack; -} - -1; diff --git a/perl-install/network/ipsec.pm b/perl-install/network/ipsec.pm deleted file mode 100644 index c0ca7689e..000000000 --- a/perl-install/network/ipsec.pm +++ /dev/null @@ -1,781 +0,0 @@ -package network::ipsec; - - - -use detect_devices; -use run_program; -use common; -use log; - -#- debugg functions ---------- -sub recreate_ipsec_conf { - my ($ipsec, $kernel_version) = @_; - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - print "$ipsec->{$key1}\n" if ! $ipsec->{$key1}{1}; - foreach my $key2 (ikeys %{$ipsec->{$key1}}) { - if ($ipsec->{$key1}{$key2}[0] =~ m/^#/) { - print "\t$ipsec->{$key1}{$key2}[0]\n"; - } elsif ($ipsec->{$key1}{$key2}[0] =~ m/(conn|config|version)/) { - print "$ipsec->{$key1}{$key2}[0] $ipsec->{$key1}{$key2}[1]\n"; - } else { - print "\t$ipsec->{$key1}{$key2}[0]=$ipsec->{$key1}{$key2}[1]\n"; - } - } - } - } else { - #- kernel 2.6 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (! $ipsec->{$key1}{command}) { - print "$ipsec->{$key1}\n"; - } else { - print $ipsec->{$key1}{command} . " " . - $ipsec->{$key1}{src_range} . " " . - $ipsec->{$key1}{dst_range} . " " . - $ipsec->{$key1}{upperspec} . " " . - $ipsec->{$key1}{flag} . " " . - $ipsec->{$key1}{direction} . " " . - $ipsec->{$key1}{ipsec} . "\n\t" . - $ipsec->{$key1}{protocol} . "/" . - $ipsec->{$key1}{mode} . "/" . - $ipsec->{$key1}{src_dest} . "/" . - $ipsec->{$key1}{level} . ";\n"; - } - } - } -} - -sub recreate_racoon_conf { - my ($racoon) = @_; - my $in_a_section = "n"; - my $in_a_proposal_section = "n"; - foreach my $key1 (ikeys %$racoon) { - if ($in_a_proposal_section eq "y") { - print "\t}\n}\n$racoon->{$key1}\n" if ! $racoon->{$key1}{1}; - } elsif ($in_a_section eq "y") { - print "}\n$racoon->{$key1}\n" if ! $racoon->{$key1}{1}; - } else { - print "$racoon->{$key1}\n" if ! $racoon->{$key1}{1}; - } - $in_a_section = "n"; - $in_a_proposal_section = "n"; - foreach my $key2 (ikeys %{$racoon->{$key1}}) { - if ($racoon->{$key1}{$key2}[0] =~ /^path/) { - print "$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1] $racoon->{$key1}{$key2}[2];\n"; - } elsif ($racoon->{$key1}{$key2}[0] =~ /^remote/) { - $in_a_section = "y"; - $in_a_proposal_section = "n"; - print "$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1] {\n"; - } elsif ($racoon->{$key1}{$key2}[0] =~ /^sainfo/) { - $in_a_section = "y"; - $in_a_proposal_section = "n"; - if ($racoon->{$key1}{$key2}[2] && $racoon->{$key1}{$key2}[5]) { - print "$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1] $racoon->{$key1}{$key2}[2] $racoon->{$key1}{$key2}[3] $racoon->{$key1}{$key2}[4] $racoon->{$key1}{$key2}[5] $racoon->{$key1}{$key2}[6] {\n"; - } else { - print "$racoon->{$key1}{$key2}[0] anonymous {\n"; - } - } elsif ($racoon->{$key1}{$key2}[0] =~ /^proposal /) { - $in_a_proposal_section = "y"; - print "\t$racoon->{$key1}{$key2}[0] {\n"; - } elsif ($in_a_section eq "y" && $racoon->{$key1}{$key2}[0] =~ /^certificate_type/) { - print "\t$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1] $racoon->{$key1}{$key2}[2] $racoon->{$key1}{$key2}[3];\n"; - } elsif ($in_a_section eq "y" && $racoon->{$key1}{$key2}[0] =~ /^#/) { - print "\t$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1]\n"; - } elsif ($in_a_section eq "y") { - print "\t$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1];\n"; - } elsif ($in_a_proposal_section eq "y" && $racoon->{$key1}{$key2}[0] =~ /^#/) { - print "\t\t$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1]\n"; - } elsif ($in_a_proposal_section eq "y") { - print "\t\t$racoon->{$key1}{$key2}[0] $racoon->{$key1}{$key2}[1];\n"; - } - } - } - -print "}\n"; -} - -sub recreate_ipsec_conf1_k24 { - my ($ipsec) = @_; - foreach my $key1 (ikeys %$ipsec) { - print "$key1-->$ipsec->{$key1}\n" if ! $ipsec->{$key1}{1}; - foreach my $key2 (ikeys %{$ipsec->{$key1}}) { - if ($ipsec->{$key1}{$key2}[0] =~ m/^#/) { - print "\t$key2-->$ipsec->{$key1}{$key2}[0]\n"; - } elsif ($ipsec->{$key1}{$key2}[0] =~ m/(conn|config|version)/) { - print "$key1-->$key2-->$ipsec->{$key1}{$key2}[0] $ipsec->{$key1}{$key2}[1]\n"; - } else { - print "\t$key2-->$ipsec->{$key1}{$key2}[0]=$ipsec->{$key1}{$key2}[1]\n"; - } - } - } -} -#- end of debug functions -------- - -sub sys { system(@_) == 0 or log::l("[drakvpn] Warning, sys failed for $_[0]") } - -sub start_daemons () { - return if $::testing; - log::explanations("Starting daemons"); - if (-e "/etc/rc.d/init.d/ipsec") { - system("/etc/rc.d/init.d/ipsec status >/dev/null") == 0 and sys("/etc/rc.d/init.d/ipsec stop"); - sys("/etc/rc.d/init.d/$_ start >/dev/null"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'ipsec'; - } else { - - } - sys("/etc/rc.d/init.d/$_ start >/dev/null"), sys("/sbin/chkconfig --level 345 $_ on") foreach 'shorewall'; -} - -sub stop_daemons () { - return if $::testing; - log::explanations("Stopping daemons"); - if (-e "/etc/rc.d/init.d/ipsec") { - foreach (qw(ipsec)) { - system("/etc/rc.d/init.d/$_ status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/$_ stop"); - } - sys("/sbin/chkconfig --level 345 $_ off") && -e "/etc/rc.d/init.d/$_" foreach 'ipsec'; - } - system("/etc/rc.d/init.d/shorewall status >/dev/null 2>/dev/null") == 0 and sys("/etc/rc.d/init.d/shorewall stop >/dev/null"); - -} - -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/$file"; -} - -sub get_config_file { - my ($file) = @_; - map { [ split ' ' ] } grep { !/^#/ } cat_("$::prefix/$file"); -} - - -#------------------------------------------------------------------- -#---------------------- configure racoon_conf ----------------------- -#------------------------------------------------------------------- - -sub read_racoon_conf { - my ($racoon_conf) = @_; - my %conf; - my $nb = 0; #total number - my $i = 0; #nb within a section - my $in_a_section = "n"; - my @line1; - my $line = ""; - local $_; - open(my $LIST, "< $racoon_conf"); - while (<$LIST>) { - chomp($_); - $line = $_; - $in_a_section = "n" if $line =~ /}/ && $line !~ /^#/; - $line =~ s/^\s+|\s*;|\s*{//g if $line !~ /^#/; - $line =~ /(.*)#(.*)/ if $line !~ /^#/; #- define before and after comment -# print "--line-->$line\n"; - my $data_part = $1; - my $comment_part = "#" . $2; - if ($data_part) { - $data_part =~ s/,//g; -# print "@@".$data_part."->".$comment_part."\n"; - @line1 = split /\s+/,$data_part; - @line1 = (@line1, $comment_part) if $comment_part; - } else { - @line1 = split /\s+/,$line; - } - if (!$line && $in_a_section eq "n") { - $nb++; - put_in_hash(\%conf, { $nb => $line }); - $in_a_section = "n"; - } elsif (!$line && $in_a_section eq "y") { - put_in_hash($conf{$nb} ||= {}, { $i => [ '' ] }); - $i++; - } elsif ($line =~ /^path/) { - $i=1; - $nb++; - put_in_hash($conf{$nb} ||= {}, { $i => [@line1] }); - $in_a_section = "n"; - $i++; - } elsif ($line =~ /^#|^{|^}/) { - if ($in_a_section eq "y") { - put_in_hash($conf{$nb} ||= {}, { $i => [$line] }); - $i++; - } else { - $nb++; - put_in_hash(\%conf, { $nb => $line }); - $in_a_section = "n"; - } - } elsif ($line =~ /^sainfo|^remote|^listen|^timer|^padding/ && $in_a_section eq "n") { - $i=1; - $nb++; - put_in_hash($conf{$nb} ||= {}, { $i => [@line1] }); - $in_a_section = "y"; - $i++; - } elsif ($line eq "proposal" && $in_a_section eq "y") { - $i=1; - $nb++; - put_in_hash($conf{$nb} ||= {}, { $i => [@line1] }); - $in_a_section = "y"; - $i++; - } else { - put_in_hash($conf{$nb} ||= {}, { $i => [@line1] }); - $i++; - } - } - -\%conf; -} - -sub display_racoon_conf { - my ($racoon) = @_; - my $display = ""; - my $prefix_to_simple_line = ""; - foreach my $key1 (ikeys %$racoon) { - if (!$racoon->{$key1}{1}) { - $display .= $prefix_to_simple_line . $racoon->{$key1} . "\n"; - $prefix_to_simple_line = ""; - } else { - foreach my $key2 (ikeys %{$racoon->{$key1}}) { - my $t = $racoon->{$key1}{1}[0]; - my $f = $racoon->{$key1}{$key2}[0]; - my $list_length = scalar @{$racoon->{$key1}{$key2}}; - my $line = ""; - - if ($racoon->{$key1}{$key2}[0] eq "sainfo" && !$racoon->{$key1}{$key2}[2]) { - $line = "sainfo anonymous"; - } else { - for (my $i = 0; $i <= $list_length-1; $i++) { - - my $c = $racoon->{$key1}{$key2}[$i]; - my $n = $racoon->{$key1}{$key2}[$i+1]; - - if ($c =~ /^path|^log|^timer|^listen|^padding|^remote|^proposal|^sainfo/) { - $line .= "$c "; - } elsif ($i == $list_length-2 && $n =~ /^#/) { - $line .= "$c; "; - } elsif ($i == $list_length-1) { - if ($f =~ /^#|^$|^timer|^listen|^padding|^remote|^proposal\s+|^sainfo/) { - $line .= $c; - } elsif ($c =~ /^#/) { - $line .= "\t$c"; - } else { - $line .= "$c;"; - } - } else { - $line .= "$c "; - } - } - } - - if ($f =~ /^timer|^listen|^padding|^remote|^sainfo/) { - $line .= " {"; - $prefix_to_simple_line = ""; - } elsif ($f eq "proposal") { - $line = "\t" . $line . " {"; - } elsif ($t eq "proposal") { - $line = "\t\t" . $line if $line ne "proposal"; - $prefix_to_simple_line = "\t"; - } else { - $line = "\t" . $line if $t !~ /^path|^log/; - $prefix_to_simple_line = ""; - } - $display .= "$line\n"; - } - } - } - -$display; - -} - -sub write_racoon_conf { - my ($racoon_conf, $racoon) = @_; - my $display = ""; - my $prefix_to_simple_line = ""; - foreach my $key1 (ikeys %$racoon) { - if (!$racoon->{$key1}{1}) { - $display .= $prefix_to_simple_line . $racoon->{$key1} . "\n"; - $prefix_to_simple_line = ""; - } else { - foreach my $key2 (ikeys %{$racoon->{$key1}}) { - my $t = $racoon->{$key1}{1}[0]; - my $f = $racoon->{$key1}{$key2}[0]; - my $list_length = scalar @{$racoon->{$key1}{$key2}}; - my $line = ""; - - if ($racoon->{$key1}{$key2}[0] eq "sainfo" && !$racoon->{$key1}{$key2}[2]) { - $line = "sainfo anonymous"; - } else { - for (my $i = 0; $i <= $list_length-1; $i++) { - - my $c = $racoon->{$key1}{$key2}[$i]; - my $n = $racoon->{$key1}{$key2}[$i+1]; - - if ($c =~ /^path|^log|^timer|^listen|^padding|^remote|^proposal|^sainfo/) { - $line .= "$c "; - } elsif ($i == $list_length-2 && $n =~ /^#/) { - $line .= "$c; "; - } elsif ($i == $list_length-1) { - if ($f =~ /^#|^$|^timer|^listen|^padding|^remote|^proposal\s+|^sainfo/) { - $line .= $c; - } elsif ($c =~ /^#/) { - $line .= "\t$c"; - } else { - $line .= "$c;"; - } - } else { - $line .= "$c "; - } - } - } - - if ($f =~ /^timer|^listen|^padding|^remote|^sainfo/) { - $line .= " {"; - $prefix_to_simple_line = ""; - } elsif ($f eq "proposal") { - $line = "\t" . $line . " {"; - } elsif ($t eq "proposal") { - $line = "\t\t" . $line if $line ne "proposal"; - $prefix_to_simple_line = "\t"; - } else { - $line = "\t" . $line if $t !~ /^path|^log/; - $prefix_to_simple_line = ""; - } - $display .= "$line\n"; - } - } - } - -open(my $ADD, "> $racoon_conf") or die "Can not open the $racoon_conf file for writing"; - print $ADD "$display\n"; - -} - -sub get_section_names_racoon_conf { - my ($racoon) = @_; - my @section_names; - - foreach my $key1 (ikeys %$racoon) { - if (!$racoon->{$key1}{1}) { - next; - } else { - my $list_length = scalar @{$racoon->{$key1}{1}}; - my $section_title = ""; - my $separator = ""; - for (my $i = 0; $i <= $list_length-1; $i++) { - my $s = $racoon->{$key1}{1}[$i]; - if ($s !~ /^#|^proposal/) { - $section_title .= $separator . $s; - $separator = " "; - } - } - push(@section_names, $section_title) if $section_title ne ""; - } - } - - @section_names; - -} - -sub add_section_racoon_conf { - my ($new_section, $racoon) = @_; - put_in_hash($racoon, { max(keys %$racoon) + 1 => '' }); - put_in_hash($racoon, { max(keys %$racoon) + 1 => $new_section }); - put_in_hash($racoon, { max(keys %$racoon) + 1 => '}' }) if $new_section->{1}[0] !~ /^path|^remote/; - put_in_hash($racoon, { max(keys %$racoon) + 1 => '' }) if $new_section->{1}[0] =~ /^proposal/; - put_in_hash($racoon, { max(keys %$racoon) + 1 => '}' }) if $new_section->{1}[0] =~ /^proposal/; -} - -sub matched_section_key_number_racoon_conf { - my ($section_name, $racoon) = @_; - foreach my $key1 (ikeys %$racoon) { - if (!$racoon->{$key1}{1}) { - next; - } else { - my $list_length = scalar @{$racoon->{$key1}{1}}; - my $section_title = ""; - my $separator = ""; - for (my $i = 0; $i <= $list_length-1; $i++) { - my $s = $racoon->{$key1}{1}[$i]; - if ($s !~ /^#|^proposal/) { - $section_title .= $separator . $s; - $separator = " "; - } - } - if ($section_title eq $section_name) { - return $key1; - } - } - } - -} - -sub already_existing_section_racoon_conf { - my ($section_name, $racoon, $racoon_conf) = @_; - if (-e $racoon_conf) { - foreach my $key1 (ikeys %$racoon) { - if (!$racoon->{$key1}{1}) { - next; - } elsif (find { - my $list_length = scalar @{$racoon->{$key1}{1}}; - my $section_title = ""; - my $separator = ""; - for (my $i = 0; $i <= $list_length-1; $i++) { - my $s = $racoon->{$key1}{1}[$i]; - if ($s !~ /^#|^proposal/) { - $section_title .= $separator . $s; - $separator = " "; - } - } - - $section_title eq $section_name; - - } ikeys %{$racoon->{$key1}}) { - - return "already existing"; - } - } - } - -} - -sub remove_section_racoon_conf { - my ($section_name, $racoon, $k) = @_; - if ($section_name =~ /^remote/) { - - delete $racoon->{$k} if $k > 1 && !$racoon->{$k-1}; - my $closing_curly_bracket = 0; - while ($closing_curly_bracket < 2) { - print "-->$k\n"; - $closing_curly_bracket++ if $racoon->{$k} eq "}"; - delete $racoon->{$k}; - $k++; - } - - } elsif ($section_name =~ /^path/) { - - delete $racoon->{$k}; - delete $racoon->{$k+1} if $racoon->{$k+1}{1} eq ""; - - } else { - - delete $racoon->{$k}; - delete $racoon->{$k+1} if $racoon->{$k+1}{1} eq ""; - delete $racoon->{$k+2} if $racoon->{$k+2}{1} eq ""; #- remove assoc } - - } - -} - -#------------------------------------------------------------------- -#---------------------- configure ipsec_conf ----------------------- -#------------------------------------------------------------------- - -sub read_ipsec_conf { - my ($ipsec_conf, $kernel_version) = @_; - my %conf; - my $nb = 0; #total number - my $i = 0; #nb within a connexion - my $in_a_conn = "n"; - my $line = ""; - my @line1; - local $_; - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - open(my $LIST, "< $ipsec_conf"); #or die "Can not open the $ipsec_conf file for reading"; - while (<$LIST>) { - chomp($_); - $line = $_; - $line =~ s/^\s+//; - if (!$line) { - $nb++; - put_in_hash(\%conf, { $nb => $line }); - $in_a_conn = "n"; - } elsif ($line =~ /^#/) { - if ($in_a_conn eq "y") { - put_in_hash($conf{$nb} ||= {}, { $i => [$line] }); - $i++; - } else { - $nb++; - put_in_hash(\%conf, { $nb => $line }); - $in_a_conn = "n"; - } - } elsif ($line =~ /^conn|^config|^version/ && $in_a_conn eq "n") { - @line1 = split /\s+/,$line; - $i=1; - $nb++; - put_in_hash($conf{$nb} ||= {}, { $i => [$line1[0], $line1[1]] }); - $in_a_conn = "y" if $line !~ /^version/; - $i++; - } elsif ($line =~ /^conn|^config|^version/ && $in_a_conn eq "y") { - @line1 = split /\s+/,$line; - $i=1; - $nb++; - put_in_hash($conf{$nb} ||= {}, { $i => [$line1[0], $line1[1]] }); - $i++; - } else { - @line1 = split /=/,$line; - put_in_hash($conf{$nb} ||= {}, { $i => [$line1[0], $line1[1]] }); - $i++; - } - } - - } else { - #- kernel 2.6 part ------------------------------- - my @mylist; - my $myline = ""; - open(my $LIST, "< $ipsec_conf"); #or die "Can not open the $ipsec_conf file for reading"; - while (<$LIST>) { - chomp($_); - $myline = $_; - $myline =~ s/^\s+//; - $myline =~ s/;$//; - if ($myline =~ /^spdadd/) { - @mylist = split /\s+/,$myline; - $in_a_conn = "y"; - $nb++; - next; - } elsif ($in_a_conn eq "y") { - @mylist = (@mylist, split '\s+|/',$myline); - put_in_hash(\%conf, { $nb => { command => $mylist[0], - src_range => $mylist[1], - dst_range => $mylist[2], - upperspec => $mylist[3], - flag => $mylist[4], - direction => $mylist[5], - ipsec => $mylist[6], - protocol => $mylist[7], - mode => $mylist[8], - src_dest => $mylist[9], - level => $mylist[10] } }); - $in_a_conn = "n"; - } else { - $nb++; - put_in_hash(\%conf, { $nb => $myline }); - } - } - - } - - \%conf; -} - -sub write_ipsec_conf { - my ($ipsec_conf, $ipsec, $kernel_version) = @_; - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - open(my $ADD, "> $ipsec_conf") or die "Can not open the $ipsec_conf file for writing"; - foreach my $key1 (ikeys %$ipsec) { - print $ADD "$ipsec->{$key1}\n" if ! $ipsec->{$key1}{1}; - foreach my $key2 (ikeys %{$ipsec->{$key1}}) { - if ($ipsec->{$key1}{$key2}[0] =~ m/^#/) { - print $ADD "\t$ipsec->{$key1}{$key2}[0]\n"; - } elsif ($ipsec->{$key1}{$key2}[0] =~ m/(^conn|^config|^version)/) { - print $ADD "$ipsec->{$key1}{$key2}[0] $ipsec->{$key1}{$key2}[1]\n"; - } else { - print $ADD "\t$ipsec->{$key1}{$key2}[0]=$ipsec->{$key1}{$key2}[1]\n" if $ipsec->{$key1}{$key2}[0] && $ipsec->{$key1}{$key2}[1]; - } - } - } - } else { - #- kernel 2.6 part ------------------------------- - my $display = ""; - foreach my $key1 (ikeys %$ipsec) { - if (! $ipsec->{$key1}{command}) { - $display .= "$ipsec->{$key1}\n"; - } else { - $display .= $ipsec->{$key1}{command} . " " . - $ipsec->{$key1}{src_range} . " " . - $ipsec->{$key1}{dst_range} . " " . - $ipsec->{$key1}{upperspec} . " " . - $ipsec->{$key1}{flag} . " " . - $ipsec->{$key1}{direction} . " " . - $ipsec->{$key1}{ipsec} . "\n\t" . - $ipsec->{$key1}{protocol} . "/" . - $ipsec->{$key1}{mode} . "/" . - $ipsec->{$key1}{src_dest} . "/" . - $ipsec->{$key1}{level} . ";\n"; - } - } - open(my $ADD, "> $ipsec_conf") or die "Can not open the $ipsec_conf file for writing"; - print $ADD $display; - } -} - -sub display_ipsec_conf { - my ($ipsec, $kernel_version) = @_; - my $display = ""; - - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - $display .= "$ipsec->{$key1}\n" if ! $ipsec->{$key1}{1}; - foreach my $key2 (ikeys %{$ipsec->{$key1}}) { - if ($ipsec->{$key1}{$key2}[0] =~ m/^#/) { - $display .= "\t$ipsec->{$key1}{$key2}[0]\n"; - } elsif ($ipsec->{$key1}{$key2}[0] =~ m/(^conn|^config|^version)/) { - $display .= "$ipsec->{$key1}{$key2}[0] $ipsec->{$key1}{$key2}[1]\n"; - } else { - $display .= "\t$ipsec->{$key1}{$key2}[0]=$ipsec->{$key1}{$key2}[1]\n"; - } - } - } - - } else { - #- kernel 2.6 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (! $ipsec->{$key1}{command}) { - $display .= "$ipsec->{$key1}\n"; - } else { - $display .= $ipsec->{$key1}{command} . " " . - $ipsec->{$key1}{src_range} . " " . - $ipsec->{$key1}{dst_range} . " " . - $ipsec->{$key1}{upperspec} . " " . - $ipsec->{$key1}{flag} . " " . - $ipsec->{$key1}{direction} . " " . - $ipsec->{$key1}{ipsec} . "\n\t" . - $ipsec->{$key1}{protocol} . "/" . - $ipsec->{$key1}{mode} . "/" . - $ipsec->{$key1}{src_dest} . "/" . - $ipsec->{$key1}{level} . ";\n"; - } - } - - } - - $display; - -} - -sub get_section_names_ipsec_conf { - my ($ipsec, $kernel_version) = @_; - my @section_names; - - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - foreach my $key2 (ikeys %{$ipsec->{$key1}}) { - if ($ipsec->{$key1}{$key2}[0] =~ m/(^conn|^config|^version)/) { - push(@section_names, "$ipsec->{$key1}{$key2}[0] $ipsec->{$key1}{$key2}[1]"); - } - } - } - - } else { - #- kernel 2.6 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if ($ipsec->{$key1}{command} =~ m/(^spdadd)/) { - push(@section_names, "$ipsec->{$key1}{src_range} $ipsec->{$key1}{dst_range}"); - } - } - } - - @section_names; - -} - -sub remove_section_ipsec_conf { - my ($section_name, $ipsec, $kernel_version) = @_; - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (find { - my $s = $ipsec->{$key1}{$_}[0]; - $s !~ /^#/ && $s =~ m/(^conn|^config|^version)/ && - $section_name eq "$s $ipsec->{$key1}{$_}[1]"; - } ikeys %{$ipsec->{$key1}}) { - delete $ipsec->{$key1}; - } - } - } else { - #- kernel 2.6 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (find { - my $s = "$ipsec->{$key1}{src_range} $ipsec->{$key1}{dst_range}"; - $s !~ /^#/ && $ipsec->{$key1}{src_range} && $section_name eq $s; - } ikeys %{$ipsec->{$key1}}) { - delete $ipsec->{$key1-1}; - delete $ipsec->{$key1}; - } - } - } -} - -sub add_section_ipsec_conf { - my ($new_section, $ipsec) = @_; - put_in_hash($ipsec, { max(keys %$ipsec) + 1 => '' }); - put_in_hash($ipsec, { max(keys %$ipsec) + 1 => $new_section }); -} - -sub already_existing_section_ipsec_conf { - my ($section_name, $ipsec, $kernel_version) = @_; - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (find { - my $s = $ipsec->{$key1}{$_}[0]; - $s !~ /^#/ && $s =~ m/(^conn|^config|^version)/ && - $section_name eq "$s $ipsec->{$key1}{$_}[1]"; - } ikeys %{$ipsec->{$key1}}) { - return "already existing"; - } - } - } else { - #- kernel 2.6 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (find { - my $s = "$ipsec->{$key1}{src_range} $ipsec->{$key1}{dst_range}"; - $s !~ /^#/ && $ipsec->{$key1}{src_range} && - $section_name eq $s; - } ikeys %{$ipsec->{$key1}}) { - return "already existing"; - } - } - } - return "no"; -} - -#- returns the reference to the dynamical list for editing -sub dynamic_list { - my ($number, $ipsec) = @_; - my @list = map { { label => $ipsec->{$number}{$_}[0] . "=", - val => \$ipsec->{$number}{$_}[1] } } ikeys %{$ipsec->{$number}}; - - @list; -} - -#- returns the hash key number of $section_name -sub matched_section_key_number_ipsec_conf { - my ($section_name, $ipsec, $kernel_version) = @_; - if ($kernel_version < 2.5) { - #- kernel 2.4 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (find { - my $s = $ipsec->{$key1}{$_}[0]; - $s !~ /^#/ && $s =~ m/(^conn|^config|^version)/ && - $section_name eq "$s $ipsec->{$key1}{$_}[1]"; - } ikeys %{$ipsec->{$key1}}) { - return $key1; - } - } - } else { - #- kernel 2.6 part ------------------------------- - foreach my $key1 (ikeys %$ipsec) { - if (find { - my $s = "$ipsec->{$key1}{src_range} $ipsec->{$key1}{dst_range}"; - $s !~ /^#/ && $ipsec->{$key1}{src_range} && - $section_name eq $s; - } ikeys %{$ipsec->{$key1}}) { - return $key1; - } - } - } -} -1 diff --git a/perl-install/network/isdn.pm b/perl-install/network/isdn.pm deleted file mode 100644 index 740741b16..000000000 --- a/perl-install/network/isdn.pm +++ /dev/null @@ -1,193 +0,0 @@ -package network::isdn; # $Id$ - -use strict; -use network::isdn_consts; -use common; -use modules; -use run_program; -use log; -use network::tools; -use services; - - -sub write_config { - my ($in, $isdn) = @_; - $in->do_pkgs->install('isdn4net', if_($isdn->{speed} =~ /128/, 'ibod'), 'isdn4k-utils'); - - 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}" -I4L_IDLETIME="$isdn->{huptimeout}" -) . 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}" -I4L_PROTOCOL="$isdn->{protocol}" -); - - output "$::prefix/etc/ppp/ioptions", - "lock -usepeerdns -defaultroute -"; - - services::stop("isdn4linux"); #- to be stopped before capi is loaded - if ($isdn->{driver} eq "capidrv") { - setup_capi_conf($in, get_capi_card($in, $isdn)); - services::enable('capi4linux'); - } else { - services::disable('capi4linux'); - } - services::enable('isdn4linux'); - - network::tools::write_secret_backend($isdn->{login}, $isdn->{passwd}); - - 1; -} - - -sub setup_capi_conf { - my ($in, $capi_card) = @_; - - $in->do_pkgs->ensure_is_installed('isdn4k-utils', "/etc/rc.d/init.d/capi4linux"); #- capi4linux service - is_module_installed($capi_card->{driver}) or $in->do_pkgs->install(@{$capi_card->{packages}}); - if ($capi_card->{firmware} && ! -f "$::prefix/usr/lib/isdn/$capi_card->{firmware}") { - $in->do_pkgs->install("$capi_card->{driver}-firmware"); - } - - #- stop capi4linux before new config is written so that it can unload the driver - services::stop("capi4linux"); - - my $capi_conf; - my $firmware = $capi_card->{firmware} || '-'; - if ($capi_card->{driver} eq "fcclassic") { - $capi_conf = "fcclassic - - 0x300 5 - -\n# adjust IRQ and IO !! ^^^^^ ^^^\n"; - } elsif ($capi_card->{driver} eq "fcpnp") { - $capi_conf = "fcpnp - - 0x300 5 - -\n# adjust IRQ and IO !! ^^^^^ ^^^\n"; - } else { - $capi_conf = "$capi_card->{driver} $firmware - - - - -\n"; - } - output("$::prefix/etc/capi.conf", $capi_conf); -} - -sub read_config { - my ($isdn) = @_; - - my %match = (I4L_USERNAME => 'login', - I4L_LOCALMSN => 'phone_in', - I4L_REMOTE_OUT => 'phone_out', - I4L_DIALMODE => 'dialing_mode', - I4L_IDLETIME => 'huptimeout', - 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{$_} && $conf{$_}; - } - } - - $isdn->{passwd} = network::tools::passwd_by_login($isdn->{login}); -} - -my $file = "$ENV{SHARE_PATH}/ldetect-lst/isdn.db"; -$file = "$::prefix$file" if !-e $file; - -sub get_info_providers_backend { - my ($isdn, $name) = @_; - $name eq N("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 read_providers_backend() { map { /(.*?)=>/ } catMaybeCompressed($file) } - - -sub detect_backend { - my ($modules_conf) = @_; - my @isdn; - require detect_devices; - each_index { - my $c = $_; - my $isdn = { map { $_ => $c->{$_} } qw(description vendor id driver card_type type) }; - $isdn->{intf_id} = $::i; - $isdn->{$_} = sprintf("%0x", $isdn->{$_}) foreach 'vendor', 'id'; - $isdn->{card_type} = $c->{bus} eq 'USB' ? 'usb' : 'pci'; - $isdn->{description} =~ s/.*\|//; -# $c->{options} !~ /id=HiSax/ && $isdn->{driver} eq "hisax" and $c->{options} .= " id=HiSax"; - if ($c->{options} !~ /protocol=/ && $isdn->{protocol} =~ /\d/) { - $modules_conf->set_options($c->{driver}, $c->{options} . " protocol=" . $isdn->{protocol}); - } - $c->{options} =~ /protocol=(\d)/ and $isdn->{protocol} = $1; - push @isdn, $isdn; - } modules::probe_category('network/isdn'); - \@isdn; -} - -sub get_cards_by_type { - my ($isdn_type) = @_; - grep { $_->{card} eq $isdn_type } @isdndata; -} - - -sub get_cards() { - my %buses = ( - isa => N("ISA / PCMCIA") . "/" . N("I do not know"), - pci => N("PCI"), - usb => N("USB"), - ); - # pmcia alias (we should really split up pcmcia from isa in isdn db): - $buses{pcmcia} = $buses{isa}; - - map { $buses{$_->{card}} . "|" . $_->{description} => $_ } @isdndata; -} - - -sub is_module_installed { - my ($driver) = @_; - find { m!/\Q$driver\E\.k?o! } cat_($::prefix . '/lib/modules/' . c::kernel_version() . '/modules.dep'); -} - - -sub get_capi_card { - my ($in, $isdn) = @_; - - my $capi_card = find { - hex($isdn->{vendor}) == $_->{vendor} && hex($isdn->{id}) == $_->{id}; - } @isdn_capi or return; - - #- check if the capi driver is available - unless (is_module_installed($capi_card->{driver}) || ($capi_card->{packages} = $in->do_pkgs->check_kernel_module_packages("$capi_card->{driver}-kernel"))) { - log::explanations("a capi driver ($capi_card->{driver}) exists to replace $isdn->{driver}, but it is not installed and no packages provide it"); - return; - } - - $capi_card; -} - -1; diff --git a/perl-install/network/isdn_consts.pm b/perl-install/network/isdn_consts.pm deleted file mode 100644 index b2361febc..000000000 --- a/perl-install/network/isdn_consts.pm +++ /dev/null @@ -1,460 +0,0 @@ -package network::isdn_consts; # $Id$ -use vars qw(@ISA @EXPORT); -@ISA = qw(Exporter); -@EXPORT = qw(@isdndata @isdn_capi); - -our @isdndata = - ( - { description => "Teles|16.0", #1 irq, mem, io - driver => 'hisax', - type => '1', - irq => '5', - mem => '0xd000', - io => '0xd80', - card => 'isa', - }, - { description => "Teles|8.0", #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|Generic (ISA PnP)", #4 irq, io0 (ISAC), io1 (HSCX) - driver => 'hisax', - type => '4', - irq => '5', - io0 => '0x0000', - io1 => '0x0000', - card => 'isa', - }, - { description => "Teles|generic", #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", #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", #7 irq, io (from isapnp setup) - driver => 'hisax', - type => '7', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "ELSA|Quickstep 1000", #18 no parameter - driver => 'hisax', - type => '18', - card => 'pci', - }, - { description => "ELSA|Quickstep 3000", #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", #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", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "Eicon.Diehl|Diva 20PRO", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "Eicon.Diehl|Diva 20_U", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "Eicon.Diehl|Diva 20PRO_U", #11 no parameter - driver => 'hisax', - type => '11', - card => 'pci', - }, - { description => "ASUS|COM ISDNLink", #12 irq, io (from isapnp setup) - driver => 'hisax', - type => '12', - irq => '5', - io => '0x200', - card => 'isa', - }, - { description => "ASUS|COM ISDNLink", - driver => 'hisax', - type => '35', - card => 'pci', - }, - { description => "DynaLink|Any", - driver => 'hisax', - type => '12', - card => 'pci', - }, - { description => "DynaLink|IS64PH, ASUSCOM", #36 - driver => 'hisax', - type => '36', - card => 'pci', - }, - { description => "HFC|2BS0 based cards", #13 irq, io - driver => 'hisax', - type => '13', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "HFC|2BDS0", #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", #15 irq, io - driver => 'hisax', - type => '15', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Sedlbauer|PC/104", #15 irq, io - driver => 'hisax', - type => '15', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Sedlbauer|Speed Card", #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+", #28 no parameter - driver => 'hisax', - type => '28', - card => 'pci', - firmware => '/usr/lib/isdn/ISAR.BIN', - }, - { description => "USR|Sportster internal", #16 irq, io - driver => 'hisax', - type => '16', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Generic|MIC card", #17 irq, io - driver => 'hisax', - type => '17', - irq => '9', - io => '0xd80', - card => 'isa', - }, - { description => "Compaq|ISDN S0 card", #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 => "Generic|NETjet card", #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", ##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 generic", #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!)", #27 no parameter - driver => 'hisax', - type => '27', - card => 'pci', - }, - { description => "AVM|B1", - 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", #32 none - driver => 'hisax', - type => '32', - card => 'pci', - }, - { description => "Scitel|Quadro", #33 subcontroller (4*S0, subctrl 1...4) - driver => 'hisax', - type => '33', - card => 'pci', - }, - { description => "Gazel|ISDN cards", #34 irq,io - driver => 'hisax', - type => '34', - irq => '5', - io => '0x300', - card => 'isa', - }, - { description => "Gazel|Gazel ISDN cards", #34 none - driver => 'hisax', - type => '34', - card => 'pci', - }, - { description => "Winbond|W6692 and Winbond based cards", #36 none - driver => 'hisax', - type => '36', - card => 'pci', - }, - { description => "BeWAN|R834", - driver => 'hisax_st5481', - type => '99', - card => 'usb', - }, - { description => "Gazel|128", - driver => 'hisax_st5481', - type => '99', - card => 'usb', - }, - ); - -#- cards than can be used with capi drivers -our @isdn_capi = - ( - { - vendor => 0x1131, - id => 0x5402, - description => 'AVM Audiovisuelles|Fritz DSL ISDN/DSL Adapter', - bus => 'PCI', - driver => 'fcdsl', - firmware => 'fdslbase.bin' - }, - { - vendor => 0x1244, - id => 0x0a00, - description => 'AVM Audiovisuelles|A1 ISDN Adapter [Fritz] CAPI', - bus => 'PCI', - driver => 'fcpci' - }, - { - vendor => 0x1244, - id => 0x0e00, - description => 'AVM Audiovisuelles|A1 ISDN Adapter [Fritz] CAPI', - bus => 'PCI', - driver => 'fcpci' - }, - { - vendor => 0x1244, - id => 0x0f00, - description => 'AVM Audiovisuelles|Fritz DSL ISDN/DSL Adapter', - bus => 'PCI', - driver => 'fcdsl', - firmware => 'fdslbase.bin' - }, - { - vendor => 0x1244, - id => 0x2700, - description => 'AVM Audiovisuelles|Fritz!Card DSL SL', - bus => 'PCI', - driver => 'fcdslsl', - firmware => 'fdssbase.bin' - }, - { - vendor => 0x1244, - id => 0x2900, - description => 'AVM Audiovisuelles|Fritz DSL Ver. 2.0', - bus => 'PCI', - driver => 'fcdsl2', - firmware => 'fds2base.bin' - }, - { - vendor => 0x057c, - id => 0x0c00, - description => 'AVM GmbH|FritzCard USB ISDN TA', - bus => 'USB', - driver => 'fcusb' - }, - { - vendor => 0x057c, - id => 0x1000, - description => 'AVM GmbH|FritzCard USB 2 Ver. 2.0 ISDN TA', - bus => 'USB', - driver => 'fcusb2', - firmware => 'fus2base.frm' - }, - { - vendor => 0x057c, - id => 0x1900, - description => 'AVM GmbH|FritzCard USB 2 Ver. 3.0 ISDN TA', - bus => 'USB', - driver => 'fcusb2', - firmware => 'fus3base.frm' - }, - { - vendor => 0x057c, - id => 0x2000, - description => 'AVM GmbH|Fritz X USB ISDN TA', - bus => 'USB', - driver => 'fxusb' - }, - { - vendor => 0x057c, - id => 0x2300, - description => 'AVM GmbH|FtitzCard USB DSL ISDN TA/ DSL Modem', - bus => 'USB', - driver => 'fcdslusb', - firmware => 'fdsubase.frm' - }, - { - vendor => 0x057c, - id => 0x2800, - description => 'AVM GmbH|Fritz X USB OEM ISDN TA', - bus => 'USB', - driver => 'fxusb_CZ' - }, - { - vendor => 0x057c, - id => 0x3000, - description => 'AVM GmbH|FtitzCard USB DSL SL USB', - bus => 'USB', - driver => 'fcdslusba', - firmware => 'fdlabase.frm' - }, - { - vendor => 0x057c, - id => 0x3500, - description => 'AVM GmbH|FtitzCard USB DSL SL USB Analog', - bus => 'USB', - driver => 'fcdslslusb', - firmware => 'fdlubase.frm', - }, - { - vendor => 0x057c, - id => 0x3600, - description => 'AVM FRITZ!Card DSL USB v2.0', - bus => 'USB', - driver => 'fcdslusb2', - firmware => 'fds2base.frm', - }, - ); - - -1; diff --git a/perl-install/network/modem.pm b/perl-install/network/modem.pm deleted file mode 100644 index 29afb69a4..000000000 --- a/perl-install/network/modem.pm +++ /dev/null @@ -1,223 +0,0 @@ -package network::modem; # $Id$ - -use strict; -use common; -use any; -use modules; -use detect_devices; -use network::network; -use network::tools; - -sub get_user_home() { - my $home; - if ($ENV{USER} ne "root") { - #- kdesu case - my $user = find { $_->[0] eq $ENV{USER} } list_passwd(); - $home = $user->[7] if $user; - } - $home ||= $ENV{HOME}; #- consolehelper case - $home; -} - -sub ppp_read_conf() { - my $modem = {}; - my %l = getVarsFromSh(get_user_home() . "/.kde/share/config/kppprc"); - add2hash(\%l, { getVarsFromSh("$::prefix/usr/share/config/kppprc") }); - $l{Authentication} = 4 if $l{Authentication} !~ /\d/; - $modem->{$_} ||= $l{$_} foreach qw(Authentication Gateway IPAddr SubnetMask); - $modem->{connection} ||= $l{Name}; - $modem->{domain} ||= $l{Domain}; - ($modem->{dns1}, $modem->{dns2}) = split(',', $l{DNS}); - - 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; - /^METRIC=(.*)/ and $modem->{METRIC} = $1; - } - $modem->{login} ||= $l{Username}; - my $secret = network::tools::read_secret_backend(); - foreach (@$secret) { - $modem->{passwd} ||= $_->{passwd} if $_->{login} eq $modem->{login}; - } - #my $secret = network::tools::read_secret_backend(); - #my @cnx_list = map { $_->{server} } @$secret; - $modem->{$_} ||= '' foreach qw(connection phone login passwd auth domain dns1 dns2); - $modem->{auto_gateway} ||= defined $modem->{Gateway} && $modem->{Gateway} ne '0.0.0.0' ? N("Manual") : N("Automatic"); - $modem->{auto_ip} ||= defined $modem->{IPAddr} && $modem->{IPAddr} ne '0.0.0.0' ? N("Manual") : N("Automatic"); - $modem->{auto_dns} ||= $modem->{dns1} || $modem->{dns2} ? N("Manual") : N("Automatic"); - $modem->{device} ||= '/dev/modem'; - $modem; -} - -#-----modem conf -sub ppp_configure { - my ($net, $in, $modem) = @_; - $in->do_pkgs->install('ppp') if !$::testing; - $in->do_pkgs->install('kdenetwork-kppp') if !$::testing && $in->do_pkgs->is_installed('kdebase'); - - if ($modem->{device} ne "/dev/modem") { - my $dev = $modem->{device}; - $dev =~ s!^/dev/!!; - any::devfssymlinkf({ device => $dev }, 'modem'); - } - - my %toreplace = map { $_ => $modem->{$_} } qw(Authentication AutoName connection dns1 dns2 domain IPAddr login passwd phone SubnetMask); - $toreplace{phone} =~ s/[^\d#*]//g; - if ($modem->{auto_dns} ne N("Automatic")) { - $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{papname} = $toreplace{login} if member($modem->{Authentication}, 1, 3, 4); - - # handle static/dynamic settings: - if ($modem->{auto_ip} eq N("Automatic")) { - $toreplace{$_} = '0.0.0.0' foreach qw(IPAddr SubnetMask); - } else { - $toreplace{$_} = $modem->{$_} foreach qw(IPAddr SubnetMask); - } - $toreplace{Gateway} = $modem->{auto_gateway} eq N("Automatic") ? '0.0.0.0' : $modem->{Gateway}; - - $toreplace{METRIC} = defined($modem->{METRIC}) ? $modem->{METRIC} : network::tools::get_default_metric("modem"); - - $net->{ifcfg}{ppp0} = { - DEVICE => "ppp0", - 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}, - METRIC => $toreplace{METRIC}, - if_($modem->{auto_dns} ne N("Automatic"), - 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}' -'TIMEOUT' '120' -'CONNECT' '' -END - if (member($modem->{Authentication}, 0, 2)) { - 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); - - network::tools::write_secret_backend($toreplace{login}, $toreplace{passwd}); - - #- install kppprc file according to used configuration. - mkdir_p("$::prefix/usr/share/config"); - - $toreplace{$_->[0]} = $modem->{$_->[0]} || $_->[1] foreach [ 'Timeout', 60 ], [ 'UseLockFile', 1 ], [ 'Enter', 'CR' ], [ 'Volume', 0 ], - [ 'BusyWait', 0 ], [ 'FlowControl', 'CRTSCTS' ], [ 'Speed', 115200 ]; - output($modem->{kppprc} || "$::prefix/usr/share/config/kppprc", common::to_utf8(<<END)); -# KDE Config File - -[Account0] -ExDNSDisabled=0 -AutoName=$toreplace{AutoName} -ScriptArguments= -AccountingEnabled=0 -DialString=ATDT -Phonenumber=$toreplace{phone} -IPAddr=$toreplace{IPAddr} -Domain=$toreplace{domain} -Name=$toreplace{connection} -VolumeAccountingEnabled=0 -pppdArguments= -Password=$toreplace{passwd} -BeforeDisconnect= -Command= -ScriptCommands= -Authentication=$toreplace{Authentication} -DNS=$toreplace{dnsserver} -SubnetMask=$toreplace{SubnetMask} -AccountingFile= -DefaultRoute=1 -Username=$toreplace{login} -Gateway=$toreplace{Gateway} -StorePassword=1 -DisconnectCommand= - -[Modem] -BusyWait=$toreplace{BusyWait} -Enter=$toreplace{Enter} -FlowControl=$toreplace{FlowControl} -Volume=$toreplace{Volume} -Timeout=$toreplace{Timeout} -UseCDLine=0 -UseLockFile=$toreplace{UseLockFile} -Device=/dev/modem -Speed=$toreplace{Speed} - -[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}); -} - -1; diff --git a/perl-install/network/monitor.pm b/perl-install/network/monitor.pm deleted file mode 100644 index c0ed8f80e..000000000 --- a/perl-install/network/monitor.pm +++ /dev/null @@ -1,83 +0,0 @@ -package network::monitor; - -use common; -use dbus_object; - -our @ISA = qw(dbus_object); - -sub new { - my ($type, $bus) = @_; - dbus_object::new($type, - $bus, - "com.mandriva.monitoring", - "/com/mandriva/monitoring/wireless", - "com.mandriva.monitoring.wireless"); -} - -sub list_wireless { - my ($monitor, $o_intf) = @_; - my ($results, $list, %networks); - #- first try to use mandi - eval { - $results = $monitor->call_method('ScanResults'); - $list = $monitor->call_method('ListNetworks'); - }; - my $has_roaming = defined $results && defined $list; - #- try wpa_cli if we're root - if ($@ && !$>) { - $results = `/usr/sbin/wpa_cli scan_results 2>/dev/null`; - $list = `/usr/sbin/wpa_cli list_networks 2>/dev/null`; - } - if ($results && $list) { - #- bssid / frequency / signal level / flags / ssid - while ($results =~ /^((?:[0-9a-f]{2}:){5}[0-9a-f]{2})\t(\d+)\t(\d+)\t(.*?)\t(.*)$/mg) { - #- wpa_supplicant may list the network two times, use ||= - $networks{$1}{frequency} ||= $2; - #- signal level is really too high in wpa_supplicant - #- this should be standardized at some point - $networks{$1}{signal_level} ||= int($3/3.5); - $networks{$1}{flags} ||= $4; - $networks{$1}{essid} ||= $5 if $5 ne '<hidden>'; - } - #- network id / ssid / bssid / flags - while ($list =~ /^(\d+)\t(.*?)\t(.*?)\t(.*)$/mg) { - if (my $net = $networks{$3} || find { $_->{essid} eq $2 } values(%networks)) { - $net->{id} = $1; - $net->{essid} ||= $2; - $net->{current} = to_bool($4 eq '[CURRENT]'); - } - } - } elsif ($o_intf) { - #- else use iwlist - my $current_essid = chomp_(`/sbin/iwgetid -r $o_intf`); - my $current_ap = lc(chomp_(`/sbin/iwgetid -r -a $o_intf`)); - my @list = `/sbin/iwlist $o_intf scanning`; - my $net = {}; - foreach (@list) { - if ((/^\s*$/ || /Cell/) && exists $net->{ap}) { - $net->{current} = to_bool($net->{essid} && $net->{essid} eq $current_essid || $net->{ap} eq $current_ap); - $networks{$net->{ap}} = $net; - $net = {}; - } - /Address: (.*)/ and $net->{ap} = lc($1); - /ESSID:"(.*?)"/ and $net->{essid} = $1; - /Mode:(\S*)/ and $net->{mode} = $1; - if (m!Quality[:=](\S*)/!) { - my $qual = $1; - $net->{signal_level} = $qual =~ m!/! ? eval($qual)*100 : $qual; - } - /Extra:wpa_ie=/ and $net->{flags} = '[WPA]'; - /key:(\S*)\s/ and $net->{flags} ||= $1 eq 'on' && '[WEP]'; - } - } - - $networks{$_}{approx_level} = 20 + min(80, int($networks{$_}{signal_level}/20)*20) foreach keys %networks; - (\%networks, $has_roaming); -} - -sub select_network { - my ($o, $id) = @_; - $o->call_method('SelectNetwork', Net::DBus::dbus_uint32($id)); -} - -1; diff --git a/perl-install/network/ndiswrapper.pm b/perl-install/network/ndiswrapper.pm deleted file mode 100644 index 83f0c3704..000000000 --- a/perl-install/network/ndiswrapper.pm +++ /dev/null @@ -1,108 +0,0 @@ -package network::ndiswrapper; - -use strict; -use common; -use modules; -use detect_devices; - -my $ndiswrapper_root = "/etc/ndiswrapper"; - -sub installed_drivers() { - grep { -d $::prefix . "$ndiswrapper_root/$_" } all($::prefix . $ndiswrapper_root); -} - -sub present_devices { - my ($driver) = @_; - my @supported_devices; - foreach (all($::prefix . "$ndiswrapper_root/$driver")) { - my ($ids) = /^([0-9A-Z]{4}:[0-9A-Z]{4})\.[05]\.conf$/; - $ids and push @supported_devices, $ids; - } - grep { member(uc(sprintf("%04x:%04x", $_->{vendor}, $_->{id})), @supported_devices) } detect_devices::probeall(); -} - -sub get_devices { - my ($in, $driver) = @_; - my @devices = present_devices($driver); - @devices or $in->ask_warn(N("Error"), N("No device supporting the %s ndiswrapper driver is present!", $driver)); - @devices; -} - -sub ask_driver { - my ($in) = @_; - if (my $inf_file = $in->ask_file(N("Please select the Windows driver (.inf file)"), "/mnt/cdrom")) { - my $driver = basename(lc($inf_file)); - $driver =~ s/\.inf$//; - - #- first uninstall the driver if present, may solve issues if it is corrupted - require run_program; - -d $::prefix . "$ndiswrapper_root/$driver" and run_program::rooted($::prefix, 'ndiswrapper', '-e', $driver); - - unless (run_program::rooted($::prefix, 'ndiswrapper', '-i', $inf_file)) { - $in->ask_warn(N("Error"), N("Unable to install the %s ndiswrapper driver!", $driver)); - return undef; - } - - return $driver; - } - undef; -} - -sub find_matching_devices { - my ($device) = @_; - my $net_path = '/sys/class/net'; - my @devices; - - foreach my $interface (all($net_path)) { - my $dev_path = "$net_path/$interface/device"; - -l $dev_path or next; - my $map = detect_devices::get_sysfs_device_id_map($dev_path); - if (every { hex(chomp_(cat_("$dev_path/" . $map->{$_}))) eq $device->{$_} } keys %$map) { - my $driver = readlink("$dev_path/driver"); - $driver =~ s!.*/!!; - push @devices, [ $interface, $driver ] if $driver; - } - } - - @devices; -} - -sub find_conflicting_devices { - my ($device) = @_; - grep { $_->[1] ne "ndiswrapper" } find_matching_devices($device); -} - -sub find_interface { - my ($device) = @_; - my $dev = find { $_->[1] eq "ndiswrapper" } find_matching_devices($device); - $dev->[0]; -} - -sub setup_device { - my ($in, $device) = @_; - - #- unload ndiswrapper first so that the newly installed .inf files will be read - eval { modules::unload("ndiswrapper") }; - eval { modules::load("ndiswrapper") }; - - if ($@) { - $in->ask_warn(N("Error"), N("Unable to load the ndiswrapper module!")); - return; - } - - my @conflicts = find_conflicting_devices($device); - if (@conflicts) { - $in->ask_yesorno(N("Warning"), N("The selected device has already been configured with the %s driver. -Do you really want to use a ndiswrapper driver?", $conflicts[0][1])) or return; - } - - my $interface = find_interface($device); - unless ($interface) { - $in->ask_warn(N("Error"), N("Unable to find the ndiswrapper interface!")); - return; - } - - $interface; -} - -1; diff --git a/perl-install/network/netconnect.pm b/perl-install/network/netconnect.pm deleted file mode 100644 index adf7f2084..000000000 --- a/perl-install/network/netconnect.pm +++ /dev/null @@ -1,1461 +0,0 @@ -package network::netconnect; # $Id$ - -use strict; -use common; -use log; -use detect_devices; -use list_modules; -use modules; -use mouse; -use services; -use network::network; -use network::tools; -use network::thirdparty; - -sub detect { - my ($modules_conf, $auto_detect, $o_class) = @_; - my %l = ( - isdn => sub { - require network::isdn; - $auto_detect->{isdn} = network::isdn::detect_backend($modules_conf); - }, - lan => sub { # ethernet - require network::ethernet; - modules::load_category($modules_conf, list_modules::ethernet_categories()); - $auto_detect->{lan} = { map { $_->[0] => $_->[1] } network::ethernet::get_eth_cards($modules_conf) }; - }, - adsl => sub { - require network::adsl; - $auto_detect->{adsl} = network::adsl::adsl_detect(); - }, - modem => sub { - $auto_detect->{modem} = { map { $_->{description} || "$_->{MANUFACTURER}|$_->{DESCRIPTION} ($_->{device})" => $_ } detect_devices::getModem($modules_conf) }; - }, - ); - $l{$_}->() foreach $o_class || keys %l; - return; -} - -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("$::prefix/etc/sysconfig/clock"); - my @country; - foreach (keys %tmz2country) { - if ($_ eq $tm_parse{ZONE}) { - unshift @country, $tmz2country{$_}; - } else { push @country, $tmz2country{$_} } - } - \@country; -} - -sub real_main { - my ($net, $in, $modules_conf) = @_; - #- network configuration should have been already read in $net at this point - my $mouse = $::o->{mouse} || {}; - my ($cnx_type, @all_cards, %eth_intf, %all_eth_intf, %unavailable_wireless_intf); - my (%connections, @connection_list); - my ($modem, $modem_name, $modem_dyn_dns, $modem_dyn_ip); - my $cable_no_auth; - my (@adsl_devices, %adsl_cards, %adsl_data, $adsl_data, $adsl_provider, $adsl_old_provider, $adsl_vpi, $adsl_vci); - my ($ntf_name, $gateway_ex, $up); - my ($isdn, $isdn_name, $isdn_type, %isdn_cards, @isdn_dial_methods); - my $my_isdn = join('', N("Manual choice"), " (", N("Internal ISDN card"), ")"); - my (@ndiswrapper_drivers, $ndiswrapper_driver, $ndiswrapper_device); - my ($is_wireless, $wireless_enc_mode, $wireless_enc_key, $need_rt2x00_iwpriv, $wireless_roaming, $need_wpa_supplicant); - my ($dvb_adapter, $dvb_ad, $dvb_net, $dvb_pid); - my ($module, $auto_ip, $protocol, $onboot, $needhostname, $peerdns, $peeryp, $peerntpd, $ifplugd, $track_network_id, $ipv6_tunnel, $need_network_restart); - my $success = 1; - my $ethntf = {}; - my $db_path = "/usr/share/apps/kppp/Provider"; - my (%countries, @isp, $country, $provider, $old_provider); - - my %l10n_lan_protocols = ( - static => N("Manual configuration"), - dhcp => N("Automatic IP (BOOTP/DHCP)"), - if_(0, - dhcp_zeroconf => N("Automatic IP (BOOTP/DHCP/Zeroconf)"), - ) - ); - my $_w = N("Protocol for the rest of the world"); - my %isdn_protocols = ( - 2 => N("European protocol (EDSS1)"), - 3 => N("Protocol for the rest of the world\nNo D-Channel (leased lines)"), - ); - - $net->{autodetect} = {}; - - my $lan_detect = sub { - detect($modules_conf, $net->{autodetect}, 'lan'); - @all_cards = network::ethernet::get_eth_cards($modules_conf); - %all_eth_intf = network::ethernet::get_eth_cards_names(@all_cards); #- needed not to loose GATEWAYDEV - %eth_intf = map { $_->[0] => join(': ', $_->[0], $_->[2] || N("Unknown driver")) } - grep { to_bool($is_wireless) == detect_devices::is_wireless_interface($_->[0]) } @all_cards; - my %available; - $available{$_->[2]} = undef foreach grep { $_->[2] } @all_cards; - %unavailable_wireless_intf = map { - $_->{driver} => sprintf('%s (%s): %s', N("unknown"), $_->{driver}, $_->{description}); - } grep { !exists($available{$_->{description}}) } modules::probe_category('network/wireless'); - }; - - my $is_dvb_interface = sub { $_[0]{DEVICE} =~ /^dvb\d+_\d+/ }; - - my $find_lan_module = sub { - if (my $dev = find { $_->{device} eq $ethntf->{DEVICE} } detect_devices::pcmcia_probe()) { # PCMCIA case - $module = $dev->{driver}; - } elsif ($dev = find { $_->[0] eq $ethntf->{DEVICE} } @all_cards) { - $module = $dev->[1]; - } elsif ($is_dvb_interface->($ethntf)) { - $module = $dvb_adapter->{driver}; - } else { $module = "" } - }; - - my %adsl_descriptions = ( - speedtouch => N("Alcatel speedtouch USB modem"), - sagem => N("Sagem USB modem"), - bewan => N("Bewan modem"), - eci => N("ECI Hi-Focus modem"), # this one needs eci agreement - ); - - my %adsl_types = ( - dhcp => N("Dynamic Host Configuration Protocol (DHCP)"), - static => N("Manual TCP/IP configuration"), - pptp => N("Point to Point Tunneling Protocol (PPTP)"), - pppoe => N("PPP over Ethernet (PPPoE)"), - pppoa => N("PPP over ATM (PPPoA)"), - capi => N("DSL over CAPI"), - ); - - my %encapsulations = ( - 1 => N("Bridged Ethernet LLC"), - 2 => N("Bridged Ethernet VC"), - 3 => N("Routed IP LLC"), - 4 => N("Routed IP VC"), - 5 => N("PPPoA LLC"), - 6 => N("PPPoA VC"), - ); - - my %ppp_auth_methods = ( - 0 => N("Script-based"), - 1 => N("PAP"), - 2 => N("Terminal-based"), - 3 => N("CHAP"), - 4 => N("PAP/CHAP"), - ); - - my $offer_to_connect = sub { - #- FIXME: create $try_to_connect sub out of this code - #- merge with "ask_connect_now" post code - if ($net->{type} eq 'adsl' && !member($net->{adsl}{method}, qw(static dhcp)) || - member($net->{type}, qw(modem isdn isdn_external))) { - return "ask_connect_now"; - } - - unless ($::isInstall) { - if ($need_network_restart) { - services::restart("network"); - } else { - #- FIXME: move this in network::tools::restart_net_interface - network::tools::stop_net_interface($net, 0); - if (exists $net->{adsl}{ethernet_device}) { - network::tools::stop_interface($net->{adsl}{ethernet_device}, 0); - network::tools::start_interface($net->{adsl}{ethernet_device}, 0); - } - network::tools::start_net_interface($net, 0); - } - } - #- FIXME: check for connection here - #- check for real interface in connection test - #- don't block when checking connection - #- return "after_connect" (old "disconnect" step) - return "end"; - }; - - my $after_lan_intf_selection = sub { $is_wireless ? 'wireless' : 'lan_protocol' }; - - my $after_start_on_boot_step = sub { - #- can't be done in adsl_account step because of static/dhcp adsl methods - #- we need to write sagem specific parameters and load corresponding modules/programs (sagem/speedtouch) - $net->{type} eq 'adsl' and network::adsl::adsl_conf_backend($in, $modules_conf, $net); - - network::network::configure_network($net, $in, $modules_conf); - #- FIXME: always run "ask_connect_now" - return $offer_to_connect->(); - }; - - my $goto_start_on_boot_ifneeded = sub { - return $after_start_on_boot_step->() if $net->{type} eq "lan"; - return "isdn_dial_on_boot" if $net->{type} eq 'isdn'; - return "network_on_boot"; - }; - - my $delete_gateway_settings = sub { - my ($device) = @_; - #- delete gateway settings if gateway device is invalid or matches the reconfigured device - if (!$net->{network}{GATEWAYDEV} || !exists $eth_intf{$net->{network}{GATEWAYDEV}} || $net->{network}{GATEWAYDEV} eq $device) { - delete $net->{network}{GATEWAY}; - delete $net->{network}{GATEWAYDEV}; - } - }; - - my $ndiswrapper_do_device_selection = sub { - $ntf_name = network::ndiswrapper::setup_device($in, $ndiswrapper_device); - unless ($ntf_name) { - undef $ndiswrapper_device; - return; - } - - #- redetect interfaces (so that the ndiswrapper module can be detected) - $lan_detect->(); - - $ethntf = $net->{ifcfg}{$ntf_name} ||= { DEVICE => $ntf_name }; - - 1; - }; - - my $ndiswrapper_do_driver_selection = sub { - my @devices = network::ndiswrapper::get_devices($in, $ndiswrapper_driver); - - if (!@devices) { - undef $ndiswrapper_driver; - return; - } elsif (@devices == 1) { - #- only one device matches installed driver - $ndiswrapper_device = $devices[0]; - return $ndiswrapper_do_device_selection->(); - } - - 1; - }; - - my $ndiswrapper_next_step = sub { - return $ndiswrapper_device ? $after_lan_intf_selection->() : - $ndiswrapper_driver ? 'ndiswrapper_select_device' : - 'ndiswrapper_select_driver'; - }; - - use locale; - set_l10n_sort(); - - require wizards; - my $wiz = wizards->new( - { - defaultimage => "drakconnect.png", - name => N("Network & Internet Configuration"), - pages => { - welcome => - { - pre => sub { - my @connections = ( - [ N("LAN connection"), "lan" ], - [ N("Wireless connection"), "lan" ], - [ N("ADSL connection"), "adsl" ], - [ N("Cable connection"), "cable" ], - [ N("ISDN connection"), "isdn" ], - [ N("Modem connection"), "modem" ], - [ N("DVB connection"), "dvb" ], - ); - - foreach (@connections) { - my ($string, $type) = @$_; - $connections{$string} = $type; - } - @connection_list = { val => \$cnx_type, type => 'list', list => [ map { $_->[0] } @connections ], }; - }, - if_(!$::isInstall, no_back => 1), - name => N("Choose the connection you want to configure"), - interactive_help_id => 'configureNetwork', - data => \@connection_list, - post => sub { - $is_wireless = $cnx_type eq N("Wireless connection"); - return $net->{type} = $connections{$cnx_type}; - }, - }, - - isdn_account => - { - pre => sub { - network::isdn::get_info_providers_backend($isdn, $provider); - $isdn->{huptimeout} ||= 180; - }, - name => N("Connection Configuration") . "\n\n" . N("Please fill or check the field below"), - data => sub { - [ - { label => N("Your personal phone number"), val => \$isdn->{phone_in} }, - { label => N("Provider name (ex provider.net)"), val => \$net->{resolv}{DOMAINNAME2} }, - { label => N("Provider phone number"), val => \$isdn->{phone_out} }, - { label => N("Provider DNS 1 (optional)"), val => \$net->{resolv}{dnsServer2} }, - { label => N("Provider DNS 2 (optional)"), val => \$net->{resolv}{dnsServer3} }, - { label => N("Dialing mode"), list => ["auto", "manual"], val => \$isdn->{dialing_mode} }, - { label => N("Connection speed"), list => ["64 Kb/s", "128 Kb/s"], val => \$isdn->{speed} }, - { label => N("Connection timeout (in sec)"), val => \$isdn->{huptimeout} }, - { label => N("Account Login (user name)"), val => \$isdn->{login} }, - { label => N("Account Password"), val => \$isdn->{passwd}, hidden => 1 }, - { label => N("Card IRQ"), val => \$isdn->{irq}, advanced => 1 }, - { label => N("Card mem (DMA)"), val => \$isdn->{mem}, advanced => 1 }, - { label => N("Card IO"), val => \$isdn->{io}, advanced => 1 }, - { label => N("Card IO_0"), val => \$isdn->{io0}, advanced => 1 }, - { label => N("Card IO_1"), val => \$isdn->{io1}, advanced => 1 }, - ]; - }, - post => sub { - network::isdn::write_config($in, $isdn); - $net->{net_interface} = 'ippp0'; - "allow_user_ctl"; - }, - }, - - cable => - { - pre => sub { - $cable_no_auth = sub { $net->{cable}{bpalogin} eq N("None") }; - }, - name => N("Cable: account options"), - data => sub { - [ - { label => N("Authentication"), type => "list", val => \$net->{cable}{bpalogin}, list => [ N("None"), N("Use BPALogin (needed for Telstra)") ] }, - { label => N("Account Login (user name)"), val => \$net->{cable}{login}, disabled => $cable_no_auth }, - { label => N("Account Password"), val => \$net->{cable}{passwd}, hidden => 1, disabled => $cable_no_auth }, - ]; - }, - complete => sub { - !$cable_no_auth->() && !$in->do_pkgs->ensure_is_installed('bpalogin', '/usr/sbin/bpalogin'); - }, - post => sub { - my $use_bpalogin = !$cable_no_auth->(); - $use_bpalogin and substInFile { - s/username\s+.*\n/username $net->{cable}{login}\n/; - s/password\s+.*\n/password $net->{cable}{passwd}\n/; - } "$::prefix/etc/bpalogin.conf"; - services::set_status("bpalogin", $use_bpalogin); - $auto_ip = 1; - return "lan"; - } - }, - - isdn => - { - pre=> sub { - detect($modules_conf, $net->{autodetect}, 'isdn'); - %isdn_cards = map { $_->{description} => $_ } @{$net->{autodetect}{isdn}}; - }, - name => N("Select the network interface to configure:"), - data => sub { - [ { label => N("Net Device"), type => "list", val => \$isdn_name, allow_empty_list => 1, - list => [ $my_isdn, N("External ISDN modem"), keys %isdn_cards ] } ]; - }, - post => sub { - if ($isdn_name eq $my_isdn) { - return "isdn_ask"; - } elsif ($isdn_name eq N("External ISDN modem")) { - $net->{type} = 'isdn_external'; - return "modem"; - } - - # FIXME: some of these should be taken from isdn db - $isdn = { map { $_ => $isdn_cards{$isdn_name}{$_} } qw(description vendor id card_type driver type mem io io0 io1 irq firmware) }; - - if ($isdn->{id}) { - log::explanations("found isdn card : $isdn->{description}; vendor : $isdn->{vendor}; id : $isdn->{id}; driver : $isdn->{driver}\n"); - $isdn->{description} =~ s/\|/ -- /; - } - - network::isdn::read_config($isdn); - $isdn->{driver} = $isdn_cards{$isdn_name}{driver}; #- do not let config overwrite default driver - - #- let the user choose hisax or capidrv if both are available - $isdn->{driver} ne "capidrv" && network::isdn::get_capi_card($in, $isdn) and return "isdn_driver"; - return "isdn_protocol"; - }, - }, - - - isdn_ask => - { - pre => sub { - %isdn_cards = network::isdn::get_cards(); - }, - name => N("Select a device!"), - data => sub { [ { label => N("Net Device"), val => \$isdn_name, type => 'list', separator => '|', list => [ keys %isdn_cards ], allow_empty_list => 1 } ] }, - pre2 => sub { - my ($label) = @_; - - #- ISDN card already detected - 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_("USB"), N_("I do not know") ] - ) or return; - isdn_ask_step_1b: - if ($e =~ /PCI/) { - $isdn->{card_type} = 'pci'; - } elsif ($e =~ /USB/) { - $isdn->{card_type} = 'usb'; - } 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} }, - [ network::isdn::get_cards_by_type($isdn->{card_type}) ]) or goto($isdn->{card_type} =~ /usb|pci/ ? 'isdn_ask_step_1' : 'isdn_ask_step_1b'); - $e->{$_} and $isdn->{$_} = $e->{$_} foreach qw(driver type mem io io0 io1 irq firmware); - - }, - post => sub { - $isdn = $isdn_cards{$isdn_name}; - return "isdn_protocol"; - } - }, - - - isdn_driver => - { - pre => sub { - $isdn_name = "capidrv"; - }, - name => N("A CAPI driver is available for this modem. This CAPI driver can offer more capabilities than the free driver (like sending faxes). Which driver do you want to use?"), - data => sub { [ - { label => N("Driver"), type => "list", val => \$isdn_name, - list => [ $isdn->{driver}, "capidrv" ] } - ] }, - post => sub { - $isdn->{driver} = $isdn_name; - return "isdn_protocol"; - } - }, - - - isdn_protocol => - { - name => N("ISDN Configuration") . "\n\n" . N("Which protocol do you want to use?"), - data => [ - { label => N("Protocol"), type => "list", val => \$isdn_type, - list => [ keys %isdn_protocols ], format => sub { $isdn_protocols{$_[0]} } } - ], - post => sub { - $isdn->{protocol} = $isdn_type; - return "isdn_db"; - } - }, - - - isdn_db => - { - name => N("ISDN Configuration") . "\n\n" . N("Select your provider.\nIf it is not listed, choose Unlisted."), - data => sub { - [ { label => N("Provider:"), type => "list", val => \$provider, separator => '|', - list => [ N("Unlisted - edit manually"), network::isdn::read_providers_backend() ] } ]; - }, - next => "isdn_account", - }, - - - no_supported_winmodem => - { - name => N("Warning") . "\n\n" . N("Your modem is not supported by the system. -Take a look at http://www.linmodems.org"), - end => 1, - }, - - - modem => - { - pre => sub { - require network::modem; - detect($modules_conf, $net->{autodetect}, 'modem'); - $modem = {}; - if ($net->{type} eq 'isdn_external') { - #- FIXME: seems to be specific to ZyXEL Adapter Omni.net/TA 128/Elite 2846i - #- it does not even work with TA 128 modems - #- http://bugs.mandrakelinux.com/query.php?bug=1033 - $modem->{special_command} = 'AT&F&O2B40'; - } - }, - name => N("Select the modem to configure:"), - data => sub { - [ { label => N("Modem"), type => "list", val => \$modem_name, allow_empty_list => 1, - list => [ keys %{$net->{autodetect}{modem}}, N("Manual choice") ], } ]; - }, - complete => sub { - my $driver = $net->{autodetect}{modem}{$modem_name}{driver} or return 0; - #- some modem configuration programs modify modprobe.conf while we're loaded - #- so write it now and reload then - $modules_conf->write; - my $ret = network::thirdparty::setup_device($in, 'rtc', $driver, $modem, qw(device)); - $modules_conf->read if $ret; - !$ret; - }, - post => sub { - return 'choose_serial_port' if $modem_name eq N("Manual choice"); - if (exists $net->{autodetect}{modem}{$modem_name}{device}) { - #- this is a serial probed modem - $modem->{device} = $net->{autodetect}{modem}{$modem_name}{device}; - } - if (exists $modem->{device}) { - return "ppp_provider"; - } else { - #- driver exists but device field hasn't been filled by network::thirdparty::setup_device - return "no_supported_winmodem"; - } - }, - }, - - - choose_serial_port => - { - pre => sub { - $modem->{device} ||= readlink "$::prefix/dev/modem"; - }, - name => N("Please choose which serial port your modem is connected to."), - interactive_help_id => 'selectSerialPort', - data => sub { - [ { val => \$modem->{device}, format => \&mouse::serial_port2text, type => "list", - list => [ grep { $_ ne $mouse->{device} } (mouse::serial_ports(), grep { -e $_ } '/dev/modem', '/dev/ttySL0', '/dev/ttyS14',) ] } ]; - }, - post => sub { - return 'ppp_provider'; - }, - }, - - - ppp_provider => - { - pre => sub { - add2hash($modem, network::modem::ppp_read_conf()); - $in->do_pkgs->ensure_is_installed('kdenetwork-kppp-provider', $db_path); - my $p_db_path = "$::prefix$db_path"; - @isp = map { - my $country = $_; - map { - s!$p_db_path/$country!!; - s/%([0-9]{3})/chr(int($1))/eg; - $countries{$country} ||= translate($country); - join('', $countries{$country}, $_); - } grep { !/.directory$/ } glob_("$p_db_path/$country/*"); - } map { s!$p_db_path/!!o; s!_! !g; $_ } glob_("$p_db_path/*") if !@isp; - $old_provider = $provider; - }, - name => N("Select your provider:"), - data => sub { - [ { label => N("Provider:"), type => "list", val => \$provider, separator => '/', - list => [ N("Unlisted - edit manually"), @isp ] } ]; - }, - post => sub { - if ($provider ne N("Unlisted - edit manually")) { - ($country, $provider) = split('/', $provider); - $country = { reverse %countries }->{$country}; - my %l = getVarsFromSh("$::prefix$db_path/$country/$provider"); - if (defined $old_provider && $old_provider ne $provider) { - $modem->{connection} = $l{Name}; - $modem->{phone} = $l{Phonenumber}; - $modem->{$_} = $l{$_} foreach qw(Authentication AutoName Domain Gateway IPAddr SubnetMask); - ($modem->{dns1}, $modem->{dns2}) = split(',', $l{DNS}); - } - } - return "ppp_account"; - }, - }, - - - ppp_account => - { - name => N("Dialup: account options"), - data => sub { - [ - { 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->{Authentication}, - list => [ sort keys %ppp_auth_methods ], format => sub { $ppp_auth_methods{$_[0]} } }, - ]; - }, - next => "ppp_ip", - }, - - - ppp_ip => - { - pre => sub { - $modem_dyn_ip = sub { $modem->{auto_ip} eq N("Automatic") }; - }, - name => N("Dialup: IP parameters"), - data => sub { - [ - { label => N("IP parameters"), type => "list", val => \$modem->{auto_ip}, list => [ N("Automatic"), N("Manual") ] }, - { label => N("IP address"), val => \$modem->{IPAddr}, disabled => $modem_dyn_ip }, - { label => N("Subnet mask"), val => \$modem->{SubnetMask}, disabled => $modem_dyn_ip }, - ]; - }, - next => "ppp_dns", - }, - - - ppp_dns => - { - pre => sub { - $modem_dyn_dns = sub { $modem->{auto_dns} eq N("Automatic") }; - }, - name => N("Dialup: DNS parameters"), - data => sub { - [ - { label => N("DNS"), type => "list", val => \$modem->{auto_dns}, list => [ N("Automatic"), N("Manual") ] }, - { label => N("Domain name"), val => \$modem->{domain}, disabled => $modem_dyn_dns }, - { label => N("First DNS Server (optional)"), val => \$modem->{dns1}, disabled => $modem_dyn_dns }, - { label => N("Second DNS Server (optional)"), val => \$modem->{dns2}, disabled => $modem_dyn_dns }, - { text => N("Set hostname from IP"), val => \$modem->{AutoName}, type => 'bool', disabled => $modem_dyn_dns }, - ]; - }, - next => "ppp_gateway", - }, - - - ppp_gateway => - { - name => N("Dialup: IP parameters"), - data => sub { - [ - { label => N("Gateway"), type => "list", val => \$modem->{auto_gateway}, list => [ N("Automatic"), N("Manual") ] }, - { label => N("Gateway IP address"), val => \$modem->{Gateway}, - disabled => sub { $modem->{auto_gateway} eq N("Automatic") } }, - ]; - }, - post => sub { - network::modem::ppp_configure($net, $in, $modem); - $net->{net_interface} = 'ppp0'; - "allow_user_ctl"; - }, - }, - - - adsl => - { - pre => sub { - $lan_detect->(); - @adsl_devices = keys %eth_intf; - - detect($modules_conf, $net->{autodetect}, 'adsl'); - %adsl_cards = (); - foreach my $modem_type (keys %{$net->{autodetect}{adsl}}) { - foreach my $modem (@{$net->{autodetect}{adsl}{$modem_type}}) { - my $name = join(': ', $adsl_descriptions{$modem_type}, $modem->{description}); - $adsl_cards{$name} = [ $modem_type, $modem ]; - } - } - push @adsl_devices, keys %adsl_cards; - - detect($modules_conf, $net->{autodetect}, 'isdn'); - if (my @isdn_modems = @{$net->{autodetect}{isdn}}) { - require network::isdn; - %isdn_cards = map { $_->{description} => $_ } grep { $_->{driver} =~ /dsl/i } map { network::isdn::get_capi_card($in, $_) } @isdn_modems; - push @adsl_devices, keys %isdn_cards; - } - }, - name => N("ADSL configuration") . "\n\n" . N("Select the network interface to configure:"), - data => [ { label => N("Net Device"), type => "list", val => \$ntf_name, allow_empty_list => 1, - list => \@adsl_devices, format => sub { $eth_intf{$_[0]} || $_[0] } } ], - complete => sub { - exists $adsl_cards{$ntf_name} && !network::thirdparty::setup_device($in, 'dsl', $adsl_cards{$ntf_name}[0]); - }, - post => sub { - if (exists $adsl_cards{$ntf_name}) { - my $modem; - ($ntf_name, $modem) = @{$adsl_cards{$ntf_name}}; - $net->{adsl}{bus} = $modem->{bus} if $ntf_name eq 'bewan'; - } - if (exists($isdn_cards{$ntf_name})) { - require network::isdn; - $net->{adsl}{capi_card} = $isdn_cards{$ntf_name}; - $net->{adsl}{method} = "capi"; - return 'adsl_account'; - } - return 'adsl_provider'; - }, - }, - - - adsl_provider => - { - pre => sub { - require network::adsl_consts; - %adsl_data = %network::adsl_consts::adsl_data if is_empty_hash_ref(\%adsl_data); - $adsl_old_provider = $adsl_provider; - if (!$adsl_provider) { - require lang; - my $locale_country = lang::c2name($::o->{locale}{country} || lang::read()->{country}); - $adsl_provider = find { /^$locale_country/ } sort(keys %adsl_data); - } - }, - name => N("Please choose your ADSL provider"), - data => sub { - [ { label => N("Provider:"), type => "list", val => \$adsl_provider, separator => '|', - list => [ sort(N("Unlisted - edit manually"), keys %adsl_data) ], sort => 0 } ]; - }, - post => sub { - $net->{adsl}{method} = 'pppoa' if member($ntf_name, qw(bewan speedtouch)); - if ($adsl_provider ne N("Unlisted - edit manually")) { - $adsl_data = $adsl_data{$adsl_provider}; - if ($adsl_provider ne $adsl_old_provider) { - $net->{adsl}{$_} = $adsl_data->{$_} foreach qw(Encapsulation vpi vci provider_id method); - $net->{resolv}{$_} = $adsl_data->{$_} foreach qw(DOMAINNAME2); - } - } - return 'adsl_protocol'; - }, - }, - - - adsl_protocol => - { - pre => sub { - # preselect right protocol for ethernet though connections: - if (!exists $adsl_descriptions{$ntf_name}) { - $ethntf = $net->{ifcfg}{$ntf_name} ||= { DEVICE => $ntf_name }; - $net->{adsl}{method} ||= $ethntf->{BOOTPROTO} || "dhcp"; - #- pppoa shouldn't be selected by default for ethernet devices, fallback on pppoe - $net->{adsl}{method} = "pppoe" if $net->{adsl}{method} eq "pppoa"; - } - }, - name => N("Please choose your DSL connection type. -If you do not know it, keep the preselected type."), - data => [ - { text => N("ADSL connection type:"), val => \$net->{adsl}{method}, type => "list", - list => [ sort { $adsl_types{$a} cmp $adsl_types{$b} } keys %adsl_types ], - format => sub { $adsl_types{$_[0]} }, - }, - ], - post => sub { - my $real_interface = $ntf_name; - $net->{type} = 'adsl'; - # blacklist bogus driver, enable ifplugd support else: - $find_lan_module->(); - $ethntf->{MII_NOT_SUPPORTED} ||= bool2yesno(network::ethernet::is_ifplugd_blacklisted($module)); - if ($ntf_name eq "sagem" && member($net->{adsl}{method}, qw(static dhcp))) { - #- "fctStartAdsl -i" builds ifcfg-ethX from ifcfg-sagem and echoes ethX - #- it auto-detects dhcp/static modes thanks to encapsulation setting - $ethntf = $net->{ifcfg}{sagem} ||= {}; - $ethntf->{DEVICE} = "`/usr/sbin/fctStartAdsl -i`"; - $ethntf->{MII_NOT_SUPPORTED} = "yes"; - } - if ($ntf_name eq "speedtouch" && member($net->{adsl}{method}, qw(static dhcp))) { - #- use ATMARP with the atm0 interface - $real_interface = "atm0"; - $ethntf = $net->{ifcfg}{$real_interface} ||= {}; - $ethntf->{DEVICE} = $real_interface; - $ethntf->{ATM_ADDR} = undef; - $ethntf->{MII_NOT_SUPPORTED} = "yes"; - } - #- delete gateway settings if gateway device is invalid or if reconfiguring the gateway interface - exists $net->{ifcfg}{$real_interface} and $delete_gateway_settings->($real_interface); - # process static/dhcp ethernet devices: - if (exists($net->{ifcfg}{$real_interface}) && member($net->{adsl}{method}, qw(static dhcp))) { - $ethntf->{TYPE} = "ADSL"; - $auto_ip = $net->{adsl}{method} eq 'dhcp'; - return 'lan_intf'; - } - member($net->{adsl}{method}, qw(pppoe pptp)) and $net->{adsl}{ethernet_device} = $ntf_name; - return 'adsl_account'; - }, - }, - - - adsl_account => - { - pre => sub { - network::adsl::adsl_probe_info($net); - $net->{net_interface} = 'ppp0'; - $net->{ifcfg}{ppp0} ||= {}; - ($adsl_vpi, $adsl_vci) = (hex($net->{adsl}{vpi}), hex($net->{adsl}{vci})); - }, - name => N("Connection Configuration") . "\n\n" . - N("Please fill or check the field below"), - data => sub { - [ - if_(0, { label => N("Provider name (ex provider.net)"), val => \$net->{resolv}{DOMAINNAME2} }), - { label => N("First DNS Server (optional)"), val => \$net->{resolv}{dnsServer2} }, - { label => N("Second DNS Server (optional)"), val => \$net->{resolv}{dnsServer3} }, - { label => N("Account Login (user name)"), val => \$net->{adsl}{login} }, - { label => N("Account Password"), val => \$net->{adsl}{passwd}, hidden => 1 }, - if_($net->{adsl}{method} ne "capi", - { label => N("Virtual Path ID (VPI):"), val => \$adsl_vpi, advanced => 1 }, - { label => N("Virtual Circuit ID (VCI):"), val => \$adsl_vci, advanced => 1 } - ), - if_($ntf_name eq "sagem", - { label => N("Encapsulation:"), val => \$net->{adsl}{Encapsulation}, list => [ keys %encapsulations ], - format => sub { $encapsulations{$_[0]} }, advanced => 1, - }, - ), - ]; - }, - post => sub { - #- update ATM_ADDR for ATMARP connections - exists $ethntf->{ATM_ADDR} and $ethntf->{ATM_ADDR} = join('.', $adsl_vpi, $adsl_vci); - #- convert VPI/VCI back to hex - ($net->{adsl}{vpi}, $net->{adsl}{vci}) = map { sprintf("%x", $_) } ($adsl_vpi, $adsl_vci); - - $net->{adsl}{device} = - $net->{adsl}{method} eq 'capi' ? 'capi_modem' : - $net->{adsl}{method} eq 'pptp' ? 'pptp_modem' : - $ntf_name; - # FIXME: duplicate with $after_start_on_boot_step sub - network::adsl::adsl_conf_backend($in, $modules_conf, $net); - "allow_user_ctl"; - }, - }, - - - lan => - { - pre => $lan_detect, - name => N("Select the network interface to configure:"), - data => sub { - [ { label => N("Net Device"), type => "list", val => \$ntf_name, list => [ - (sort keys %eth_intf, if_($is_wireless, keys %unavailable_wireless_intf)), - N_("Manually load a driver"), - if_($is_wireless, N_("Use a Windows driver (with ndiswrapper)")), - ], allow_empty_list => 1, format => sub { - translate($eth_intf{$_[0]} || $unavailable_wireless_intf{$_[0]} || $_[0]) } } ]; - }, - complete => sub { - if (any { $_->[0] eq $ntf_name && !$_->[1] } @all_cards) { - $in->ask_warn(N("Error"), N("Unknown driver")); - return 1; - } - - if ($ntf_name eq "Use a Windows driver (with ndiswrapper)") { - require network::ndiswrapper; - $in->do_pkgs->ensure_is_installed('ndiswrapper', '/usr/sbin/ndiswrapper') or return 1; - undef $ndiswrapper_driver; - undef $ndiswrapper_device; - unless (network::ndiswrapper::installed_drivers()) { - $ndiswrapper_driver = network::ndiswrapper::ask_driver($in) or return 1; - return !$ndiswrapper_do_driver_selection->(); - } - } - if (exists $unavailable_wireless_intf{$ntf_name}) { - my $driver = $ntf_name; - network::thirdparty::setup_device($in, 'wireless', $driver) or return 1; - eval { - modules::unload($driver); - modules::load($driver); - }; - $lan_detect->(); - my $eth_card = find { $_->[1] eq $driver } @all_cards; - unless ($eth_card) { - #- FIXME (#17545) - #- "No matching device found for driver %s." - #- "The driver has probably failed to load because of a missing firmware - #- or because it doesn't support your card revision. - #- Have a look at /var/log/messages to find additional information." - $in->ask_warn(N("Error"), N("No device found")); - return 1; - } - $ntf_name = $eth_card->[0]; - } - 0; - }, - post => sub { - if ($ntf_name eq "Manually load a driver") { - require modules::interactive; - modules::interactive::load_category__prompt($in, $modules_conf, list_modules::ethernet_categories()); - return 'lan'; - } elsif ($ntf_name eq "Use a Windows driver (with ndiswrapper)") { - return $ndiswrapper_next_step->(); - } - $ethntf = $net->{ifcfg}{$ntf_name} ||= { DEVICE => $ntf_name }; - return $after_lan_intf_selection->(); - }, - }, - - - lan_protocol => - { - pre => sub { - $find_lan_module->(); - $ethntf->{METRIC} = network::tools::get_default_metric(network::tools::get_interface_type($ethntf, $module)) - unless defined($ethntf->{METRIC}); - $protocol = $l10n_lan_protocols{defined $auto_ip ? ($auto_ip ? 'dhcp' : 'static') : $ethntf->{BOOTPROTO}} || 0; - }, - name => sub { - my $_msg = N("Zeroconf hostname resolution"); - N("Configuring network device %s (driver %s)", $ethntf->{DEVICE}, $module) . "\n\n" . - N("The following protocols can be used to configure a LAN connection. Please choose the one you want to use"); - }, - data => sub { - [ { val => \$protocol, type => "list", list => [ sort values %l10n_lan_protocols ] } ]; - }, - post => sub { - $auto_ip = $protocol ne $l10n_lan_protocols{static} || 0; - return 'lan_intf'; - }, - }, - - - lan_intf => - { - pre => sub { - require network::ethernet; - $onboot = $ethntf->{ONBOOT} ? $ethntf->{ONBOOT} =~ /yes/ : bool2yesno(!member($ethntf->{DEVICE}, - map { $_->{device} } detect_devices::pcmcia_probe())); - $needhostname = $ethntf->{NEEDHOSTNAME} !~ /no/; - $peerdns = $ethntf->{PEERDNS} !~ /no/; - $peeryp = $ethntf->{PEERYP} =~ /yes/; - $peerntpd = $ethntf->{PEERNTPD} =~ /yes/; - # blacklist bogus driver, enable ifplugd support else: - $ifplugd = !text2bool($ethntf->{MII_NOT_SUPPORTED}) && !network::ethernet::is_ifplugd_blacklisted($module); - $track_network_id = $::isStandalone && $ethntf->{HWADDR} || detect_devices::isLaptop(); - delete $ethntf->{TYPE} if $net->{type} ne 'adsl' || !member($net->{adsl}{method}, qw(static dhcp)); - $ethntf->{DHCP_CLIENT} ||= (find { -x "$::prefix/sbin/$_" } qw(dhclient dhcpcd pump dhcpxd)); - $ipv6_tunnel = text2bool($ethntf->{IPV6TO4INIT}); - }, - name => sub { join('', - N("Configuring network device %s (driver %s)", $ethntf->{DEVICE}, $module), - if_(!$auto_ip, "\n\n" . 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).")), - ) }, - data => sub { - [ $auto_ip ? - ( - { text => N("Assign host name from DHCP address"), val => \$needhostname, type => "bool" }, - { label => N("DHCP host name"), val => \$ethntf->{DHCP_HOSTNAME} }, - ) - : - ( - { label => N("IP address"), val => \$ethntf->{IPADDR}, disabled => sub { $auto_ip } }, - { label => N("Netmask"), val => \$ethntf->{NETMASK}, disabled => sub { $auto_ip } }, - ), - { text => N("Track network card id (useful for laptops)"), val => \$track_network_id, type => "bool" }, - { text => N("Network Hotplugging"), val => \$ifplugd, type => "bool", disabled => sub { $wireless_roaming } }, - if_($net->{type} eq "lan", - { text => N("Start at boot"), val => \$onboot, type => "bool" }, - ), - { label => N("Metric"), val => \$ethntf->{METRIC}, advanced => 1 }, - { text => N("Enable IPv6 to IPv4 tunnel"), val => \$ipv6_tunnel, type => "bool", advanced => 1 }, - if_($auto_ip, - { label => N("DHCP client"), val => \$ethntf->{DHCP_CLIENT}, - list => \@network::ethernet::dhcp_clients, advanced => 1 }, - { label => N("DHCP timeout (in seconds)"), val => \$ethntf->{DHCP_TIMEOUT}, advanced => 1 }, - { text => N("Get DNS servers from DHCP"), val => \$peerdns, type => "bool", advanced => 1 }, - { text => N("Get YP servers from DHCP"), val => \$peeryp, type => "bool", advanced => 1 }, - { text => N("Get NTPD servers from DHCP"), val => \$peerntpd, type => "bool", advanced => 1 }, - ), - ]; - }, - complete => sub { - $ethntf->{BOOTPROTO} = $auto_ip ? "dhcp" : "static"; - return 0 if $auto_ip; - if (!is_ip($ethntf->{IPADDR})) { - $in->ask_warn(N("Error"), N("IP address should be in format 1.2.3.4")); - return 1, 0; - } - if (!is_ip($ethntf->{NETMASK})) { - $in->ask_warn(N("Error"), N("Netmask should be in format 255.255.224.0")); - return 1, 1; - } - if (is_ip_forbidden($ethntf->{IPADDR})) { - $in->ask_warn(N("Error"), N("Warning: IP address %s is usually reserved!", $ethntf->{IPADDR})); - return 1, 0; - } - #- test if IP address is already used (do not test for sagem DSL devices since it may use many ifcfg files) - if ($ntf_name ne "sagem" && find { $_->{DEVICE} ne $ethntf->{DEVICE} && $_->{IPADDR} eq $ethntf->{IPADDR} } values %{$net->{ifcfg}}) { - $in->ask_warn(N("Error"), N("%s already in use\n", $ethntf->{IPADDR})); - return 1, 0; - } - }, - focus_out => sub { - $ethntf->{NETMASK} ||= netmask($ethntf->{IPADDR}) unless $ethntf->{NETMASK}; - }, - post => sub { - $ethntf->{ONBOOT} = bool2yesno($onboot); - $ethntf->{NEEDHOSTNAME} = bool2yesno($needhostname); - $ethntf->{PEERDNS} = bool2yesno($peerdns); - $ethntf->{PEERYP} = bool2yesno($peeryp); - $ethntf->{PEERNTPD} = bool2yesno($peerntpd); - $ethntf->{MII_NOT_SUPPORTED} = bool2yesno(!$ifplugd); - $ethntf->{HWADDR} = $track_network_id or delete $ethntf->{HWADDR}; - #- FIXME: special case for sagem where $ethntf->{DEVICE} is the result of a command - #- we can't always use $ntf_name because of some USB DSL modems - $net->{net_interface} = $ntf_name eq "sagem" ? "sagem" : $ethntf->{DEVICE}; - $need_network_restart = $ipv6_tunnel ^ text2bool($ethntf->{IPV6TO4INIT}); - if ($ipv6_tunnel) { - $net->{network}{NETWORKING_IPV6} = "yes"; - $net->{network}{IPV6_DEFAULTDEV} = "tun6to4"; - } - $ethntf->{IPV6INIT} = bool2yesno($ipv6_tunnel); - $ethntf->{IPV6TO4INIT} = bool2yesno($ipv6_tunnel); - if ($auto_ip) { - #- delete gateway settings if gateway device is invalid or if reconfiguring the gateway interface to dhcp - $delete_gateway_settings->($ntf_name); - } - return "static_hostname"; - }, - }, - - ndiswrapper_select_driver => - { - pre => sub { - @ndiswrapper_drivers = network::ndiswrapper::installed_drivers(); - $ndiswrapper_driver ||= first(@ndiswrapper_drivers); - }, - data => sub { - [ { label => N("Choose an ndiswrapper driver"), type => "list", val => \$ndiswrapper_driver, allow_empty_list => 1, - list => [ undef, @ndiswrapper_drivers ], - format => sub { defined $_[0] ? N("Use the ndiswrapper driver %s", $_[0]) : N("Install a new driver") } } ]; - }, - complete => sub { - $ndiswrapper_driver ||= network::ndiswrapper::ask_driver($in) or return 1; - !$ndiswrapper_do_driver_selection->(); - }, - post => $ndiswrapper_next_step, - }, - - ndiswrapper_select_device => - { - data => sub { - [ { label => N("Select a device:"), type => "list", val => \$ndiswrapper_device, allow_empty_list => 1, - list => [ network::ndiswrapper::present_devices($ndiswrapper_driver) ], - format => sub { $_[0]{description} } } ]; - }, - complete => sub { - !$ndiswrapper_do_device_selection->(); - }, - post => $ndiswrapper_next_step, - }, - - wireless => - { - pre => sub { - require network::wireless; - $find_lan_module->(); - $need_rt2x00_iwpriv = network::wireless::is_old_rt2x00($module); - $wireless_roaming = delete $ethntf->{WIRELESS_MODE} eq 'Roaming' && !$need_rt2x00_iwpriv; - $ethntf->{WIRELESS_MODE} ||= "Managed"; - $ethntf->{WIRELESS_ESSID} ||= "any"; - ($wireless_enc_key, my $restricted) = network::wireless::get_wep_key_from_iwconfig($ethntf->{WIRELESS_ENC_KEY}); - $wireless_enc_mode = - $ethntf->{WIRELESS_WPA_DRIVER} || $ethntf->{WIRELESS_IWPRIV} =~ /WPAPSK/ ? 'wpa-psk' : - !$wireless_enc_key ? 'none' : - $restricted ? 'restricted' : - 'open'; - delete $ethntf->{WIRELESS_ENC_KEY}; - delete $ethntf->{WIRELESS_IWPRIV}; - delete $ethntf->{WIRELESS_WPA_DRIVER}; - }, - name => N("Please enter the wireless parameters for this card:"), - data => sub { - [ - { label => N("Operating Mode"), val => \$ethntf->{WIRELESS_MODE}, - list => [ N_("Ad-hoc"), N_("Managed"), N_("Master"), N_("Repeater"), N_("Secondary"), N_("Auto") ], - format => \&translate, - disabled => sub { $wireless_roaming } }, - { label => N("Network name (ESSID)"), val => \$ethntf->{WIRELESS_ESSID} }, - { label => N("Encryption mode"), val => \$wireless_enc_mode, - list => [ keys %network::wireless::wireless_enc_modes ], - sort => 1, - format => sub { translate($network::wireless::wireless_enc_modes{$_[0]}) } }, - { label => N("Encryption key"), val => \$wireless_enc_key, disabled => sub { $wireless_enc_mode eq 'none' } }, - { text => N("Allow access point roaming"), val => \$wireless_roaming, type => "bool", - disabled => sub { network::wireless::is_wpa_supplicant_blacklisted($module) } }, - { label => N("Network ID"), val => \$ethntf->{WIRELESS_NWID}, advanced => 1 }, - { label => N("Operating frequency"), val => \$ethntf->{WIRELESS_FREQ}, advanced => 1 }, - { label => N("Sensitivity threshold"), val => \$ethntf->{WIRELESS_SENS}, advanced => 1 }, - { label => N("Bitrate (in b/s)"), val => \$ethntf->{WIRELESS_RATE}, advanced => 1 }, - { label => N("RTS/CTS"), val => \$ethntf->{WIRELESS_RTS}, advanced => 1, - help => N("RTS/CTS adds a handshake before each packet transmission to make sure that the -channel is clear. This adds overhead, but increase performance in case of hidden -nodes or large number of active nodes. This parameter sets the size of the -smallest packet for which the node sends RTS, a value equal to the maximum -packet size disable the scheme. You may also set this parameter to auto, fixed -or off.") - }, - { label => N("Fragmentation"), val => \$ethntf->{WIRELESS_FRAG}, advanced => 1 }, - { label => N("iwconfig command extra arguments"), val => \$ethntf->{WIRELESS_IWCONFIG}, advanced => 1, - help => N("Here, one can configure some extra wireless parameters such as: -ap, channel, commit, enc, power, retry, sens, txpower (nick is already set as the hostname). - -See iwconfig(8) man page for further information."), - }, - { label => - #-PO: split the "xyz command extra argument" translated string into two lines if it's bigger than the english one - N("iwspy command extra arguments"), val => \$ethntf->{WIRELESS_IWSPY}, advanced => 1, - help => N("iwspy is used to set a list of addresses in a wireless network -interface and to read back quality of link information for each of those. - -This information is the same as the one available in /proc/net/wireless : -quality of the link, signal strength and noise level. - -See iwpspy(8) man page for further information."), - }, - if_(!$need_rt2x00_iwpriv, - { label => N("iwpriv command extra arguments"), val => \$ethntf->{WIRELESS_IWPRIV}, advanced => 1, - help => N("iwpriv enable to set up optionals (private) parameters of a wireless network -interface. - -iwpriv deals with parameters and setting specific to each driver (as opposed to -iwconfig which deals with generic ones). - -In theory, the documentation of each device driver should indicate how to use -those interface specific commands and their effect. - -See iwpriv(8) man page for further information."), - }) - ]; - }, - complete => sub { - if ($ethntf->{WIRELESS_FREQ} && $ethntf->{WIRELESS_FREQ} !~ /[0-9.]*[kGM]/) { - $in->ask_warn(N("Error"), 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 ($ethntf->{WIRELESS_RATE} && $ethntf->{WIRELESS_RATE} !~ /[0-9.]*[kGM]/) { - $in->ask_warn(N("Error"), N("Rate should have the suffix k, M or G (for example, \"11M\" for 11M), or add enough '0' (zeroes).")); - return 1, 8; - } - if (network::wireless::wlan_ng_needed($module)) { - $in->do_pkgs->ensure_is_installed('prism2-utils', '/sbin/wlanctl-ng') or return 1; - } - $need_wpa_supplicant = ($wireless_roaming || $wireless_enc_mode eq 'wpa-psk') && !$need_rt2x00_iwpriv; - if ($need_wpa_supplicant) { - $in->do_pkgs->ensure_is_installed('wpa_supplicant', '/usr/sbin/wpa_supplicant') or return 1; - } - !network::thirdparty::setup_device($in, 'wireless', $module); - }, - post => sub { - if ($wireless_roaming) { - $ethntf->{MII_NOT_SUPPORTED} = 'no'; - $ethntf->{WIRELESS_MODE} = 'Roaming'; - } elsif (member($wireless_enc_mode, qw(open restricted))) { - $ethntf->{WIRELESS_ENC_KEY} = network::wireless::convert_wep_key_for_iwconfig($wireless_enc_key, $wireless_enc_mode eq 'restricted'); - } elsif ($need_rt2x00_iwpriv) { - #- use iwpriv for WPA with rt2400/rt2500 drivers, they don't plan to support wpa_supplicant - $ethntf->{WIRELESS_IWPRIV} = $wireless_enc_mode eq 'wpa-psk' && qq(set AuthMode=WPAPSK -set EncrypType=TKIP -set SSID=$ethntf->{WIRELESS_ESSID} -set WPAPSK="$wireless_enc_key" -set TxRate=0); - } - - if ($need_wpa_supplicant) { - $ethntf->{WIRELESS_WPA_DRIVER} = network::wireless::wpa_supplicant_get_driver($module); - network::wireless::wpa_supplicant_add_network($ethntf->{WIRELESS_ESSID}, $wireless_enc_mode, $wireless_enc_key); - } - - if (network::wireless::wlan_ng_needed($module)) { - network::wireless::wlan_ng_configure($ethntf->{WIRELESS_ESSID}, $wireless_enc_key, $ethntf->{DEVICE}, $module); - } - - return "lan_protocol"; - }, - }, - - - dvb => - { - name => N("DVB configuration") . "\n\n" . N("Select the network interface to configure:"), - data => [ { label => N("DVB Adapter"), type => "list", val => \$dvb_adapter, allow_empty_list => 1, - list => [ modules::probe_category("multimedia/dvb") ], format => sub { $_[0]{description} } } ], - next => "dvb_adapter", - }, - - - dvb_adapter => - { - pre => sub { - my $previous_ethntf = find { $is_dvb_interface->($_) } values %{$net->{ifcfg}}; - $dvb_ad = $previous_ethntf->{DVB_ADAPTER_ID}; - $dvb_net = $previous_ethntf->{DVB_NETWORK_DEMUX}; - $dvb_pid = $previous_ethntf->{DVB_NETWORK_PID}; - if (my $device = find { sysopen(undef, $_, c::O_RDWR() | c::O_NONBLOCK()) } glob("/dev/dvb/adapter*/net*")) { - ($dvb_ad, $dvb_net) = $device =~ m,/dev/dvb/adapter(\d+)/net(\d+),; - } - }, - name => N("DVB adapter settings"), - data => sub { - [ - { label => N("Adapter card"), val => \$dvb_ad }, - { label => N("Net demux"), val => \$dvb_net }, - { label => N("PID"), val => \$dvb_pid }, - ]; - }, - post => sub { - $ntf_name = 'dvb' . $dvb_ad . '_' . $dvb_net; - $ethntf = $net->{ifcfg}{$ntf_name} ||= {}; - $ethntf->{DEVICE} = $ntf_name; - $ethntf->{DVB_ADAPTER_ID} = qq("$dvb_ad"); - $ethntf->{DVB_NETWORK_DEMUX} = qq("$dvb_net"); - $ethntf->{DVB_NETWORK_PID} = qq("$dvb_pid"); - return "lan_protocol"; - }, - }, - - static_hostname => - { - pre => sub { - if ($ethntf->{IPADDR}) { - $net->{resolv}{dnsServer} ||= dns($ethntf->{IPADDR}); - $gateway_ex = gateway($ethntf->{IPADDR}); - # $net->{network}{GATEWAY} ||= gateway($ethntf->{IPADDR}); - if ($ntf_name eq "sagem") { - my @sagem_ip = split(/\./, $ethntf->{IPADDR}); - $sagem_ip[3] = 254; - $net->{network}{GATEWAY} = join(".", @sagem_ip); - } - } - }, - name => 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.") . - " " . # better looking text (to be merged into texts since some languages (eg: ja) doesn't need it -N("Last but not least you can also type in your DNS server IP addresses."), - data => sub { - [ { label => $auto_ip ? N("Host name (optional)") : N("Host name"), val => \$net->{network}{HOSTNAME} }, - if_(!$auto_ip, - { label => N("DNS server 1"), val => \$net->{resolv}{dnsServer} }, - { label => N("DNS server 2"), val => \$net->{resolv}{dnsServer2} }, - { label => N("DNS server 3"), val => \$net->{resolv}{dnsServer3} }, - { label => N("Search domain"), val => \$net->{resolv}{DOMAINNAME}, - help => N("By default search domain will be set from the fully-qualified host name") }, - { label => N("Gateway (e.g. %s)", $gateway_ex), val => \$net->{network}{GATEWAY} }, - if_(@all_cards > 1, - { label => N("Gateway device"), val => \$net->{network}{GATEWAYDEV}, list => [ N_("None"), sort keys %all_eth_intf ], - format => sub { $all_eth_intf{$_[0]} || translate($_[0]) } }, - ), - ), - ]; - }, - complete => sub { - foreach my $dns (qw(dnsServer dnsServer2 dnsServer3)) { - if ($net->{resolv}{$dns} && !is_ip($net->{resolv}{$dns})) { - $in->ask_warn(N("Error"), N("DNS server address should be in format 1.2.3.4")); - return 1; - } - } - if ($net->{network}{GATEWAY} && !is_ip($net->{network}{GATEWAY})) { - $in->ask_warn(N("Error"), N("Gateway address should be in format 1.2.3.4")); - return 1; - } - }, - post => sub { - $net->{network}{GATEWAYDEV} eq "None" and delete $net->{network}{GATEWAYDEV}; - return "zeroconf"; - } - }, - - - zeroconf => - { - name => N("If desired, enter a Zeroconf hostname. -This is the name your machine will use to advertise any of -its shared resources that are not managed by the network. -It is not necessary on most networks."), - data => [ { label => N("Zeroconf Host name"), val => \$net->{zeroconf}{hostname} } ], - complete => sub { - if ($net->{zeroconf}{hostname} =~ /\./) { - $in->ask_warn(N("Error"), N("Zeroconf host name must not contain a .")); - return 1; - } - }, - next => "allow_user_ctl", - }, - - - allow_user_ctl => - { - name => N("Do you want to allow users to start the connection?"), - type => "yesorno", - default => sub { bool2yesno(text2bool($net->{ifcfg}{$net->{net_interface}}{USERCTL})) }, - post => sub { - my ($res) = @_; - $net->{ifcfg}{$net->{net_interface}}{USERCTL} = bool2yesno($res); - return $goto_start_on_boot_ifneeded->(); - }, - }, - - - network_on_boot => - { - name => N("Do you want to start the connection at boot?"), - type => "yesorno", - default => sub { ($net->{type} eq 'modem' ? 'no' : 'yes') }, - post => sub { - my ($res) = @_; - $net->{ifcfg}{$net->{net_interface}}{ONBOOT} = bool2yesno($res); - return $after_start_on_boot_step->(); - }, - }, - - - isdn_dial_on_boot => - { - pre => sub { - $net->{ifcfg}{ippp0} ||= {}; # we want the ifcfg-ippp0 file to be written - $net->{ifcfg}{ippp0}{DEVICE} = "ippp0"; - @isdn_dial_methods = ({ name => N("Automatically at boot"), - ONBOOT => 1, DIAL_ON_IFUP => 1 }, - { name => N("By using Net Applet in the system tray"), - ONBOOT => 0, DIAL_ON_IFUP => 1 }, - { name => N("Manually (the interface would still be activated at boot)"), - ONBOOT => 1, DIAL_ON_IFUP => 0 }); - my $method = find { - $_->{ONBOOT} eq text2bool($net->{ifcfg}{ippp0}{ONBOOT}) && - $_->{DIAL_ON_IFUP} eq text2bool($net->{ifcfg}{ippp0}{DIAL_ON_IFUP}); - } @isdn_dial_methods; - #- use net_applet by default - $isdn->{dial_method} = $method->{name} || $isdn_dial_methods[1]{name}; - }, - name => N("How do you want to dial this connection?"), - data => sub { - [ { type => "list", val => \$isdn->{dial_method}, list => [ map { $_->{name} } @isdn_dial_methods ] } ]; - }, - post => sub { - my $method = find { $_->{name} eq $isdn->{dial_method} } @isdn_dial_methods; - $net->{ifcfg}{ippp0}{$_} = bool2yesno($method->{$_}) foreach qw(ONBOOT DIAL_ON_IFUP); - return $after_start_on_boot_step->(); - }, - }, - - ask_connect_now => - { - name => N("Do you want to try to connect to the Internet now?"), - type => "yesorno", - post => sub { - my ($a) = @_; - my $type = $net->{type}; - $up = 1; - if ($a) { - # local $::isWizard = 0; - my $_w = $in->wait_message('', N("Testing your connection..."), 1); - network::tools::stop_net_interface($net, 0); - if (exists $net->{adsl}{ethernet_device}) { - network::tools::stop_interface($net->{adsl}{ethernet_device}, 0); - sleep 1; - network::tools::start_interface($net->{adsl}{ethernet_device}, 0); - } - sleep 1; - network::tools::start_net_interface($net, 1); - my $s = 30; - $type =~ /modem/ and $s = 50; - $type =~ /adsl/ and $s = 35; - $type =~ /isdn/ and $s = 20; - sleep $s; - $up = network::tools::connected(); - } - $success = $up; - return $a ? "disconnect" : "end"; - } - }, - - - disconnect => - { - name => sub { - $up ? N("The system is now connected to the Internet.") . - if_($::isInstall, N("For security reasons, it will be disconnected now.")) : - N("The system does not seem to be connected to the Internet. -Try to reconfigure your connection."); - }, - no_back => 1, - end => 1, - post => sub { - $::isInstall and network::tools::stop_net_interface($net, 0); - return "end"; - }, - }, - - - end => - { - name => sub { - return $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 occurred during configuration. -Test your connection via net_monitor or mcc. If your connection does not work, you might want to relaunch the configuration."); - }, - end => 1, - }, - }, - }); - $wiz->process($in); - - #- keeping the translations in case someone want to restore these texts - if_(0, - # keep b/c of translations in case they can be reused somewhere else: - N("(detected on port %s)", 'toto'), - #-PO: here, "(detected)" string will be appended to eg "ADSL connection" - N("(detected %s)", 'toto'), N("(detected)"), - 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. -"), - N("The network needs to be restarted. Do you want to restart it?"), - N("A problem occurred while restarting the network: \n\n%s", 'foo'), - N("We are now going to configure the %s connection.\n\n\nPress \"%s\" to continue.", 'a', 'b'), - N("Configuration is complete, do you want to apply settings?"), - N("You have configured multiple ways to connect to the Internet.\nChoose the one you want to use.\n\n"), - N("Internet connection"), - ); -} - -sub safe_main { - my ($net, $in, $modules_conf) = @_; - eval { real_main($net, $in, $modules_conf) }; - my $err = $@; - if ($err) { # && $in->isa('interactive::gtk') - $err =~ /wizcancel/ and $in->exit(0); - - local $::isEmbedded = 0; # to prevent sub window embedding - local $::isWizard = 0 if !$::isInstall; # to prevent sub window embedding - #err_dialog(N("Error"), N("An unexpected error has happened:\n%s", $err)); - $in->ask_warn(N("Error"), N("An unexpected error has happened:\n%s", $err)); - } -} - -sub start_internet { - my ($o) = @_; - #- give a chance for module to be loaded using kernel-BOOT modules... - #- FIXME, this has nothing to do there - $::isStandalone or modules::load_category($o->{modules_conf}, 'network/*'); - network::tools::start_net_interface($o->{net}, 1); -} - -sub stop_internet { - my ($o) = @_; - network::tools::stop_net_interface($o->{net}, 1); -} - -1; - -=head1 network::netconnect::detect() - -=head2 example of usage - -use lib qw(/usr/lib/libDrakX); -use network::netconnect; -use modules; -use Data::Dumper; - -my %i; -my $modules_conf = modules::any_conf->read; -network::netconnect::detect($modules_conf, \%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 45c5dc2ee..000000000 --- a/perl-install/network/network.pm +++ /dev/null @@ -1,627 +0,0 @@ -package network::network; # $Id$wir - -#-###################################################################################### -#- misc imports -#-###################################################################################### - -use strict; - -use Socket; -use common; -use detect_devices; -use run_program; -use network::tools; -use vars qw(@ISA @EXPORT); -use log; - -my $network_file = "/etc/sysconfig/network"; -my $resolv_file = "/etc/resolv.conf"; -my $tmdns_file = "/etc/tmdns.conf"; - - -@ISA = qw(Exporter); -@EXPORT = qw(addDefaultRoute dns dnsServers gateway guessHostname is_ip is_ip_forbidden masked_ip netmask resolv sethostname); - -#- $net hash structure -#- autodetect -#- type -#- net_interface -#- PROFILE: selected netprofile -#- network (/etc/sysconfig/network) : NETWORKING FORWARD_IPV4 NETWORKING_IPV6 HOSTNAME GATEWAY GATEWAYDEV NISDOMAIN -#- NETWORKING : networking flag : string : "yes" by default -#- FORWARD_IPV4 : forward IP flag : string : "false" by default -#- HOSTNAME : hostname : string : "localhost.localdomain" by default -#- GATEWAY : gateway -#- GATEWAYDEV : gateway interface -#- NISDOMAIN : nis domain -#- NETWORKING_IPV6 : use IPv6, "yes" or "no" -#- IPV6_DEFAULTDEV -#- resolv (/etc/resolv.conf): dnsServer, dnsServer2, dnsServer3, DOMAINNAME, DOMAINNAME2, DOMAINNAME3 -#- dnsServer : dns server 1 -#- dnsServer2 : dns server 2 -#- dnsServer3 : dns server 3 : note that we uses the dns1 for the LAN, and the 2 others for the internet conx -#- DOMAINNAME : domainname : string : $net->{network}{HOSTNAME} =~ /\.(.*)/ by default -#- DOMAINNAME2 : well it's another domainname : have to look further why we used 2 -#- adsl: bus, Encapsulation, vpi, vci provider_id, method, login, passwd, ethernet_device, capi_card -#- cable: bpalogin, login, passwd -#- zeroconf: hostname -#- auth: LDAPDOMAIN WINDOMAIN -#- ifcfg (/etc/sysconfig/network-scripts/ifcfg-*): -#- key : device name -#- value : hash containing ifcfg file values, see write_interface_conf() for an exhaustive list -#- DHCP_HOSTNAME : If you have a dhcp and want to set the hostname -#- IPADDR : IP address -#- NETMASK : netmask -#- DEVICE : device name -#- BOOTPROTO : boot prototype : "bootp" or "dhcp" or "pump" or ... -#- IPV6INIT -#- IPV6TO4INIT -#- MS_DNS1 -#- MS_DNS2 -#- DOMAIN - -sub read_conf { - my ($file) = @_; - +{ getVarsFromSh($file) }; -} - -sub read_resolv_conf_raw { - my ($o_file) = @_; - my $s = cat_($o_file || $::prefix . $resolv_file); - { nameserver => [ $s =~ /^\s*nameserver\s+(\S+)/mg ], - search => [ if_($s =~ /^\s*search\s+(.*)/m, split(' ', $1)) ] }; -} - -sub read_resolv_conf { - my ($o_file) = @_; - my $resolv_conf = read_resolv_conf_raw($o_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); - - $intf{BOOTPROTO} ||= 'static'; - $intf{isPtp} = $intf{NETWORK} eq '255.255.255.255'; - $intf{isUp} = 1; - \%intf; -} - -sub read_zeroconf() { - cat_($::prefix . $tmdns_file) =~ /^\s*hostname\s*=\s*(\w+)/m && { ZEROCONF_HOSTNAME => $1 }; -} - -sub write_network_conf { - my ($net) = @_; - - if ($net->{network}{HOSTNAME} && $net->{network}{HOSTNAME} =~ /\.(.+)$/) { - $net->{resolv}{DOMAINNAME} = $1; - } - $net->{network}{NETWORKING} = 'yes'; - - setVarsInSh($::prefix . $network_file, $net->{network}, qw(HOSTNAME NETWORKING GATEWAY GATEWAYDEV NISDOMAIN FORWARD_IPV4 NETWORKING_IPV6 IPV6_DEFAULTDEV)); -} - -sub write_zeroconf { - my ($net, $in) = @_; - my $zhostname = $net->{zeroconf}{hostname}; - my $file = $::prefix . $tmdns_file; - - if ($zhostname) { - $in->do_pkgs->ensure_binary_is_installed('tmdns', 'tmdns', 'auto') if !$in->do_pkgs->is_installed('bind'); - $in->do_pkgs->ensure_binary_is_installed('zcip', 'zcip', 'auto'); - } - - #- write blank hostname even if disabled so that drakconnect does not assume zeroconf is enabled - eval { substInFile { s/^\s*(hostname)\s*=.*/$1 = $zhostname/ } $file } if $zhostname || -f $file; - - require services; - services::set_status('tmdns', $net->{zeroconf}{hostname}, $::isInstall); -} - -sub write_resolv_conf { - my ($net) = @_; - my $resolv = $net->{resolv}; - my $file = $::prefix . $resolv_file; - - my %new = ( - search => [ grep { $_ } uniq(@$resolv{'DOMAINNAME', 'DOMAINNAME2', 'DOMAINNAME3'}) ], - nameserver => [ grep { $_ } uniq(@$resolv{'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 if -l $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::explanations("neither domain name nor dns server are configured"); - 0; - } -} - -sub update_broadcast_and_network { - my ($intf) = @_; - my @ip = split '\.', $intf->{IPADDR}; - my @mask = split '\.', $intf->{NETMASK}; - $intf->{BROADCAST} = join('.', mapn { int($_[0]) | ((~int($_[1])) & 255) } \@ip, \@mask); - $intf->{NETWORK} = join('.', mapn { int($_[0]) & $_[1] } \@ip, \@mask); -} - -sub write_interface_settings { - my ($intf, $file) = @_; - setVarsInSh($file, $intf, qw(DEVICE BOOTPROTO IPADDR NETMASK NETWORK BROADCAST ONBOOT HWADDR METRIC MII_NOT_SUPPORTED TYPE USERCTL ATM_ADDR ETHTOOL_OPTS VLAN MTU MS_DNS1 MS_DNS2 DOMAIN), - 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 WIRELESS_WPA_DRIVER), - qw(DVB_ADAPTER_ID DVB_NETWORK_DEMUX DVB_NETWORK_PID), - qw(IPV6INIT IPV6TO4INIT), - qw(MRU REMIP PEERDNS PPPOPTIONS HARDFLOWCTL DEFABORT RETRYTIMEOUT PAPNAME LINESPEED MODEMPORT DEBUG ESCAPECHARS INITSTRING), - qw(DISCONNECTTIMEOUT PERSIST DEFROUTE), - if_($intf->{BOOTPROTO} eq "dhcp", qw(DHCP_CLIENT DHCP_HOSTNAME NEEDHOSTNAME PEERDNS PEERYP PEERNTPD DHCP_TIMEOUT)), - if_($intf->{DEVICE} =~ /^ippp\d+$/, qw(DIAL_ON_IFUP)) - ); - substInFile { s/^DEVICE='(`.*`)'/DEVICE=$1/g } $file; #- remove quotes if DEVICE is the result of a command - chmod $intf->{WIRELESS_ENC_KEY} ? 0700 : 0755, $file; #- hide WEP key for non-root users - log::explanations("written $intf->{DEVICE} interface configuration in $file"); -} - -sub write_interface_conf { - my ($net, $name) = @_; - - my $file = "$::prefix/etc/sysconfig/network-scripts/ifcfg-$name"; - #- prefer ifcfg-XXX files - unlink("$::prefix/etc/sysconfig/network-scripts/$name"); - - my $intf = $net->{ifcfg}{$name}; - - require network::ethernet; - my (undef, $mac_address) = network::ethernet::get_eth_card_mac_address($intf->{DEVICE}); - $intf->{HWADDR} &&= $mac_address; #- set HWADDR to MAC address if required - - update_broadcast_and_network($intf); - $intf->{ONBOOT} ||= bool2yesno(!member($intf->{DEVICE}, map { $_->{device} } detect_devices::pcmcia_probe())); - - defined($intf->{METRIC}) or $intf->{METRIC} = network::tools::get_default_metric(network::tools::get_interface_type($intf)), - $intf->{BOOTPROTO} =~ s/dhcp.*/dhcp/; - - write_interface_settings($intf, $file); -} - -sub write_wireless_conf { - my ($ssid, $ifcfg) = @_; - my $wireless_file = "$::prefix/etc/sysconfig/network-scripts/wireless.d/$ssid"; - write_interface_settings($ifcfg, $wireless_file); - # FIXME: write only DHCP/IP settings here - substInFile { $_ = '' if /^DEVICE=/ } $wireless_file; -} - -sub add2hosts { - my ($hostname, @ips) = @_; - my ($sub_hostname) = $hostname =~ /(.*?)\./; - - my $file = "$::prefix/etc/hosts"; - - my %l; - foreach (cat_($file)) { - my ($ip, $aliases) = /^\s*(\S+)\s+(\S+.*)$/ or next; - push @{$l{$ip}}, difference2([ split /\s+/, $aliases ], [ $hostname, $sub_hostname ]); - } cat_($file); - - unshift @{$l{$_}}, $hostname, if_($sub_hostname, $sub_hostname) foreach grep { $_ } @ips; - - log::explanations("writing host information to $file"); - output($file, map { "$_\t\t" . join(" ", @{$l{$_}}) . "\n" } keys %l); -} - -# The interface/gateway needs to be configured before this will work! -sub guessHostname { - my ($net, $intf_name) = @_; - - $net->{ifcfg}{$intf_name}{isUp} && dnsServers($net) or return 0; - $net->{network}{HOSTNAME} && $net->{resolv}{DOMAINNAME} and return 1; - - write_resolv_conf($net); - - my $name = gethostbyaddr(Socket::inet_aton($net->{ifcfg}{$intf_name}{IPADDR}), Socket::AF_INET()) or log::explanations("reverse name lookup failed"), return 0; - - log::explanations("reverse name lookup worked"); - - $net->{network}{HOSTNAME} ||= $name; - 1; -} - -sub addDefaultRoute { - my ($net) = @_; - c::addDefaultRoute($net->{network}{GATEWAY}) if $net->{network}{GATEWAY}; -} - -sub sethostname { - my ($net) = @_; - my $text; - my $hostname = $net->{network}{HOSTNAME}; - syscall_("sethostname", $hostname, length $hostname) ? ($text="set sethostname to $hostname") : ($text="sethostname failed: $!"); - log::explanations($text); - - run_program::run("/usr/bin/run-parts", "--arg", $hostname, "/etc/sysconfig/network-scripts/hostname.d") unless $::isInstall; -} - -sub resolv($) { - my ($name) = @_; - is_ip($name) and return $name; - my $a = join(".", unpack "C4", (gethostbyname $name)[4]); - #-log::explanations("resolved $name in $a"); - $a; -} - -sub dnsServers { - my ($net) = @_; - #- FIXME: that's weird - my %used_dns; @used_dns{$net->{network}{dnsServer}, $net->{network}{dnsServer2}, $net->{network}{dnsServer3}} = (1, 2, 3); - sort { $used_dns{$a} <=> $used_dns{$b} } grep { $_ } keys %used_dns; -} - -sub findIntf { - my ($net, $device) = @_; - $net->{ifcfg}{$device}{DEVICE} = undef; - $net->{ifcfg}{$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 netprofile_set { - my ($net, $profile) = @_; - $net->{PROFILE} = $profile; - system('/sbin/set-netprofile', $net->{PROFILE}); - log::explanations(qq(Switching to "$net->{PROFILE}" profile)); -} - -sub netprofile_save { - my ($net) = @_; - system('/sbin/save-netprofile', $net->{PROFILE}); - log::explanations(qq(Saving "$net->{PROFILE}" profile)); -} - -sub netprofile_delete { - my ($profile) = @_; - return if !$profile || $profile eq "default"; - rm_rf("$::prefix/etc/netprofile/profiles/$profile"); - log::explanations(qq(Deleting "$profile" profile)); -} - -sub netprofile_add { - my ($net, $profile) = @_; - return if !$profile || $profile eq "default" || member($profile, netprofile_list()); - system('/sbin/clone-netprofile', $net->{PROFILE}, $profile); - log::explanations(qq("Creating "$profile" profile)); -} - -sub netprofile_list() { - map { if_(m!([^/]*)/$!, $1) } glob("$::prefix/etc/netprofile/profiles/*/"); -} - -sub netprofile_read { - my ($net) = @_; - my $config = { getVarsFromSh("$::prefix/etc/netprofile/current") }; - $net->{PROFILE} = $config->{PROFILE} || 'default'; -} - - -sub miscellaneous_choose { - my ($in, $u) = @_; - - my $use_http_for_https = $u->{https_proxy} eq $u->{http_proxy}; - $in->ask_from(N("Proxies configuration"), - N("Here you can set up your proxies configuration (eg: http://my_caching_server:8080)"), - [ { label => N("HTTP proxy"), val => \$u->{http_proxy} }, - { text => N("Use HTTP proxy for HTTPS connections"), val => \$use_http_for_https, type => "bool" }, - { label => N("HTTPS proxy"), val => \$u->{https_proxy}, disabled => sub { $use_http_for_https } }, - { label => N("FTP proxy"), val => \$u->{ftp_proxy} }, - ], - complete => sub { - $use_http_for_https and $u->{https_proxy} = $u->{http_proxy}; - $u->{http_proxy} =~ m,^($|http://), or $in->ask_warn('', N("Proxy should be http://...")), return 1,0; - $u->{https_proxy} =~ m,^($|http://), or $in->ask_warn('', N("Proxy should be https?://...")), return 1,2; - $u->{ftp_proxy} =~ m,^($|ftp://|http://), or $in->ask_warn('', N("URL should begin with 'ftp:' or 'http:'")), return 1,3; - 0; - } - ) or return; - 1; -} - -sub proxy_configure { - my ($u) = @_; - my $sh_file = "$::prefix/etc/profile.d/proxy.sh"; - setExportedVarsInSh($sh_file, $u, qw(http_proxy https_proxy ftp_proxy)); - chmod 0755, $sh_file; - my $csh_file = "$::prefix/etc/profile.d/proxy.csh"; - setExportedVarsInCsh($csh_file, $u, qw(http_proxy https_proxy ftp_proxy)); - chmod 0755, $csh_file; - - #- KDE proxy settings - my $kde_config_dir = "$::prefix/usr/share/config"; - my $kde_config_file = "$kde_config_dir/kioslaverc"; - if (-d $kde_config_dir) { - update_gnomekderc($kde_config_file, - undef, - PersistentProxyConnection => "false" - ); - update_gnomekderc($kde_config_file, - "Proxy Settings", - AuthMode => 0, - ProxyType => $u->{http_proxy} || $u->{https_proxy} || $u->{ftp_proxy} ? 4 : 0, - ftpProxy => "ftp_proxy", - httpProxy => "http_proxy", - httpsProxy => "https_proxy" - ); - } - - #- Gnome proxy settings - if (-d "$::prefix/etc/gconf/2/") { - my $defaults_dir = "/etc/gconf/gconf.xml.local-defaults"; - my $p_defaults_dir = "$::prefix$defaults_dir"; - my $p_defaults_path = "$::prefix/etc/gconf/2/local-defaults.path"; - -r $p_defaults_path or output_with_perm($p_defaults_path, 0755, qq( -# System local settings -xml:readonly:$defaults_dir -)); - -d $p_defaults_dir or mkdir $p_defaults_dir, 0755; - - my $use_alternate_proxy; - my $gconf_set = sub { - my ($key, $type, $value) = @_; - #- gconftool-2 is available since /etc/gconf/2/ exists - system("gconftool-2", "--config-source=xml::$p_defaults_dir", "--direct", "--set", "--type=$type", $key, $value); - }; - - #- http proxy - if (my ($user, $password, $host, $port) = $u->{http_proxy} =~ m,^http://(?:([^:\@]+)(?::([^:\@]+))?\@)?([^\:]+)(?::(\d+))?$,) { - $port ||= 80; - $gconf_set->("/system/http_proxy/use_http_proxy", "bool", 1); - $gconf_set->("/system/http_proxy/host", "string", $host); - $gconf_set->("/system/http_proxy/port", "int", $port); - $gconf_set->("/system/http_proxy/use_authentication", "bool", to_bool($user)); - $user and $gconf_set->("/system/http_proxy/authentication_user", "string", $user); - $password and $gconf_set->("/system/http_proxy/authentication_password", "string", $password); - } else { - $gconf_set->("/system/http_proxy/use_http_proxy", "bool", 0); - } - - #- https proxy - if (my ($host, $port) = $u->{https_proxy} =~ m,^https?://(?:[^:\@]+(?::[^:\@]+)?\@)?([^\:]+)(?::(\d+))?$,) { - $port ||= 443; - $gconf_set->("/system/proxy/secure_host", "string", $host); - $gconf_set->("/system/proxy/secure_port", "int", $port); - $use_alternate_proxy = 1; - } else { - #- clear the ssl host so that it isn't used if the manual proxy is activated for ftp - $gconf_set->("/system/proxy/secure_host", "string", ""); - } - - #- ftp proxy - if (my ($host, $port) = $u->{ftp_proxy} =~ m,^(?:http|ftp)://(?:[^:\@]+(?::[^:\@]+)?\@)?([^\:]+)(?::(\d+))?$,) { - $port ||= 21; - $gconf_set->("/system/proxy/ftp_host", "string", $host); - $gconf_set->("/system/proxy/ftp_port", "int", $port); - $use_alternate_proxy = 1; - } else { - #- clear the ftp host so that it isn't used if the manual proxy is activated for ssl - $gconf_set->("/system/proxy/ftp_host", "string", ""); - } - - #- set proxy mode to manual if either https or ftp is used - $gconf_set->("/system/proxy/mode", "string", $use_alternate_proxy ? "manual" : "none"); - - #- make gconf daemons reload their settings - system("killall -s HUP gconfd-2"); - } -} - -sub read_net_conf { - my ($net) = @_; - add2hash($net->{network} ||= {}, read_conf($::prefix . $network_file)); - add2hash($net->{resolv} ||= {}, read_resolv_conf()); - add2hash($net->{zeroconf} ||= {}, read_zeroconf()); - - foreach (all("$::prefix/etc/sysconfig/network-scripts")) { - my ($device) = /^ifcfg-([A-Za-z0-9.:_-]+)$/; - next if $device =~ /.rpmnew$|.rpmsave$/; - if ($device && $device ne 'lo') { - my $intf = findIntf($net, $device); - add2hash($intf, { getVarsFromSh("$::prefix/etc/sysconfig/network-scripts/$_") }); - $intf->{DEVICE} ||= $device; - } - } - $net->{wireless} ||= {}; - foreach (all("$::prefix/etc/sysconfig/network-scripts/wireless.d")) { - $net->{wireless}{$_} = { getVarsFromSh("$::prefix/etc/sysconfig/network-scripts/wireless.d/$_") }; - } - netprofile_read($net); - if (my $default_intf = network::tools::get_default_gateway_interface($net)) { - $net->{net_interface} = $default_intf; - $net->{type} = network::tools::get_interface_type($net->{ifcfg}{$default_intf}); - } -} - -#- FIXME: this is buggy, use network::tools::get_default_gateway_interface -sub probe_netcnx_type { - my ($net) = @_; - #- try to probe $netcnx->{type} which is used almost everywhere. - unless ($net->{type}) { - #- ugly hack to determine network type (avoid saying not configured in summary). - -e "$::prefix/etc/ppp/peers/adsl" and $net->{type} ||= 'adsl'; # enough ? - -e "$::prefix/etc/ppp/ioptions1B" || -e "$::prefix/etc/ppp/ioptions2B" and $net->{type} ||= 'isdn'; # enough ? - $net->{ifcfg}{ppp0} and $net->{type} ||= 'modem'; - $net->{ifcfg}{eth0} and $net->{type} ||= 'lan'; - } -} - -sub easy_dhcp { - my ($net, $modules_conf) = @_; - - return if text2bool($net->{network}{NETWORKING}); - - require modules; - require network::ethernet; - modules::load_category($modules_conf, list_modules::ethernet_categories()); - my @all_dev = sort map { $_->[0] } network::ethernet::get_eth_cards($modules_conf); - - #- only for a single ethernet network card - my @ether_dev = grep { /^eth[0-9]+$/ && `LC_ALL= LANG= $::prefix/sbin/ip -o link show $_ 2>/dev/null` =~ m|\slink/ether\s| } @all_dev; - @ether_dev == 1 or return; - - my $dhcp_intf = $ether_dev[0]; - log::explanations("easy_dhcp: found $dhcp_intf"); - - put_in_hash($net->{network}, { - NETWORKING => "yes", - DHCP => "yes", - NET_DEVICE => $dhcp_intf, - NET_INTERFACE => $dhcp_intf, - }); - $net->{ifcfg}{$dhcp_intf} ||= {}; - put_in_hash($net->{ifcfg}{$dhcp_intf}, { - DEVICE => $dhcp_intf, - BOOTPROTO => 'dhcp', - NETMASK => '255.255.255.0', - ONBOOT => 'yes' - }); - $net->{type} = 'lan'; - $net->{net_interface} = $dhcp_intf; - - 1; -} - -sub configure_network { - my ($net, $in, $modules_conf) = @_; - if (!$::testing) { - require network::ethernet; - network::ethernet::configure_eth_aliases($modules_conf); - - write_network_conf($net); - write_resolv_conf($net); - if ($::isInstall && ! -e "/etc/resolv.conf") { - #- symlink resolv.conf in install root too so that updates and suppl media can be added - symlink "$::prefix/etc/resolv.conf", "/etc/resolv.conf"; - } - foreach (keys %{$net->{ifcfg}}) { - write_interface_conf($net, $_); - my $ssid = $net->{ifcfg}{$_}{WIRELESS_ESSID} or next; - write_wireless_conf($ssid, $net->{ifcfg}{$_}); - } - network::ethernet::install_dhcp_client($in, $_->{DHCP_CLIENT}) foreach grep { $_->{BOOTPROTO} eq "dhcp" } values %{$net->{ifcfg}}; - add2hosts("localhost", "127.0.0.1"); - add2hosts($net->{network}{HOSTNAME}, "127.0.0.1") if $net->{network}{HOSTNAME}; - write_zeroconf($net, $in); - - any { $_->{BOOTPROTO} =~ /^(pump|bootp)$/ } values %{$net->{ifcfg}} and $in->do_pkgs->install('pump'); - - require network::shorewall; - network::shorewall::update_interfaces_list(); - - $net->{network}{HOSTNAME} && !$::isInstall and sethostname($net); - } - - #- make net_applet reload the configuration - my $pid = chomp_(`pidof -x net_applet`); - $pid and kill 1, $pid; -} - -1; diff --git a/perl-install/network/nfs.pm b/perl-install/network/nfs.pm deleted file mode 100644 index 194a9c678..000000000 --- a/perl-install/network/nfs.pm +++ /dev/null @@ -1,68 +0,0 @@ -package network::nfs; # $Id$ - -use strict; -use diagnostics; - -use common; -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_binary_is_installed('nfs-utils-clients', 'showmount') or return; - system('/etc/init.d/portmap start') if system('/etc/init.d/portmap status') != 0; - 1; -} - -sub find_servers { - open(my $F2, "rpcinfo-flushed -b mountd 2 |"); - open(my $F3, "rpcinfo-flushed -b mountd 3 |"); - - common::nonblock($F2); - common::nonblock($F3); - my $domain = chomp_(`domainname`); - my ($s, %servers); - my $quit; - while (!$quit) { - $quit = 1; - sleep 1; - while ($s = <$F2> || <$F3>) { - $quit = 0; - my ($ip, $name) = $s =~ /(\S+)\s+(\S+)/ or log::explanations("bad line in rpcinfo output"), next; - $name =~ s/\.$//; - $name =~ s/\Q.$domain\E$//; - $servers{$ip} ||= { ip => $ip, if_($name ne '(unknown)', name => $name) }; - } - } - values %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/pxe.pm b/perl-install/network/pxe.pm deleted file mode 100644 index 1bc625ad0..000000000 --- a/perl-install/network/pxe.pm +++ /dev/null @@ -1,286 +0,0 @@ -package network::pxe; - -use common; -use network::tools; -use Xconfig::resolution_and_depth; - -our $tftp_root = "/var/lib/tftpboot"; -my $client_path = '/X86PC/linux'; -our $pxelinux_client_root = $tftp_root . $client_path; -our $pxelinux_images = $pxelinux_client_root . '/images'; -our $pxelinux_help_file = $pxelinux_client_root . '/help.txt'; -our $pxelinux_message_file = $pxelinux_client_root . '/messages'; -my $pxelinux_config_root = $pxelinux_client_root . '/pxelinux.cfg'; -our $pxelinux_config_file = $pxelinux_config_root . '/default'; -our $pxe_config_file = '/etc/pxe.conf'; - -my @global_pxelinux_settings = qw(PROMPT DEFAULT DISPLAY TIMEOUT F1); -my @append_settings = qw(initrd ramdisk_size vga display auto_install); -my @automatic_settings = qw(method interface network server directory); - -our %vga_bios_to_resolution = ( - 'normal' => "vga", - 'text' => "text", - '' => "automatic", - map { $_->{bios} => "$_->{X}x$_->{Y}" } grep { $_->{Depth} == 16 } Xconfig::resolution_and_depth::bios_vga_modes() - ); -our %vga_resolution_to_bios = reverse %vga_bios_to_resolution; - -sub read_pxelinux_help { - my ($help_file) = @_; - my %info; - foreach (cat_($help_file)) { - /^(\w+)\s*:\s*(.*)$/ and $info{$1} = $2; - } - \%info; -} - -sub read_pxelinux_conf { - my ($conf_file, $help_file) = @_; - my (%conf); - my $info = read_pxelinux_help($help_file); - my $entry = {}; - foreach (cat_($conf_file)) { - my $global = join('|', @global_pxelinux_settings); - if (/^($global)\s+(.*)/) { - $conf{lc($1)} = $2; - } elsif (/^label\s+(.*)/) { - $entry->{label} = $1; - } elsif (/^\s+LOCALBOOT\s+(\d+)/) { - $entry->{localboot} = $1; - } elsif (/^\s+KERNEL\s+(.*)/) { - $entry->{kernel} = $1; - } elsif (/^\s+APPEND\s+(.*)/) { - my @others; - foreach (split /\s+/, $1) { - my ($option, $value) = /^(.+?)(?:=(.*))?$/; - if (member($option, @append_settings)) { - $entry->{$option} = $value; - } elsif ($option eq 'automatic') { - foreach (split /,/, $value) { - my ($option, $value) = /^(.+?):(.+)$/; - $entry->{$option} = $value; - } - } else { - push @others, $_; - } - } - $entry->{others} = join(' ', @others); - } - if (exists $entry->{label} && (exists $entry->{localboot} || exists $entry->{kernel} && exists $entry->{initrd})) { - $entry->{info} = $info->{$entry->{label}}; - push @{$conf{entries}}, $entry; - $entry = {}; - } - } - \%conf; -} - - -sub list_pxelinux_labels { - my ($conf) = @_; - map { $_->{label} } @{$conf->{entries}}; -} - -sub write_pxelinux_conf { - my ($conf, $conf_file) = @_; - - output($conf_file, - join("\n", - "# DO NOT EDIT auto_generated by drakpxelinux.pl", - (map { $_ . ' ' . $conf->{lc($_)} } @global_pxelinux_settings), - '', - (map { - my $e = $_; - my $automatic = join(',', map { "$_:$e->{$_}" } grep { $e->{$_} } @automatic_settings); - ("label $e->{label}", - exists $e->{localboot} ? - " LOCALBOOT $e->{localboot}" : - (" KERNEL $e->{kernel}", - " APPEND " . join(' ', - (map { "$_=$e->{$_}" } grep { $e->{$_} } @append_settings), - if_($automatic, "automatic=$automatic"), - $e->{others})), - ''); - } @{$conf->{entries}}))); -} - -sub write_default_pxe_messages { - my ($net) = @_; - my $hostname = $net->{hostname} || chomp_(`hostname`); - output($pxelinux_message_file, <<EOF); - - Welcome to Mandriva Linux PXE Server - Pxelinux - . .-----------------------------------. - /|\\ / Press F1 for available images \\ - /_|_\\ \\ Hosted by $hostname - \\ | / _ /'-----------------------------------' - \\|/ (') / - '. U / (O__ - . '. / (o_ (o_ (0_ //\\ - {o_ (o_ (o_ (o_ (o_ //\\ //\\ //\\ // ) - (')_ (`)_ (/)_ (/)_ (/)_ V_/_ V_/_ V_/_ V__/_ - --------------------------------------------------------- - - press F1 for help -EOF -} - -sub write_default_pxe_help() { - output($pxelinux_help_file, <<EOF); -Available images are: ---------------------- -local: local boot -EOF -} - -sub add_in_help { - my ($NAME, $INFO) = @_; - if (!any { /$NAME/ } cat_($pxelinux_help_file)) { - append_to_file($pxelinux_help_file, <<EOF); -$NAME : $INFO -EOF - - } else { - substInFile { - s/$NAME.*/$NAME : $INFO/; - } $pxelinux_help_file; - } -} - -sub change_label_in_help { - my ($NAMEOLD, $NEWNAME) = @_; - substInFile { - s/$NAMEOLD\s(.*)/$NEWNAME $1/; - } $pxelinux_help_file; -} - -# remove entry in help.txt -sub remove_in_help { - my ($NAME) = @_; - substInFile { - s/^$NAME\s:.*//x; - s/^\s*$//; - } $pxelinux_help_file; -} - -# adjust pxe confi with good value -sub write_pxe_conf { - my ($net, $interface) = @_; - if (!-f "$pxe_config_file.orig") { cp_af($pxe_config_file, "$pxe_config_file.orig") } - my $domainname = $net->{resolv}{domainname} || chomp_(`dnsdomainname`); - my $ip_address = network::tools::get_interface_ip_address($net, $interface); - - substInFile { - s/default_address.*/default_address=$ip_address/; - s/mtftp_address.*/mtftp_address=$ip_address/; - s/domain.*/domain=$domainname/; - } $pxe_config_file; -} - - -sub get_pxelinux_config_file_for_mac_address { - my ($mac_address) = @_; - #- 01 is the hardware type: Ethernet (ARP type 1) - $pxelinux_config_root . "/" . join('-', '01', split(/:/, $mac_address)); -} - -sub set_profile_for_mac_address { - my ($profile, $to_install, $mac_address) = @_; - if ($profile) { - symlinkf("profiles/" . ($to_install ? "install/" : "boot/") . $profile, get_pxelinux_config_file_for_mac_address($mac_address)); - } else { - unlink get_pxelinux_config_file_for_mac_address($mac_address); - } -} - -#- returns (profile_type, profile_name) -sub profile_from_file { - my ($file) = @_; - $file =~ m!(?:^|/)profiles/(\w+)/(.*)?$!; -} - -sub read_profiles() { - my %profiles_conf; - - foreach (all($pxelinux_config_root)) { - my $file = $pxelinux_config_root . '/' . $_; - if (-l $file && /^01(?:-([0-9a-z]{2}))+$/) { - #- per MAC address settings - #- the filename looks like 01-aa-bb-cc-dd-ee-ff - #- where AA:BB:CC:DD:EE:FF is the MAC address - my ($type, $name) = profile_from_file(readlink($file)); - tr/-/:/; - my $mac_address = substr($_, 3); - $profiles_conf{per_mac}{$mac_address} = { profile => $name, to_install => $type eq 'install' }; - } - } - - foreach my $type (qw(boot install)) { - my $root = $pxelinux_config_root . '/profiles/' . $type; - mkdir_p($root); - $profiles_conf{profiles}{$type}{$_} = 1 foreach all($root); - } - - \%profiles_conf; -} - -#- returns (pxelinux entries file, help file) -sub get_pxelinux_profile_path { - my ($profile, $type) = @_; - my $root = $pxelinux_config_root . '/profiles/' . $type; - "$root/$profile", "$root/help-$profile.txt"; -} - -sub list_profiles { - my ($profiles_conf) = @_; - sort(uniq(map { keys %{$profiles_conf->{profiles}{$_}} } qw(boot install))); -} - -sub profile_exists { - my ($profiles_conf, $profile) = @_; - member($profile, network::pxe::list_profiles($profiles_conf)); -} - -sub find_next_profile_name { - my ($profiles_conf, $prefix) = @_; - my $i; - /^$prefix(\d*)$/ && $1 >= $i and $i = $1 + 1 foreach network::pxe::list_profiles($profiles_conf); - "$prefix$i"; -} - -sub add_empty_profile { - my ($profiles_conf, $profile, $to_install) = @_; - $to_install and $profiles_conf->{profiles}{install}{$profile} = 1; - $profiles_conf->{profiles}{boot}{$profile} = 1; -} - -sub copy_profile_for_type { - my ($profile, $clone, $type) = @_; - my ($pxe, $help) = get_pxelinux_profile_path($profile, $type); - my ($clone_pxe, $clone_help) = get_pxelinux_profile_path($clone, $type); - -r $pxe and cp_f($pxe, $clone_pxe); - -r $help and cp_f($help, $clone_help); -} - -sub clone_profile { - my ($profiles_conf, $profile) = @_; - my $clone = find_next_profile_name($profiles_conf, $profile); - if (exists $profiles_conf->{profiles}{install}{$profile}) { - $profiles_conf->{profiles}{install}{$clone} = 1; - copy_profile_for_type($profile, $clone, 'install'); - } - $profiles_conf->{profiles}{boot}{$clone} = 1; - copy_profile_for_type($profile, $clone, 'boot'); -} - -sub remove_profile { - my ($profiles_conf, $profile) = @_; - foreach my $type (qw(boot install)) { - delete $profiles_conf->{profiles}{$type}{$profile}; - unlink(get_pxelinux_profile_path($profile, $type)); - } -} - -1; diff --git a/perl-install/network/shorewall.pm b/perl-install/network/shorewall.pm deleted file mode 100644 index 2567b4881..000000000 --- a/perl-install/network/shorewall.pm +++ /dev/null @@ -1,172 +0,0 @@ -package network::shorewall; # $Id$ - -use detect_devices; -use network::ethernet; -use network::network; -use run_program; -use common; -use log; - -sub check_iptables() { - -f "$::prefix/etc/sysconfig/iptables" || - $::isStandalone && do { - system('modprobe iptable_nat'); - -x '/sbin/iptables' && listlength(`/sbin/iptables -t nat -nL`) > 8; - }; -} - -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 get_ifcfg_interface() { - my $net = {}; - network::network::read_net_conf($net); - network::tools::get_default_gateway_interface($net); -} - -sub dev_to_shorewall { - my ($dev) = @_; - $dev =~ /^ippp/ && "ippp+" || - $dev =~ /^ppp/ && "ppp+" || - $dev; -} - -sub get_shorewall_interface() { - #- read shorewall configuration first - foreach (get_config_file('interfaces')) { - $_->[0] eq 'net' and return $_->[1]; - } - #- else try to find the best interface available - dev_to_shorewall(get_ifcfg_interface()); -} - -our $ask_shorewall_interface_label = N_("Please enter the name of the interface connected to the internet. - -Examples: - ppp+ for modem or DSL connections, - eth0, or eth1 for cable connection, - ippp+ for a isdn connection. -"); - -sub shorewall_interface_choices { - my ($refval) = @_; - my $modules_conf = modules::any_conf->read; - my @all_cards = network::ethernet::get_eth_cards($modules_conf); - my %net_devices = network::ethernet::get_eth_cards_names(@all_cards); - put_in_hash(\%net_devices, { 'ppp+' => 'ppp+', 'ippp+' => 'ippp+' }); - - [ { label => N("Net Device"), val => $refval, list => [ sort keys %net_devices ], format => sub { $net_devices{$_[0]} || $_[0] }, not_edit => 0 } ]; -} - -sub read_default_interfaces { - my ($conf, $o_in) = @_; - my $interface = get_shorewall_interface(); - $o_in and $o_in->ask_from('', translate($ask_shorewall_interface_label), shorewall_interface_choices(\$interface)); - set_net_interface($conf, $interface); -} - -sub set_net_interface { - my ($conf, $interface) = @_; - $conf->{net_interface} = $interface; - my $net = {}; - network::network::read_net_conf($net); - my @all_intf = uniq((map { dev_to_shorewall($_) } keys %{$net->{ifcfg}}), detect_devices::getNet()); - #- keep all other interfaces (but alias interfaces) in local zone - $conf->{loc_interface} = [ grep { !/:/ && $_ ne $interface } @all_intf ]; -} - -sub read { - my ($o_in) = @_; - my @rules = get_config_file('rules'); - my %conf = (disabled => !glob_("$::prefix/etc/rc3.d/S*shorewall"), - ports => join(' ', map { - my $e = $_; - map { "$_/$e->[3]" } split(',', $e->[4]); - } grep { $_->[0] eq 'ACCEPT' && $_->[1] eq 'net' } @rules), - ); - $conf{redirects}{$_->[3]}{$_->[2]} = $_->[4] foreach grep { $_->[0] eq 'REDIRECT' } @rules; - - if (my ($e) = get_config_file('masq')) { - $conf{masq_subnet} = $e->[1]; - } - read_default_interfaces(\%conf, $o_in); - $conf{net_interface} && \%conf; -} - -sub ports_by_proto { - my ($ports) = @_; - my %ports_by_proto; - foreach (split ' ', $ports) { - m!^(\d+(?::\d+)?)/(udp|tcp|icmp)$! or die "bad port $_\n"; - push @{$ports_by_proto{$2}}, $1; - } - \%ports_by_proto; -} - -sub write { - my ($conf) = @_; - my $default_intf = get_ifcfg_interface(); - my $use_pptp = $default_intf =~ /^ppp/ && cat_("$::prefix/etc/ppp/peers/$default_intf") =~ /pptp/; - my $ports_by_proto = ports_by_proto($conf->{ports}); - - my $interface_settings = sub { - my ($zone, $interface) = @_; - [ $zone, $interface, 'detect', if_(detect_devices::is_bridge_interface($interface), 'routeback') ]; - }; - - set_config_file("zones", - [ 'net', 'ipv4' ], - if_($conf->{loc_interface}[0], [ 'loc', 'ipv4' ]), - [ 'fw', 'firewall' ], - ); - set_config_file('interfaces', - $interface_settings->('net', $conf->{net_interface}), - (map { $interface_settings->('loc', $_) } @{$conf->{loc_interface} || []}), - ); - set_config_file('policy', - if_($conf->{loc_interface}[0], [ 'loc', 'net', 'ACCEPT' ], [ 'loc', 'fw', 'ACCEPT' ], [ 'fw', 'loc', 'ACCEPT' ]), - [ 'fw', 'net', 'ACCEPT' ], - [ 'net', 'all', 'DROP', 'info' ], - [ 'all', 'all', 'REJECT', 'info' ], - ); - set_config_file('rules', - if_($use_pptp, [ 'ACCEPT', 'fw', 'loc:10.0.0.138', 'tcp', '1723' ]), - if_($use_pptp, [ 'ACCEPT', 'fw', 'loc:10.0.0.138', 'gre' ]), - (map_each { [ 'ACCEPT', 'net', 'fw', $::a, join(',', @$::b), '-' ] } %$ports_by_proto), - (map { - map_each { [ 'REDIRECT', 'loc', $::a, $_, $::b, '-' ] } %{$conf->{redirects}{$_}}; - } keys %{$conf->{redirects}}), - ); - set_config_file('masq', if_($conf->{masq_subnet}, [ $conf->{net_interface}, $conf->{masq_subnet} ])); - - require services; - if ($conf->{disabled}) { - services::disable('shorewall', $::isInstall); - run_program::rooted($::prefix, '/sbin/shorewall', 'clear') unless $::isInstall; - } else { - services::enable('shorewall', $::isInstall); - } -} - -sub update_interfaces_list() { - my $shorewall = network::shorewall::read(); - $shorewall && !$shorewall->{disabled} and network::shorewall::write($shorewall); -} - -1; diff --git a/perl-install/network/smb.pm b/perl-install/network/smb.pm deleted file mode 100644 index 7fca6d65c..000000000 --- a/perl-install/network/smb.pm +++ /dev/null @@ -1,217 +0,0 @@ -package network::smb; # $Id$ - -use strict; -use diagnostics; - -use common; -use fs::mount_options; -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_binary_is_installed('samba-client', 'nmblookup'); -} - -sub smbclient { - my ($server) = @_; - my $name = $server->{name} || $server->{ip}; - my $ip = $server->{ip} ? "-I $server->{ip}" : ''; - my $group = $server->{group} ? qq( -W "$server->{group}") : ''; - - my $U = $server->{username} ? sprintf("%s/%s%%%s", @$server{'domain', 'username', 'password'}) : '%'; - my %h; - foreach (`smbclient -g -U "$U" -L "$name" $ip$group 2>/dev/null`) { - if (my ($type, $v1, $v2) = /(.*)\|(.*)\|(.*)/) { - push @{$h{$type}}, [ $v1, $v2 ]; - } elsif (/^Error returning browse list/) { - push @{$h{Error}}, $_; - } - } - \%h; -} - -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; - my $workgroups = smbclient($browse)->{Workgroup} || []; - foreach (@$workgroups) { - my ($group, $name) = map { 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; - - my $browse = smbclient($server); - if (my $err = find { /NT_STATUS_/ } @{$browse->{Error} || []}) { - die $err; - } - foreach (@{$browse->{Disk} || []}) { - my ($name, $comment) = @$_; - push @l, { name => $name, type => 'Disk', comment => $comment, server => $server } - if $name !~ /\$$/ && $name !~ /netlogon|NETLOGON|SYSVOL/; - } - @l; -} - -sub authentications_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 did not 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 - unix charset = ISO8859-15 - os level = 18 - local master = No - dns proxy = No - idmap uid = 10000-20000 - idmap gid = 10000-20000 - winbind separator = + - template homedir = /home/%D/%U - template shell = /bin/bash - winbind use default domain = yes -"); -} - -sub write_smb_ads_conf { - my ($domain, $realm) = @_; - - #- was going to just have a canned config in samba-winbind - #- and replace the domain, but sylvestre/buchan did not bless it yet - - my $f = "$::prefix/etc/samba/smb.conf"; - rename $f, "$f.orig"; - output($f, " -[global] - workgroup = $domain - realm = $realm - server string = Samba Member %v - security = ads - 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 - 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 bc5b92b60..000000000 --- a/perl-install/network/smbnfs.pm +++ /dev/null @@ -1,45 +0,0 @@ -package network::smbnfs; # $Id$ - -use strict; -use diagnostics; - -use fs::mount_options; - - -sub new { - my ($class, $o_v) = @_; - bless($o_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, $fs_type) = @_; - my $fs_entry = { device => $class->to_dev($e), fs_type => $fs_type }; - fs::mount_options::set_default($fs_entry); - $fs_entry; -} - -1; - diff --git a/perl-install/network/squid.pm b/perl-install/network/squid.pm deleted file mode 100644 index 7ca60d2b6..000000000 --- a/perl-install/network/squid.pm +++ /dev/null @@ -1,73 +0,0 @@ -package network::squid; - -use strict; -use common; - -our $squid_conf_file = "$::prefix/etc/squid/squid.conf"; - -sub read_squid_conf { - my ($o_file) = @_; - my $s = cat_($o_file || $squid_conf_file); - { http_port => [ $s =~ /^\s*http_port\s+(.*)/mg ], - cache_size => [ if_($s =~ /^\s*cache_dir diskd\s+(.*)/mg, split(' ', $1)) ], - admin_mail => [ if_($s =~ /^\s*err_html_text\s+(.*)/mg, split(' ', $1)) ] }; -} - -sub write_squid_conf { - my ($squid_conf, $intf, $internal_domain_name) = @_; - - renamef($squid_conf_file, "$squid_conf_file.old"); - output($squid_conf_file, qq( -http_port $squid_conf->{http_port}[0] -hierarchy_stoplist cgi-bin ? -acl QUERY urlpath_regex cgi-bin \\? -no_cache deny QUERY -cache_dir diskd /var/spool/squid $squid_conf->{cache_size}[1] 16 256 -cache_store_log none -auth_param basic children 5 -auth_param basic realm Squid proxy-caching web server -auth_param basic credentialsttl 2 hours -refresh_pattern ^ftp: 1440 20% 10080 -refresh_pattern ^gopher: 1440 0% 1440 -refresh_pattern . 0 20% 4320 -half_closed_clients off -acl all src 0.0.0.0/0.0.0.0 -acl manager proto cache_object -acl localhost src 127.0.0.1/255.255.255.255 -acl to_localhost dst 127.0.0.0/8 -acl SSL_ports port 443 563 -acl Safe_ports port 80 # http -acl Safe_ports port 21 # ftp -acl Safe_ports port 443 563 # https, snews -acl Safe_ports port 70 # gopher -acl Safe_ports port 210 # wais -acl Safe_ports port 1025-65535 # unregistered ports -acl Safe_ports port 280 # http-mgmt -acl Safe_ports port 488 # gss-http -acl Safe_ports port 591 # filemaker -acl Safe_ports port 777 # multiling http -acl CONNECT method CONNECT -http_access allow manager localhost -http_access deny manager -http_access deny !Safe_ports -http_access deny CONNECT !SSL_ports -http_access deny to_localhost -acl mynetwork src $intf->{NETWORK}/$intf->{NETMASK} -http_access allow mynetwork -http_access allow localhost -http_reply_access allow all -icp_access allow all -visible_hostname $squid_conf->{visible_hostname}[0] -httpd_accel_host virtual -httpd_accel_with_proxy on -httpd_accel_uses_host_header on -append_domain .$internal_domain_name -err_html_text $squid_conf->{admin_mail}[0] -deny_info ERR_CUSTOM_ACCESS_DENIED all -memory_pools off -coredump_dir /var/spool/squid -ie_refresh on -)) if !$::testing; -} - -1; diff --git a/perl-install/network/test.pm b/perl-install/network/test.pm deleted file mode 100644 index ec680b7a3..000000000 --- a/perl-install/network/test.pm +++ /dev/null @@ -1,158 +0,0 @@ -package network::test; # $Id$ - -use strict; -use common; -use run_program; -use Socket; - -sub new { - my ($class, $o_hostname) = @_; - bless { - hostname => $o_hostname || "www.mandriva.com" - }, $class; -} - -#- launch synchronous test, will hang until the test finishes -sub test_synchronous { - my ($o) = @_; - ($o->{address}, $o->{ping}) = resolve_and_ping($o->{hostname}); - $o->{done} = 1; -} - -#- launch asynchronous test, will not hang -sub start { - my ($o) = @_; - $o->{done} = 0; - $o->{kid} = bg_command->new(sub { - my ($address, $ping) = resolve_and_ping($o->{hostname}); - print "$address|$ping\n"; - }); -} - -#- abort asynchronous test -sub abort { - my ($o) = @_; - if ($o->{kid}) { - kill -9, $o->{kid}{pid}; - undef $o->{kid}; - } -} - -#- returns a true value if the test is finished, usefull for asynchronous tests -sub is_done { - my ($o) = @_; - $o->update_status; - to_bool($o->{done}); -} - -#- return a true value if the connection works (hostname resolution and ping) -sub is_connected { - my ($o) = @_; - to_bool(defined($o->{hostname}) && defined($o->{ping})); -} - -#- get hostname used in test for resolution and ping -sub get_hostname { - my ($o) = @_; - $o->{hostname}; -} - -#- get resolved address (if any) of given hostname -sub get_address { - my ($o) = @_; - $o->{address}; -} - -#- get ping (if any) to given hostname -sub get_ping { - my ($o) = @_; - $o->{ping}; -} - -sub resolve_and_ping { - my ($hostname) = @_; - require Net::Ping; - require Time::HiRes; - my $p; - if ($>) { - $p = Net::Ping->new('tcp'); - # Try connecting to the www port instead of the echo port - $p->{port_num} = getservbyname('http', 'tcp'); - } else { - $p = Net::Ping->new('icmp'); - } - $p->hires; #- get ping as float - #- default timeout is 5 seconds - my ($ret, $ping, $address) = $p->ping($hostname, 5); - if ($ret) { - return $address, $ping; - } elsif (defined($ret)) { - return $address; - } -} - -sub update_status { - my ($o) = @_; - if ($o->{kid}) { - my $fd = $o->{kid}{fd}; - fcntl($fd, c::F_SETFL(), c::O_NONBLOCK()) or die "can not fcntl F_SETFL: $!"; - local $| = 1; - if (defined(my $output = <$fd>)) { - ($o->{address}, $o->{ping}) = $output =~ /^([\d\.]+)\|([\d\.,]+)*$/; - $o->{done} = 1; - undef $o->{kid}; - } - } -} - -1; - -=head1 network::test - -=head2 Test synchronously - -#- resolve and get ping to hostname from command line if given, else to www.mandriva.com -use lib qw(/usr/lib/libDrakX); -use network::test; - -my $net_test = network::test->new($ARGV[0]); -$net_test->test_synchronous; - -my $is_connected = $net_test->is_connected; -my $hostname = $net_test->get_hostname; -my $address = $net_test->get_address; -my $ping = $net_test->get_ping; - -print "connected: $is_connected -host: $hostname -resolved host: $address -ping to host: $ping -"; - -=head2 Test asynchronously - -#- resolve and get ping to hostname from command line if given, else to Mandriva -#- prints a "." every 10 miliseconds during connection test -use lib qw(/usr/lib/libDrakX); -use network::test; - -my $net_test = network::test->new($ARGV[0]); -$net_test->start; - -do { - print ".\n"; - select(undef, undef, undef, 0.01); -} while !$net_test->is_done; - -my $is_connected = $net_test->is_connected; -my $hostname = $net_test->get_hostname; -my $address = $net_test->get_address; -my $ping = $net_test->get_ping; - -print "connected: $is_connected -host: $hostname -resolved host: $address -ping to host: $ping -"; - -=cut diff --git a/perl-install/network/thirdparty.pm b/perl-install/network/thirdparty.pm deleted file mode 100644 index b7b8c1e03..000000000 --- a/perl-install/network/thirdparty.pm +++ /dev/null @@ -1,517 +0,0 @@ -package network::thirdparty; - -use strict; -use common; -use detect_devices; -use run_program; -use services; -use fs::get; -use fs; -use log; - -#- network_settings is an hash of categories (rtc, dsl, wireless, ...) -#- each category is an hash of device settings - -#- a device settings element must have the following fields: -#- o matching: -#- specify if this settings element matches a driver -#- can be a regexp, array ref or Perl code (parameters: driver) -#- o description: -#- full name of the device -#- o name: name used by the packages - -#- the following fields are optional: -#- o url: -#- url where the user can find tools/drivers/firmwares for this device -#- o device: -#- device in /dev to be configured -#- o post: -#- command to be run after all packages are installed -#- can be a shell command or Perl code -#- o restart_service: -#- if exists but not 1, name of the service to be restarted -#- if 1, specify that the service named by the name field should be restarted -#- o tools: -#- hash of the tools settings -#- test_file field required -#- if package field doesn't exist, 'name' is used -#- o kernel_module: -#- if exists but not 1, hash of the module settings -#- if 1, kernel modules are needed and use the name field -#- (name-kernel or dkms-name) -#- o firmware: -#- hash of the firmware settings -#- test_file field required -#- if package field doesn't exist, 'name-firmware' is used - -#- hash of package settings structure: -#- o package: -#- name of the package to be installed for these device -#- o test_file: -#- file used to test if the package is installed -#- o prefix: -#- path of the files that are tested -#- o links: -#- useful links for this device -#- can be a single link or array ref -#- o user_install: -#- function to call if the package installation fails -#- o explanations: -#- additionnal text to display if the installation fails -#- o no_club: -#- 1 if the package isn't available on Mandriva club - -my $firmware_directory = "/lib/firmware"; - -my %network_settings = ( - rtc => - [ - { - matching => qr/^Hcf:/, - description => 'HCF 56k Modem', - url => 'http://www.linuxant.com/drivers/hcf/', - name => 'hcfpcimodem', - kernel_module => { - test_file => 'hcfpciengine', - }, - tools => - { - test_file => '/usr/sbin/hcfpciconfig', - }, - device => '/dev/ttySHCF0', - post => '/usr/sbin/hcfpciconfig --auto', - restart_service => 'hcfpci', - }, - - { - matching => qr/^Hsf:/, - description => 'HSF 56k Modem', - url => 'http://www.linuxant.com/drivers/hsf/', - name => 'hsfmodem', - kernel_module => { - test_file => 'hsfengine', - }, - tools => - { - test_file => '/usr/sbin/hsfconfig', - }, - device => '/dev/ttySHSF0', - post => '/usr/sbin/hsfconfig --auto', - restart_service => 'hsf', - }, - - { - matching => qr/^LT:/, - description => 'LT WinModem', - url => 'http://www.heby.de/ltmodem/', - name => 'ltmodem', - kernel_module => 1, - tools => - { - test_file => '/etc/devfs/conf.d/ltmodem.conf', - }, - device => '/dev/ttyS14', - links => - [ - 'http://linmodems.technion.ac.il/Ltmodem.html', - 'http://linmodems.technion.ac.il/packages/ltmodem/', - ], - }, - - { - matching => [ list_modules::category2modules('network/slmodem') ], - description => 'Smartlink WinModem', - url => 'http://www.smlink.com/content.aspx?id=135/', - name => 'slmodem', - kernel_module => 1, - tools => - { - test_file => '/usr/sbin/slmodemd', - }, - device => '/dev/ttySL0', - post => sub { - my ($driver) = @_; - addVarsInSh("$::prefix/etc/sysconfig/slmodemd", { SLMODEMD_MODULE => $driver }); - }, - restart_service => "slmodemd", - }, - - { - matching => 'sm56', - description => 'Motorola SM56 WinModem', - url => 'http://www.motorola.com/softmodem/driver.htm#linux', - name => 'sm56', - kernel_module => - { - package => 'sm56', - }, - no_club => 1, - device => '/dev/sm56', - }, - ], - - wireless => - [ - { - matching => 'zd1201', - description => 'ZyDAS ZD1201', - url => 'http://linux-lc100020.sourceforge.net/', - firmware => - { - test_file => 'zd1201*.fw', - }, - }, - - (map { - { - matching => "ipw${_}", - description => "Intel(R) PRO/Wireless ${_}", - url => "http://ipw${_}.sourceforge.net/", - name => "ipw${_}", - firmware => - { - url => "http://ipw${_}.sourceforge.net/firmware.php", - test_file => ($_ == 2100 ? "ipw2100-*.fw" : "ipw-2.3-*.fw"), - }, - }; - } (2100, 2200)), - - { - matching => 'prism54', - description => 'Prism GT / Prism Duette / Prism Indigo Chipsets', - url => 'http://prism54.org/', - name => 'prism54', - firmware => - { - url => 'http://prism54.org/~mcgrof/firmware/', - test_file => "isl38*", - }, - }, - - { - matching => qr/^at76c50/, - description => 'Atmel at76c50x cards', - url => 'http://thekelleys.org.uk/atmel/', - name => 'atmel', - firmware => - { - test_file => 'atmel_at76c50*', - }, - links => 'http://at76c503a.berlios.de/', - }, - - { - matching => 'ath_pci', - description => 'Multiband Atheros Driver for WiFi', - url => 'http://madwifi.sourceforge.net/', - name => 'madwifi', - kernel_module => 1, - tools => { - optionnal => 1, - test_file => '/usr/bin/athstats', - }, - }, - ], - - dsl => - [ - { - matching => 'speedtouch', - description => N_("Alcatel speedtouch USB modem"), - url => "http://www.speedtouch.com/supuser.htm", - name => 'speedtouch', - tools => - { - test_file => '/usr/sbin/modem_run', - }, - firmware => - { - package => 'speedtouch_mgmt', - prefix => '/usr/share/speedtouch', - test_file => 'mgmt*.o', - explanations => N_("Copy the Alcatel microcode as mgmt.o in /usr/share/speedtouch/"), - user_install => \&install_speedtouch_microcode, - }, - links => 'http://linux-usb.sourceforge.net/SpeedTouch/mandrake/index.html', - }, - - { - matching => 'eciadsl', - name => 'eciadsl', - explanations => N_("The ECI Hi-Focus modem cannot be supported due to binary driver distribution problem. - -You can find a driver on http://eciadsl.flashtux.org/"), - no_club => 1, - tools => { - test_file => '/usr/sbin/pppoeci', - }, - }, - - { - matching => 'sagem', - description => 'Eagle chipset (from Analog Devices), e.g. Sagem F@st 800/840/908', - url => 'http://www.eagle-usb.org/', - name => 'eagle-usb', - tools => - { - test_file => '/sbin/eaglectrl', - }, - }, - - { - matching => 'bewan', - description => 'Bewan Adsl (Unicorn)', - url => 'http://www.bewan.com/bewan/users/downloads/', - name => 'unicorn', - kernel_module => { - test_file => 'unicorn_.*_atm', - }, - tools => { - optionnal => 1, - test_file => '/usr/bin/bewan_adsl_status', - }, - }, - ], -); - -sub device_get_package { - my ($settings, $option, $o_default) = @_; - $settings->{$option} or return; - my $package; - if (ref $settings->{$option} eq 'HASH') { - $package = $settings->{$option}{package} || 1; - } else { - $package = $settings->{$option}; - } - $package == 1 ? $o_default || $settings->{name} : $package; -} - -sub device_get_option { - my ($settings, $option) = @_; - $settings->{$option} or return; - my $value = $settings->{$option}; - $value == 1 ? $settings->{name} : $value; -} - -sub find_settings { - my ($category, $driver) = @_; - find { - my $type = ref $_->{matching}; - $type eq 'Regexp' && $driver =~ $_->{matching} || - $type eq 'CODE' && $_->{matching}->($driver) || - $type eq 'ARRAY' && member($driver, @{$_->{matching}}) || - $driver eq $_->{matching}; - } @{$network_settings{$category}}; -} - -sub device_run_command { - my ($settings, $driver, $option) = @_; - my $command = $settings->{$option} or return; - - if (ref $command eq 'CODE') { - $command->($driver); - } else { - log::explanations("Running $option command $command"); - run_program::rooted($::prefix, $command); - } -} - -sub warn_not_installed { - my ($in, @packages) = @_; - $in->ask_warn(N("Error"), N("Could not install the packages (%s)!", @packages)); -} - -sub warn_not_found { - my ($in, $settings, $option, @packages) = @_; - my %opt; - $opt{$_} = $settings->{$option}{$_} || $settings->{$_} foreach qw(url explanations no_club); - $in->ask_warn(N("Error"), - N("Some packages (%s) are required but aren't available.", @packages) . - (!$opt{no_club} && "\n" . N("These packages can be found in Mandriva Club or in Mandriva commercial releases.")) . - ($option eq 'firmware' && "\n\n" . N("Info: ") . "\n" . N("due to missing %s", get_firmware_path($settings))) . - ($opt{url} && "\n\n" . N("The required files can also be installed from this URL: -%s", $opt{url})) . - ($opt{explanations} && "\n\n" . translate($opt{explanations}))); -} - -sub is_file_installed { - my ($settings, $option) = @_; - my $file = exists $settings->{$option} && $settings->{$option}{test_file}; - $file && -e "$::prefix$file"; -} - -sub is_module_installed { - my ($settings, $driver) = @_; - my $module = ref $settings->{kernel_module} eq 'HASH' && $settings->{kernel_module}{test_file} || $driver; - find { m!/$module\.k?o! } cat_("$::prefix/lib/modules/" . c::kernel_version() . '/modules.dep'); -} - -sub get_firmware_path { - my ($settings) = @_; - my $wildcard = exists $settings->{firmware} && $settings->{firmware}{test_file} or return; - my $path = $settings->{firmware}{prefix} || $firmware_directory; - "$::prefix$path/$wildcard"; -} - -sub is_firmware_installed { - my ($settings) = @_; - my $pattern = get_firmware_path($settings) or return; - scalar glob_($pattern); -} - -sub find_file_on_windows_system { - my ($in, $file) = @_; - my $source; - require fsedit; - my $all_hds = fsedit::get_hds(); - fs::get_info_from_fstab($all_hds); - if (my $part = find { $_->{device_windobe} eq 'C' } fs::get::fstab($all_hds)) { - foreach (qw(windows/system winnt/system windows/system32/drivers winnt/system32/drivers)) { - -d $_ and $source = first(glob_("$part->{mntpoint}/$_/$file")) and last; - } - $source or $in->ask_warn(N("Error"), N("Unable to find \"%s\" on your Windows system!", $file)); - } else { - $in->ask_warn(N("Error"), N("No Windows system has been detected!")); - } - { file => $source }; -} - -sub find_file_on_floppy { - my ($in, $file) = @_; - my $floppy = detect_devices::floppy(); - my $mountpoint = '/mnt/floppy'; - my $h; - $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; - if (eval { fs::mount::mount(devices::make($floppy), $mountpoint, 'vfat', 'readonly'); 1 }) { - log::explanations("Mounting floppy device $floppy in $mountpoint"); - $h = before_leaving { fs::mount::umount($mountpoint) }; - if ($h->{file} = first(glob("$mountpoint/$file"))) { - log::explanations("Found $h->{file} on floppy device"); - } else { - log::explanations("Unabled to find $file on floppy device"); - } - } else { - $in->ask_warn(N("Error"), N("Floppy access error, unable to mount device %s", $floppy)); - log::explanations("Unable to mount floppy device $floppy"); - } - $h; -} - -sub install_speedtouch_microcode { - my ($in) = @_; - my $choice; - $in->ask_from('', - N("You need the Alcatel microcode. -You can provide it now via a floppy or your windows partition, -or skip and do it later."), - [ { type => "list", val => \$choice, format => \&translate, - list => [ N_("Use a floppy"), N_("Use my Windows partition") ] } ]) or return; - my ($h, $source); - if ($choice eq N_("Use a floppy")) { - $source = 'mgmt*.o'; - $h = find_file_on_floppy($in, $source); - } else { - $source = 'alcaudsl.sys'; - $h = find_file_on_windows_system($in, $source); - } - unless (-e $h->{file} && cp_f($h->{file}, "$::prefix/usr/share/speedtouch/mgmt.o")) { - $in->ask_warn(N("Error"), N("Firmware copy failed, file %s not found", $source)); - log::explanations("Firmware copy of $source ($h->{file}) failed"); - return; - } - log::explanations("Firmware copy of $h->{file} succeeded"); - $in->ask_warn(N("Congratulations!"), N("Firmware copy succeeded")); - 1; -} - -sub install_packages { - my ($in, $settings, $driver, @options) = @_; - - foreach my $option (@options) { - my %methods = - ( - default => - { - find_package_name => sub { device_get_package($settings, $option) }, - check_installed => sub { is_file_installed($settings, $option) }, - get_packages => sub { my ($name) = @_; $in->do_pkgs->is_available($name) }, - user_install => sub { my $f = $settings->{$option}{user_install}; $f && $f->($in) }, - }, - kernel_module => - { - find_package_name => sub { device_get_package($settings, $option, "$settings->{name}-kernel") }, - check_installed => sub { is_module_installed($settings, $driver) }, - get_packages => sub { my ($name) = @_; my $l = $in->do_pkgs->check_kernel_module_packages($name); $l ? @$l : () } - }, - firmware => - { - find_package_name => sub { device_get_package($settings, $option, "$settings->{name}-firmware") }, - check_installed => sub { is_firmware_installed($settings) }, - }, - ); - my $get_method = sub { my ($method) = @_; exists $methods{$option} && $methods{$option}{$method} || $methods{default}{$method} }; - - my $name = $get_method->('find_package_name')->(); - unless ($name) { - log::explanations(qq(No $option package for module "$driver" is required, skipping)); - next; - } - - if ($get_method->('check_installed')->()) { - log::explanations(qq(Required $option package for module "$driver" is already installed, skipping)); - next; - } - - if (my @packages = $get_method->('get_packages')->($name)) { - log::explanations("Installing thirdparty packages ($option) " . join(', ', @packages)); - if (!$in->do_pkgs->install(@packages)) { - next if ref $settings->{$option} eq 'HASH' && $settings->{$option}{optionnal}; - warn_not_installed($in, @packages); - } elsif ($get_method->('check_installed')->()) { - next; - } - } - log::explanations("Thirdparty package $name ($option) is required but not available"); - - unless ($get_method->('user_install')->($in)) { - warn_not_found($in, $settings, $option, $name); - return; - } - } - - 1; -} - -sub setup_device { - my ($in, $category, $driver, $o_config, @o_fields) = @_; - - my $settings = find_settings($category, $driver); - if ($settings) { - log::explanations(qq(Found settings for driver "$driver" in category "$category")); - - my $wait = $in->wait_message('', N("Looking for required software and drivers...")); - - install_packages($in, $settings, $driver, qw(kernel_module firmware tools)) or return; - - undef $wait; - $wait = $in->wait_message('', N("Please wait, running device configuration commands...")); - device_run_command($settings, $driver, 'post'); - - if (my $service = device_get_option($settings, 'restart_service')) { - log::explanations("Restarting service $service"); - services::restart_or_start($service); - } - - log::explanations(qq(Settings for driver "$driver" applied)); - } else { - log::explanations(qq(No settings found for driver "$driver" in category "$category")); - } - - #- assign requested settings, erase with undef if no settings have been found - $o_config->{$_} = $settings->{$_} foreach @o_fields; - - 1; -} - -1; diff --git a/perl-install/network/tools.pm b/perl-install/network/tools.pm deleted file mode 100644 index 460797959..000000000 --- a/perl-install/network/tools.pm +++ /dev/null @@ -1,255 +0,0 @@ -package network::tools; # $Id$ - -use strict; -use common; -use run_program; -use c; -use Socket; - -sub write_secret_backend { - my ($a, $b) = @_; - foreach my $i ("$::prefix/etc/ppp/pap-secrets", "$::prefix/etc/ppp/chap-secrets") { - substInFile { s/^'$a'.*\n//; $_ .= "\n'$a' * '$b' * \n" if eof } $i; - #- restore access right to secrets file, just in case. - chmod 0600, $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 wrap_command_for_root { - my ($name, @args) = @_; - #- FIXME: duplicate code from common::require_root_capability - check_for_xserver() && fuzzy_pidofs(qr/\bkwin\b/) > 0 ? - ("kdesu", "--ignorebutton", "-c", "$name @args") : - ([ 'consolehelper', $name ], @args); -} - -sub run_interface_command { - my ($command, $intf, $detach) = @_; - my @command = - !$> || system("/usr/sbin/usernetctl $intf report") == 0 ? - ($command, $intf, if_(!$::isInstall, "daemon")) : - wrap_command_for_root($command, $intf); - run_program::raw({ detach => $detach, root => $::prefix }, @command); -} - -sub start_interface { - my ($intf, $detach) = @_; - run_interface_command('/sbin/ifup', $intf, $detach); -} - -sub stop_interface { - my ($intf, $detach) = @_; - run_interface_command('/sbin/ifdown', $intf, $detach); -} - -sub start_net_interface { - my ($net, $detach) = @_; - start_interface($net->{net_interface}, $detach); -} - -sub stop_net_interface { - my ($net, $detach) = @_; - stop_interface($net->{net_interface}, $detach); -} - -sub connected() { gethostbyname("www.mandriva.com") ? 1 : 0 } - -# request a ref on a bg_connect and a ref on a scalar -sub connected_bg__raw { - my ($kid_pipe, $status) = @_; - local $| = 1; - if (ref($kid_pipe) && ref($$kid_pipe)) { - my $fd = $$kid_pipe->{fd}; - fcntl($fd, c::F_SETFL(), c::O_NONBLOCK()) or die "can not fcntl F_SETFL: $!"; - my $a = <$fd>; - $$status = $a if defined $a; - } else { $$kid_pipe = check_link_beat() } -} - -my $kid_pipe; -sub connected_bg { - my ($status) = @_; - connected_bg__raw(\$kid_pipe, $status); -} - -# 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 $current_connection_status; - -sub test_connected { - local $| = 1; - my ($cmd) = @_; - - $current_connection_status = -1 if !defined $current_connection_status; - - if ($cmd == 0) { - connected_bg__raw(\$kid_pipe_connect, \$current_connection_status); - } elsif ($cmd == 1) { - if ($current_connection_status != -2) { - $current_connection_status = -2; - $kid_pipe_connect = check_link_beat(); - } - } elsif ($cmd == 2) { - if (defined($kid_pipe_connect)) { - kill -9, $kid_pipe_connect->{pid}; - undef $kid_pipe_connect; - } - } - return $current_connection_status; -} - -sub check_link_beat() { - bg_command->new(sub { - require Net::Ping; - my $p; - if ($>) { - $p = Net::Ping->new("tcp"); - # Try connecting to the www port instead of the echo port - $p->{port_num} = getservbyname("http", "tcp"); - } else { - $p = Net::Ping->new("icmp"); - } - print $p->ping("www.mandriva.com") ? 1 : 0; - }); -} - -sub is_dynamic_ip { - my ($net) = @_; - any { $_->{BOOTPROTO} !~ /^(none|static|)$/ } values %{$net->{ifcfg}}; -} - -sub is_dynamic_host { - my ($net) = @_; - any { defined $_->{DHCP_HOSTNAME} } values %{$net->{ifcfg}}; -} - -#- returns interface whose IP address matchs given IP address, according to its network mask -sub find_matching_interface { - my ($net, $address) = @_; - my @ip = split '\.', $address; - find { - my @intf_ip = split '\.', $net->{ifcfg}{$_}{IPADDR} or return; - my @mask = split '\.', $net->{ifcfg}{$_}{NETMASK} or return; - every { $_ } mapn { ($_[0] & $_[2]) == ($_[1] & $_[2]) } \@intf_ip, \@ip, \@mask; - } sort keys %{$net->{ifcfg}}; -} - -#- returns the current gateway, with lowest metric -sub get_current_gateway_interface() { - my $routes = get_routes(); - first(sort { $routes->{$a}{metric} <=> $routes->{$b}{metric} } grep { exists $routes->{$_}{gateway} } keys %$routes); -} - -#- returns gateway interface if found -sub get_default_gateway_interface { - my ($net) = @_; - my @intfs = sort keys %{$net->{ifcfg}}; - get_current_gateway_interface() || - $net->{network}{GATEWAYDEV} || - $net->{network}{GATEWAY} && find_matching_interface($net, $net->{network}{GATEWAY}) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'adsl' } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'isdn' && text2bool($net->{ifcfg}{$_}{DIAL_ON_IFUP}) } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'modem' } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'wifi' && $net->{ifcfg}{$_}{BOOTPROTO} eq 'dhcp' } @intfs) || - (find { get_interface_type($net->{ifcfg}{$_}) eq 'ethernet' && $net->{ifcfg}{$_}{BOOTPROTO} eq 'dhcp' } @intfs); -} - -sub get_interface_status { - my ($intf) = @_; - my $routes = get_routes(); - return $routes->{$intf}{network}, $routes->{$intf}{gateway}; -} - -#- returns (gateway_interface, interface is up, gateway address, dns server address) -sub get_internet_connection { - my ($net, $o_gw_intf) = @_; - my $gw_intf = $o_gw_intf || get_default_gateway_interface($net) or return; - return $gw_intf, get_interface_status($gw_intf), $net->{resolv}{dnsServer}; -} - -sub get_interface_type { - my ($interface, $o_module) = @_; - require detect_devices; - member($interface->{TYPE}, "xDSL", "ADSL") && "adsl" || - $interface->{DEVICE} =~ /^ippp/ && "isdn" || - $interface->{DEVICE} =~ /^ppp/ && "modem" || - (detect_devices::is_wireless_interface($interface->{DEVICE}) || exists $interface->{WIRELESS_MODE}) && "wifi" || - detect_devices::is_lan_interface($interface->{DEVICE}) && - ($o_module && member($o_module, list_modules::category2modules('network/gigabit')) ? "ethernet_gigabit" : "ethernet") || - "unknown"; -} - -sub get_default_metric { - my ($type) = @_; - my @known_types = ("ethernet_gigabit", "ethernet", "adsl", "wifi", "isdn", "modem", "unknown"); - my $idx; - eval { $idx = find_index { $type eq $_ } @known_types }; - $idx = @known_types if $@; - $idx * 10; -} - -sub get_interface_ip_address { - my ($net, $interface) = @_; - `/sbin/ip addr show dev $interface` =~ /^\s*inet\s+([\d.]+)/m && $1 || - $net->{ifcfg}{$interface}{IPADDR}; -} - -sub host_hex_to_dotted { - my ($address) = @_; - inet_ntoa(pack('N', unpack('L', pack('H8', $address)))); -} - -sub get_routes() { - my %routes; - foreach (cat_("/proc/net/route")) { - if (/^(\S+)\s+([0-9A-F]+)\s+([0-9A-F]+)\s+[0-9A-F]+\s+\d+\s+\d+\s+(\d+)\s+([0-9A-F]+)/) { - if (hex($2)) { $routes{$1}{network} = host_hex_to_dotted($2) } - elsif (hex($3)) { $routes{$1}{gateway} = host_hex_to_dotted($3) } - if ($4) { $routes{$1}{metric} = $4 } - } - } - #- TODO: handle IPv6 with /proc/net/ipv6_route - \%routes; -} - -1; diff --git a/perl-install/network/wireless.pm b/perl-install/network/wireless.pm deleted file mode 100644 index 513c8a95e..000000000 --- a/perl-install/network/wireless.pm +++ /dev/null @@ -1,239 +0,0 @@ -package network::wireless; - -use strict; -use common; - -our %wireless_enc_modes = ( - none => N_("None"), - open => N_("Open WEP"), - restricted => N_("Restricted WEP"), - 'wpa-psk' => N_("WPA Pre-Shared Key"), -); - -my $wpa_supplicant_conf = "/etc/wpa_supplicant.conf"; - -sub is_old_rt2x00 { - my ($module) = @_; - member($module, qw(rt2400 rt2500)); -} - -sub is_wpa_supplicant_blacklisted { - my ($module) = @_; - is_old_rt2x00($module); -} - -sub get_hex_key { - my ($key) = @_; - if ($key =~ /^([[:xdigit:]]{4}[\:-]?)+[[:xdigit:]]{2,}$/) { - $key =~ s/[\:-]//g; - return lc($key); - } -} - -sub convert_wep_key_for_iwconfig { - #- 5 or 13 characters, consider the key as ASCII and prepend "s:" - #- else consider the key as hexadecimal, do not strip dashes - #- always quote the key as string - my ($real_key, $restricted) = @_; - my $key = get_hex_key($real_key) || "s:$real_key"; - $restricted ? "restricted $key" : "open $key"; -} - -sub get_wep_key_from_iwconfig { - #- strip "s:" if the key is 5 or 13 characters (ASCII) - #- else the key as hexadecimal, do not modify - my ($key) = @_; - my ($mode, $real_key) = $key =~ /^(?:(open|restricted)\s+)?(.*)$/; - $real_key =~ s/^s://; - ($real_key, $mode eq 'restricted'); -} - -sub convert_key_for_wpa_supplicant { - my ($key) = @_; - get_hex_key($key) || qq("$key"); -} - -sub wlan_ng_needed { - my ($module) = @_; - $module =~ /^prism2_/; -} - -#- FIXME: to be improved (quotes, comments) and moved in common files -sub wlan_ng_update_vars { - my ($file, $vars) = @_; - substInFile { - while (my ($key, $value) = each(%$vars)) { - s/^#?\Q$key\E=(?:"[^#]*"|[^#\s]*)(\s*#.*)?/$key=$value$1/ and delete $vars->{$key}; - } - $_ .= join('', map { "$_=$vars->{$_}\n" } keys %$vars) if eof; - } $file; -} - -sub wlan_ng_configure { - my ($essid, $key, $device, $module) = @_; - my $wlan_conf_file = "$::prefix/etc/wlan/wlan.conf"; - my @wlan_devices = split(/ /, (cat_($wlan_conf_file) =~ /^WLAN_DEVICES="(.*)"/m)[0]); - push @wlan_devices, $device unless member($device, @wlan_devices); - #- enable device and make it use the choosen ESSID - wlan_ng_update_vars($wlan_conf_file, - { - WLAN_DEVICES => qq("@wlan_devices"), - "SSID_$device" => qq("$essid"), - "ENABLE_$device" => "y" - }); - - my $wlan_ssid_file = "$::prefix/etc/wlan/wlancfg-$essid"; - #- copy default settings for this ESSID if config file does not exist - -f $wlan_ssid_file or cp_f("$::prefix/etc/wlan/wlancfg-DEFAULT", $wlan_ssid_file); - - #- enable/disable encryption - wlan_ng_update_vars($wlan_ssid_file, - { - (map { $_ => $key ? "true" : "false" } qw(lnxreq_hostWEPEncrypt lnxreq_hostWEPDecrypt dot11PrivacyInvoked dot11ExcludeUnencrypted)), - AuthType => $key ? qq("sharedkey") : qq("opensystem"), - if_($key, - dot11WEPDefaultKeyID => 0, - dot11WEPDefaultKey0 => qq("$key") - ) - }); - #- hide settings for non-root users - chmod 0600, $wlan_conf_file; - chmod 0600, $wlan_ssid_file; - - #- apply settings on wlan interface - require services; - services::restart($module eq 'prism2_cs' ? 'pcmcia' : 'wlan'); -} - -sub wpa_supplicant_get_driver { - my ($module) = @_; - $module =~ /^hostap_/ ? "hostap" : - $module eq "prism54" ? "prism54" : - $module =~ /^ath_/ ? "madwifi" : - $module =~ /^at76c50|atmel_/ ? "atmel" : - $module eq "ndiswrapper" ? "ndiswrapper" : - "wext"; -} - -sub wpa_supplicant_add_network { - my ($essid, $enc_mode, $key) = @_; - my $conf = wpa_supplicant_read_conf(); - my $network = { - ssid => qq("$essid"), - scan_ssid => 1, - }; - - if ($enc_mode eq 'wpa-psk') { - $network->{psk} = convert_key_for_wpa_supplicant($key); - } else { - $network->{key_mgmt} = 'NONE'; - if (member($enc_mode, qw(open restricted))) { - put_in_hash($network, { - wep_key0 => convert_key_for_wpa_supplicant($key), - wep_tx_keyidx => 0, - auth_alg => $enc_mode eq 'restricted' ? 'SHARED' : 'OPEN', - }); - } - } - - @$conf = difference2($conf, [ wpa_supplicant_find_similar($conf, $network) ]); - push @$conf, $network; - wpa_supplicant_write_conf($conf); -} - -sub wpa_supplicant_find_similar { - my ($conf, $network) = @_; - grep { - my $current = $_; - any { exists $network->{$_} && $network->{$_} eq $current->{$_} } qw(ssid bssid); - } @$conf; -} - -sub wpa_supplicant_read_conf() { - my @conf; - my $network; - foreach (cat_($::prefix . $wpa_supplicant_conf)) { - if ($network) { - #- in a "network = {}" block - if (/^\s*(\w+)=(.*?)(?:\s*#.*)?$/) { - $network->{$1} = $2; - } elsif (/^\}/) { - #- end of network block - push @conf, $network; - undef $network; - } - } elsif (/^\s*network={/) { - #- beginning of a new network block - $network = {}; - } - } - \@conf; -} - -sub wpa_supplicant_write_conf { - my ($conf) = @_; - my $buf; - my @conf = @$conf; - my $network; - foreach (cat_($::prefix . $wpa_supplicant_conf)) { - if ($network) { - #- in a "network = {}" block - if (/^\s*(\w+)=(.*)$/) { - push @{$network->{entries}}, { key => $1, value => $2 }; - member($1, qw(ssid bssid)) and $network->{$1} = $2; - } elsif (/^\}/) { - #- end of network block, write it - $buf .= "network={$network->{comment}\n"; - - my $new_network = first(wpa_supplicant_find_similar(\@conf, $network)); - foreach (@{$network->{entries}}) { - my $key = $_->{key}; - if ($new_network) { - #- do not write entry if not provided in the new network - exists $new_network->{$key} or next; - #- update value from the new network - $_->{value} = delete $new_network->{$key}; - } - $buf .= " "; - $buf .= "$key=$_->{value}" if $key; - $buf .= "$_->{comment}\n"; - } - if ($new_network) { - #- write new keys - while (my ($key, $value) = each(%$new_network)) { - $buf .= " $key=$value\n"; - } - } - $buf .= "}\n"; - $new_network and @conf = grep { $_ != $new_network } @conf; - undef $network; - } else { - #- unrecognized, keep it anyway - push @{$network->{entries}}, { comment => $_ }; - } - } else { - if (/^\s*network={/) { - #- beginning of a new network block - $network = {}; - } else { - #- keep other options, comments - $buf .= $_; - } - } - } - - #- write remaining networks - foreach (@conf) { - $buf .= "\nnetwork={\n"; - while (my ($key, $value) = each(%$_)) { - $buf .= " $key=$value\n"; - } - $buf .= "}\n"; - } - - output($::prefix . $wpa_supplicant_conf, $buf); - #- hide keys for non-root users - chmod 0600, $::prefix . $wpa_supplicant_conf; -} - -1; |