package keyboard; # $Id$
use diagnostics;
use strict;
#-######################################################################################
#- misc imports
#-######################################################################################
use common;
use detect_devices;
use run_program;
use log;
use c;
#-######################################################################################
#- Globals
#-######################################################################################
my $KMAP_MAGIC = 0x8B39C07F;
#- a best guess of the keyboard layout, based on the choosen locale
#- beware only the first 5 characters of the locale are used
my %lang2keyboard =
(
'af' => 'us_intl',
'ar' => 'ar:90',
'as' => 'ben:90 dev:20 us_intl:5',
'az' => 'az:90 tr_q:10 us_intl:5',
'be' => 'by:90 ru:50 ru_yawerty:40',
'bg' => 'bg_phonetic:60 bg:50',
'bn' => 'ben:90 dev:20 us_intl:5',
'br' => 'fr:90',
'bs' => 'bs:90',
'ca' => 'es:90 fr:15',
'cs' => 'cz_qwerty:70 cz:50',
'cy' => 'uk:90',
'da' => 'dk:90',
'de' => 'de_nodeadkeys:70 de:50 be:50 ch_de:50',
'el' => 'gr:90',
'en' => 'us:89 us_intl:50 qc:50 uk:50',
'en_US' => 'us:90 us_intl:50',
'en_GB' => 'uk:89 us:60 us_intl:50',
'eo' => 'us_intl:89 dvorak:20',
'es' => 'es:85 la:80 us_intl:50',
'et' => 'ee:90',
'eu' => 'es:90 fr:15',
'fa' => 'ir:90',
'fi' => 'fi:90',
'fr' => 'fr:89 qc:85 be:85 ch_fr:70',
'ga' => 'ie:80 uk:70',
'gd' => 'uk:80 ie:70',
'gl' => 'es:90',
'gu' => 'guj:90',
'gv' => 'uk:80 ie:70',
'he' => 'il:90 il_phonetic:10',
'hi' => 'dev:90',
'hr' => 'hr:90 si:50',
'hu' => 'hu:90',
'hy' => 'am:90 am_old:10 am_phonetic:5',
'id' => 'us:90 us_intl:20',
'is' => 'is:90',
'iu' => 'iu:90',
'it' => 'it:90 ch_fr:50 ch_de:50',
'ja' => 'jp:90 us:50 us_intl:20',
'ka' => 'ge_la:90 ge_ru:50',
'kl' => 'dk:80 us_intl:30',
'kn' => 'kan:90',
'ko' => 'kr:90 us:60',
'ku' => 'tr_q:90 tr_f:30',
'kw' => 'uk:80 ie:70',
'li' => 'us_intl:80 be:70 nl:10 us:5',
'lo' => 'lao:90',
'lt' => 'lt:80 lt_new:70 lt_b:60 lt_p:50',
'lv' => 'lv:90 lt:40 lt_new:30 lt_b:20 lt_p:10 ee:5',
'mi' => 'us_intl:90 uk:20 us:10',
'mk' => 'mk:90',
'ml' => 'mal:90',
'mn' => 'mng:90 ru:20 ru_yawerty:5',
'mr' => 'dev:90',
'ms' => 'us:90 us_intl:20',
'mt' => 'mt:90 mt_us:35 us_intl:10',
'my' => 'mm:90',
'nb' => 'no:90 dvorak_no:10',
'nl' => 'us_intl:80 be:70 nl:10 us:5',
'nn' => 'no:90 dvorak_no:10',
'no' => 'no:90 dvorak_no:10',
'oc' => 'fr:90',
'or' => 'ori:90',
'pa' => 'gur:90',
'ph' => 'us:90 us_intl:20',
'pl' => 'pl:90 pl2:60',
'pp' => 'br:80 la:20 pt:10 us_intl:30',
'pt_BR' => 'br:90 la:20 pt:10 us_intl:30',
'pt' => 'pt:90',
'ro' => 'ro2:80 ro:40 us_intl:10',
'ru' => 'ru:85 ru_yawerty:80 ua:50',
'se' => 'sapmi:70 sapmi_sefi:50',
'sh' => 'yu:80',
'sk' => 'sk_qwerty:80 sk:70',
'sl' => 'si:90 hr:50',
'sq' => 'al:90',
'sr' => 'sr:80',
'sv' => 'se:90 fi:30 dvorak_se:10',
'ta' => 'tscii:80 tml:20',
'te' => 'tel:90',
'tg' => 'tj:90 ru_yawerty:40',
'th' => 'th:90',
'tr' => 'tr_q:90 tr_f:30',
'tt' => 'ru:50 ru_yawerty:40',
'uk' => 'ua:90 ru:50 ru_yawerty:40',
'uz' => 'us:80 uz:80',
'uz\@Cyrl' => 'uz:80 ru_yawerty:40',
'vi' => 'vn:80 us:60 us_intl:50',
'wa' => 'be:90 fr:5',
'yi' => 'il_phonetic:90 il:10 us_intl:10',
'zh_CN' => 'us:60',
'zh_TW' => 'us:60',
);
# USB kbd table
# The numeric values are the bCountryCode field (5th byte) of HID descriptor
my @usb2keyboard =
(
qw(SKIP ar_SKIP be ca_SKIP qc cz dk fi fr de gr il hu us_intl it jp),
#- 0x10
qw(kr la nl no ir pl pt ru sk es se ch_de ch_de ch_de tw_SKIP tr_q),
#- 0x20
qw(uk us yu tr_f),
#- higher codes not attribued as of 2002-02
);
#- key = extension for Xmodmap file, [0] = description of the keyboard,
#- [1] = name for loadkeys, [2] = name for XKB, [3] = "1" if it is
#- a multigroup layout (eg: one with latin/non-latin letters)
my %keyboards = (
arch() =~ /^sparc/ ? (
"cz" => [ N_("Czech (QWERTZ)"), "sunt5-cz-us", "cz", 0 ],
"de" => [ N_("German"), "sunt5-de-latin1", "de", 0 ],
"dvorak" => [ N_("Dvorak"), "sundvorak", "dvorak",0 ],
"es" => [ N_("Spanish"), "sunt5-es", "es", 0 ],
"fi" => [ N_("Finnish"), "sunt5-fi-latin1", "fi", 0 ],
"fr" => [ N_("French"), "sunt5-fr-latin1", "fr", 0 ],
"no" => [ N_("Norwegian"), "sunt4-no-latin1", "no", 0 ],
"pl" => [ N_("Polish"), "sun-pl-altgraph", "pl", 0 ],
"ru" => [ N_("Russian"), "sunt5-ru", "ru", 1 ],
# TODO: check the console map
"se" => [ N_("Swedish"), "sunt5-fi-latin1", "se", 0 ],
"uk" => [ N_("UK keyboard"), "sunt5-uk", "gb", 0 ],
"us" => [ N_("US keyboard"), "sunkeymap", "us", 0 ],
) : (
"al" => [ N_("Albanian"), "al", "al", 0 ],
"am_old" => [ N_("Armenian (old)"), "am_old", "am(old)", 1 ],
"am" => [ N_("Armenian (typewriter)"), "am-armscii8", "am", 1 ],
"am_phonetic" => [ N_("Armenian (phonetic)"), "am_phonetic", "am(phonetic)",1 ],
"ar" => [ N_("Arabic"), "us", "ar(digits)", 1 ],
"az" => [ N_("Azerbaidjani (latin)"), "az", "az", 0 ],
#"a3" => [ N_("Azerbaidjani (cyrillic)"), "az-koi8k","az(cyrillic)",1 ],
"be" => [ N_("Belgian"), "be2-latin1", "be", 0 ],
"ben" => [ N_("Bengali"), "us", "ben", 1 ],
"bg_phonetic" => [ N_("Bulgarian (phonetic)"), "bg", "bg(phonetic)", 1 ],
"bg" => [ N_("Bulgarian (BDS)"), "bg", "bg", 1 ],
"br" => [ N_("Brazilian (ABNT-2)"), "br-abnt2", "br", 0 ],
#- Bosnia and Croatia use the same layout, but people are confused if there
#- isn't an antry for their country
"bs" => [ N_("Bosnian"), "croat", "hr", 0 ],
"by" => [ N_("Belarusian"), "by-cp1251", "by", 1 ],
"ch_de" => [ N_("Swiss (German layout)"), "sg-latin1", "de_CH", 0 ],
"ch_fr" => [ N_("Swiss (French layout)"), "fr_CH-latin1", "fr_CH", 0 ],
"cz" => [ N_("Czech (QWERTZ)"), "cz", "cz", 0 ],
"cz_qwerty" => [ N_("Czech (QWERTY)"), "cz-lat2", "cz_qwerty", 0 ],
"de" => [ N_("German"), "de-latin1", "de", 0 ],
"de_nodeadkeys" => [ N_("German (no dead keys)"), "de-latin1-nodeadkeys", "de(nodeadkeys)", 0 ],
"dev" => [ N_("Devanagari"), "us", "dev", 0 ],
"dk" => [ N_("Danish"), "dk-latin1", "dk", 0 ],
"dvorak" => [ N_("Dvorak (US)"), "pc-dvorak-latin1", "dvorak", 0 ],
"dvorak_no" => [ N_("Dvorak (Norwegian)"), "no-dvorak", "dvorak(no)", 0 ],
"dvorak_se" => [ N_("Dvorak (Swedish)"), "se-dvorak", "dvorak(se)", 0 ],
"ee" => [ N_("Estonian"), "ee-latin9", "ee", 0 ],
"es" => [ N_("Spanish"), "es-latin1", "es", 0 ],
"fi" => [ N_("Finnish"), "fi-latin1", "fi", 0 ],
"fr" => [ N_("French"), "fr-latin1", "fr", 0 ],
"ge_ru" => [N_("Georgian (\"Russian\" layout)"), "ge_ru-georgian_academy", "ge_ru",1],
"ge_la" => [N_("Georgian (\"Latin\" layout)"), "ge_la-georgian_academy", "ge_la",1],
"gr" => [ N_("Greek"), "gr-8859_7", "el(extended)", 1 ],
"gr_pl" => [ N_("Greek (polytonic)"), "gr-8859_7", "el(polytonic)", 1 ],
"guj" => [ N_("Gujarati"), "us", "guj", 1 ],
"gur" => [ N_("Gurmukhi"), "us", "gur", 1 ],
"hu" => [ N_("Hungarian"), "hu-latin2", "hu", 0 ],
"hr" => [ N_("Croatian"), "croat", "hr", 0 ],
"ie" => [ N_("Irish"), "uk", "ie", 0 ],
"il" => [ N_("Israeli"), "il-8859_8", "il", 1 ],
"il_phonetic" => [ N_("Israeli (Phonetic)"), "hebrew", "il_phonetic", 1 ],
"ir" => [ N_("Iranian"), "ir-isiri_3342", "ir", 1 ],
"is" => [ N_("Icelandic"), "is-latin1", "is", 0 ],
"it" => [ N_("Italian"), "it-latin1", "it", 0 ],
"iu" => [ N_("Inuktitut"), "us", "iu", 1 ],
# Japanese keyboard is dual latin/kana; but telling it here shows a
# message to choose the switching key that is misleading, as input methods
# aren't automatically enabled when typing in kana
"jp" => [ N_("Japanese 106 keys"), "jp106", "jp", 0 ],
"kan" => [ N_("Kannada"), "us", "kan", 1 ],
#There is no XKB korean file yet; but using xmodmap one disables
# some functioanlity; "us" used for XKB until this is fixed
"kr" => [ N_("Korean keyboard"), "us", "us", 1 ],
"la" => [ N_("Latin American"), "la-latin1", "la", 0 ],
"lao" => [ N_("Laotian"), "us", "lo", 1 ],
"lt" => [ N_("Lithuanian AZERTY (old)"), "lt-latin7", "lt_a", 0 ],
#- TODO: write a console kbd map for lt_new
"lt_new" => [ N_("Lithuanian AZERTY (new)"), "lt-latin7", "lt_std", 0 ],
"lt_b" => [ N_("Lithuanian \"number row\" QWERTY"), "ltb-latin7", "lt", 1 ],
"lt_p" => [ N_("Lithuanian \"phonetic\" QWERTY"), "ltp-latin7", "lt_p", 0 ],
"lv" => [ N_("Latvian"), "lv-latin7", "lv", 0 ],
"mal" => [ N_("Malayalam"), "us", "ml(mlplusnum)", 1 ],
"mk" => [ N_("Macedonian"), "mk", "mk", 1 ],
"mm" => [ N_("Myanmar (Burmese)"), "us", "mm", 1 ],
"mng" => [ N_("Mongolian (cyrillic)"), "us", "mng", 1 ],
"mt" => [ N_("Maltese (UK)"), "uk", "mt", 0 ],
"mt_us" => [ N_("Maltese (US)"), "us", "mt_us", 0 ],
"nl" => [ N_("Dutch"), "nl-latin1", "nl", 0 ],
"no" => [ N_("Norwegian"), "no-latin1", "no", 0 ],
"ori" => [ N_("Oriya"), "us", "ori", 1 ],
"pl" => [ N_("Polish (qwerty layout)"), "pl", "pl", 0 ],
"pl2" => [ N_("Polish (qwertz layout)"), "pl-latin2", "pl2", 0 ],
"pt" => [ N_("Portuguese"), "pt-latin1", "pt", 0 ],
"qc" => [ N_("Canadian (Quebec)"), "qc-latin1", "ca_enhanced", 0 ],
#- TODO: write a console kbd map for ro2
"ro2" => [ N_("Romanian (qwertz)"), "ro2", "ro2", 0 ],
"ro" => [ N_("Romanian (qwerty)"), "ro", "ro", 0 ],
"ru" => [ N_("Russian"), "ru4", "ru(winkeys)", 1 ],
"ru_yawerty" => [ N_("Russian (Phonetic)"), "ru-yawerty", "ru_yawerty", 1 ],
"sapmi" => [ N_("Saami (norwegian)"), "no-latin1", "sapmi", 0 ],
"sapmi_sefi" => [ N_("Saami (swedish/finnish)"), "se-latin1", "sapmi(sefi)", 0 ],
"se" => [ N_("Swedish"), "se-latin1", "se", 0 ],
"si" => [ N_("Slovenian"), "slovene", "si", 0 ],
"sk" => [ N_("Slovakian (QWERTZ)"), "sk-qwertz", "sk", 0 ],
"sk_qwerty" => [ N_("Slovakian (QWERTY)"), "sk-qwerty", "sk_qwerty", 0 ],
# TODO: console map
"sr" => [ N_("Serbian (cyrillic)"), "sr", "sr", 1 ],
"syr" => [ N_("Syriac"), "us", "syr", 1 ],
"syr_p" => [ N_("Syriac (phonetic)"), "us", "syr_phonetic", 1 ],
"tel" => [ N_("Telugu"), "us", "tel", 1 ],
# no console kbd that I'm aware of
"tml" => [ N_("Tamil (ISCII-layout)"), "us", "tml", 1 ],
"tscii" => [ N_("Tamil (Typewriter-layout)"), "us", "ta(UNI)", 1 ],
"th" => [ N_("Thai keyboard"), "th", "th", 1 ],
# TODO: console map
"tj" => [ N_("Tajik keyboard"), "ru4", "tj", 1 ],
"tr_f" => [ N_("Turkish (traditional \"F\" model)"), "trf", "tr_f", 0 ],
"tr_q" => [ N_("Turkish (modern \"Q\" model)"), "tr_q-latin5", "tr", 0 ],
#-"tw => [ N_("Chineses bopomofo"), "tw", "tw", 1 ],
"ua" => [ N_("Ukrainian"), "ua", "ua", 1 ],
"uk" => [ N_("UK keyboard"), "uk", "gb", 0 ],
"us" => [ N_("US keyboard"), "us", "en_US", 0 ],
"us_intl" => [ N_("US keyboard (international)"), "us-latin1", "us_intl", 0 ],
"uz" => [ N_("Uzbek (cyrillic)"), "uz.uni", "uz", 1 ],
"vn" => [ N_("Vietnamese \"numeric row\" QWERTY"), "vn-tcvn", "vn(toggle)", 0 ],
"yu" => [ N_("Yugoslavian (latin)"), "sr", "yu", 0 ],
),
);
#- list of possible choices for the key combinations to toggle XKB groups
#- (eg in X86Config file: XkbOptions "grp:toggle")
my %grp_toggles = (
toggle => N_("Right Alt key"),
shift_toggle => N_("Both Shift keys simultaneously"),
ctrl_shift_toggle => N_("Control and Shift keys simultaneously"),
caps_toggle => N_("CapsLock key"),
ctrl_alt_toggle => N_("Ctrl and Alt keys simultaneously"),
alt_shift_toggle => N_("Alt and Shift keys simultaneously"),
menu_toggle => N_("\"Menu\" key"),
lwin_toggle => N_("Left \"Windows\" key"),
rwin_toggle => N_("Right \"Windows\" key"),
ctrls_toggle => N_("Both Control keys simultaneously"),
alts_toggle => N_("Both Alt keys simultaneously"),
lshift_toggle => N_("Left Shift key"),
rshift_toggle => N_("Right Shift key"),
lalt_toggle => N_("Left Alt key"),
lctrl_toggle => N_("Left Control key"),
rctrl_toggle => N_("Right Control key"),
);
#-######################################################################################
#- Functions
#-######################################################################################
sub KEYBOARDs() { keys %keyboards }
sub KEYBOARD2text { $keyboards{$_[0]} && $keyboards{$_[0]}[0] }
sub keyboards() { map { { KEYBOARD => $_ } } keys %keyboards }
sub keyboard2one {
my ($keyboard, $nb) = @_;
ref $keyboard or internal_error();
my $l = $keyboards{$keyboard->{KEYBOARD}} or return;
$l->[$nb];
}
sub keyboard2text { keyboard2one($_[0], 0) }
sub keyboard2kmap { keyboard2one($_[0], 1) }
sub keyboard2xkb { keyboard2one($_[0], 2) }
sub grp_toggles {
my ($keyboard) = @_;
keyboard2one($keyboard, 3) or return;
\%grp_toggles;
}
sub group_toggle_choose {
my ($in, $keyboard) = @_;
if (my $grp_toggles = keyboard::grp_toggles($keyboard)) {
my $GRP_TOGGLE = $keyboard->{GRP_TOGGLE} || 'caps_toggle';
$GRP_TOGGLE = $in->ask_from_listf('', N("Here you can choose the key or key combination that will
allow switching between the different keyboard layouts
(eg: latin and non latin)"), sub { translate($grp_toggles->{$_[0]}) }, [ sort keys %$grp_toggles ], $GRP_TOGGLE) or return;
$GRP_TOGGLE ne 'rctrl_toggle' and $in->ask_warn(N("Warning"), formatAlaTeX(
N("This setting will be activated after the installation.
During installation, you will need to use the Right Control
key to switch between the different keyboard layouts.")));
log::l("GRP_TOGGLE: $GRP_TOGGLE");
$keyboard->{GRP_TOGGLE} = $GRP_TOGGLE;
} else {
$keyboard->{GRP_TOGGLE} = '';
}
1;
}
sub loadkeys_files {
my ($err) = @_;
my $archkbd = arch() =~ /^sparc/ ? "sun" : arch() =~ /i.86/ ? "i386" : arch() =~ /ppc/ ? "mac" : arch();
my $p = "/usr/lib/kbd/keymaps/$archkbd";
my $post = ".kmap.gz";
my %trans = ("cz-latin2" => "cz-lat2");
my %find_file;
foreach my $dir (all($p)) {
$find_file{$dir} = '';
foreach (all("$p/$dir")) {
$find_file{$_} and $err->("file $_ is both in $find_file{$_} and $dir") if $err;
$find_file{$_} = "$p/$dir/$_";
}
}
my (@l, %l);
foreach (values %keyboards) {
local $_ = $trans{$_->[1]} || $_->[1];
my $l = $find_file{"$_$post"} || $find_file{first(/(..)/) . $post};
if ($l) {
push @l, $l;
foreach (`zgrep include $l | grep "^include"`) {
/include\s+"(.*)"/ or die "bad line $_";
@l{grep { -e $_ } ("$p/$1.inc.gz")} = ();
}
} else {
$err->("invalid loadkeys keytable $_") if $err;
}
}
uniq(@l, keys %l, grep { -e $_ } map { "$p/$_.inc.gz" } qw(compose euro windowkeys linux-keys-bare));
}
sub unpack_keyboards {
my ($k) = @_; $k or return;
[ grep {
my $b = $keyboards{$_->[0]};
$b or log::l("bad keyboard $_->[0] in %keyboard::lang2keyboard");
$b;
} map { [ split ':' ] } split ' ', $k ];
}
sub lang2keyboards {
my @li = sort { $b->[1] <=> $a->[1] } map { @$_ } map {
#- first try with the 5 first chars of LANG; if it fails then try with
#- with the 2 first chars of LANG before resorting to default.
unpack_keyboards($lang2keyboard{substr($_, 0, 5)}) || unpack_keyboards($lang2keyboard{substr($_, 0, 2)}) || [ [ ($keyboards{$_} ? $_ : "us") => 100 ] ];
} @_;
\@li;
}
sub lang2keyboard {
my ($l) = @_;
my $kb = lang2keyboards($l)->[0][0];
{ KEYBOARD => $keyboards{$kb} ? $kb : 'us' }; #- handle incorrect keyboard mapping to us.
}
sub from_usb() {
return if $::noauto;
my ($usb_kbd) = detect_devices::usbKeyboards() or return;
my $country_code = detect_devices::usbKeyboard2country_code($usb_kbd) or return;
my $keyboard = $usb2keyboard[$country_code];
$keyboard !~ /SKIP/ && { KEYBOARD => $keyboard };
}
sub load {
my ($keymap) = @_;
return if $::testing;
my ($magic, $tables_given, @tables) = common::unpack_with_refs('I' .
'i' . c::MAX_NR_KEYMAPS() .
's' . c::NR_KEYS() . '*',
$keymap);
$magic != $KMAP_MAGIC and die "failed to read kmap magic";
sysopen(my $F, "/dev/console", 2) or die "failed to open /dev/console: $!";
my $i_tables = 0;
each_index {
my $table_index = $::i;
if (!$_) {
#- deallocate table
ioctl($F, c::KDSKBENT(), pack("CCS", $table_index, 0, c::K_NOSUCHMAP())) or log::l("removing table $table_index failed: $!");
} else {
each_index {
ioctl($F, c::KDSKBENT(), pack("CCS", $table_index, $::i, $_)) or log::l("keymap ioctl failed ($table_index $::i $_): $!");
} @{$tables[$i_tables++]};
}
} @$tables_given;
}
sub keyboard2full_xkb {
my ($keyboard) = @_;
my $XkbLayout = keyboard2xkb($keyboard) or return { XkbDisable => '' };
my $XkbModel =
arch() =~ /sparc/ ? 'sun' :
$XkbLayout eq 'jp' ? 'jp106' :
$XkbLayout eq 'br' ? 'abnt2' : 'pc105';
{
XkbLayout => join(',', if_($keyboard->{GRP_TOGGLE}, 'us'), $XkbLayout),
XkbModel => $XkbModel,
XkbOptions => join(',',
if_($keyboard->{GRP_TOGGLE},
if_($keyboard->{GRP_TOGGLE} eq 'rwin_toggle', 'compose:rwin'),
"grp:$keyboard->{GRP_TOGGLE}",
'grp_led:scroll'),
if_(member($XkbLayout, 'az', 'tr', 'tr_f'), 'caps:shift')),
};
}
sub xmodmap_file {
my ($keyboard) = @_;
my $KEYBOARD = $keyboard->{KEYBOARD};
my $f = "$ENV{SHARE_PATH}/xmodmap/xmodmap.$KEYBOARD";
if (! -e $f) {
eval {
require packdrake;
my $packer = new packdrake("$ENV{SHARE_PATH}/xmodmap.cz2", quiet => 1);
$packer->extract_archive("/tmp", "xmodmap.$KEYBOARD");
};
$f = "/tmp/xmodmap.$KEYBOARD";
}
-e $f && $f;
}
sub setxkbmap {
my ($keyboard) = @_;
my $xkb = keyboard::keyboard2full_xkb($keyboard) or return;
run_program::run('setxkbmap', '-option', '') if $xkb->{XkbOptions}; #- need re-initialised other toggles are cumulated
run_program::run('setxkbmap', $xkb->{XkbLayout}, '-model' => $xkb->{XkbModel}, '-option' => $xkb->{XkbOptions} || '', '-compat' => $xkb->{XkbCompat} || '');
}
sub setup {
my ($keyboard) = @_;
return if arch() =~ /^sparc/;
#- Xpmac doesn't map keys quite right
if (arch() =~ /ppc/ && !$::testing && $ENV{DISPLAY}) {
log::l("Fixing Mac keyboard");
run_program::run('xmodmap', "-e", "keycode 59 = BackSpace");
run_program::run('xmodmap', "-e", "keycode 131 = Shift_R");
run_program::run('xmodmap', "-e", "add shift = Shift_R");
return;
}
my $kmap = keyboard2kmap($keyboard) or return;
log::l("loading keymap $kmap");
if (-x '/bin/loadkeys') {
run_program::run('loadkeys', $kmap);
} elsif (-e (my $f = "$ENV{SHARE_PATH}/keymaps/$kmap.bkmap")) {
load(scalar cat_($f));
} else {
my $kid = bg_command->new(sub {
eval {
require packdrake;
my $packer = new packdrake("$ENV{SHARE_PATH}/keymaps.cz2", quiet => 1);
$packer->extract_archive(undef, "$kmap.bkmap");
};
});
local $/ = undef;
eval { my $fd = $kid->{fd}; load(join('', <$fd>)) };
}
if (-x "/usr/X11R6/bin/setxkbmap") {
setxkbmap($keyboard);
} else {
my $f = xmodmap_file($keyboard);
eval { run_program::run('xmodmap', $f) } if $f && !$::testing && $ENV{DISPLAY};
}
}
sub write {
my ($keyboard) = @_;
log::l("keyboard::write $keyboard->{KEYBOARD}");
$keyboard = { %$keyboard };
delete $keyboard->{unsafe};
$keyboard->{KEYTABLE} = keyboard2kmap($keyboard);
setVarsInSh("$::prefix/etc/sysconfig/keyboard", $keyboard);
run_program::rooted($::prefix, 'dumpkeys', '>', '/etc/sysconfig/console/default.kmap') or log::l("dumpkeys failed");
if (arch() =~ /ppc/) {
my $s = "dev.mac_hid.keyboard_sends_linux_keycodes = 1\n";
substInFile {
$_ = '' if /^\Qdev.mac_hid.keyboard_sends_linux_keycodes/;
$_ .= $s if eof;
} "$::prefix/etc/sysctl.conf";
}
}
sub read() {
my %keyboard = getVarsFromSh("$::prefix/etc/sysconfig/keyboard") or return;
if (!$keyboard{KEYBOARD}) {
add2hash(\%keyboard, grep { keyboard2kmap($_) eq $keyboard{KEYTABLE} } keyboards());
}
$keyboard{DISABLE_WINDOWS_KEY} = bool2yesno(detect_devices::isLaptop());
keyboard2text(\%keyboard) ? \%keyboard : {};
}
sub check() {
require lang;
$^W = 0;
my $not_ok = 0;
my $warn = sub {
print STDERR "$_[0]\n";
};
my $err = sub {
&$warn;
$not_ok = 1;
};
if (my @l = grep { is_empty_array_ref(lang2keyboards($_)) } lang::list_langs()) {
$warn->("no keyboard for langs " . join(" ", @l));
}
foreach my $lang (lang::list_langs()) {
my $l = lang2keyboards($lang);
foreach (@$l) {
0 <= $_->[1] && $_->[1] <= 100 or $err->("invalid value $_->[1] in $lang2keyboard{$lang} for $lang in \%lang2keyboard keyboard.pm");
$keyboards{$_->[0]} or $err->("invalid keyboard $_->[0] in $lang2keyboard{$lang} for $lang in \%lang2keyboard keyboard.pm");
}
}
/SKIP/ || $keyboards{$_} or $err->("invalid keyboard $_ in \@usb2keyboard keyboard.pm") foreach @usb2keyboard;
$usb2keyboard[0x21] eq 'us' or $err->('@usb2keyboard is badly modified, 0x21 is not us keyboard');
my @xkb_groups = map { if_(/grp:(\S+)/, $1) } cat_('/usr/lib/X11/xkb/rules/xfree86.lst');
$err->("invalid xkb group toggle '$_' in \%grp_toggles") foreach difference2([ keys %grp_toggles ], \@xkb_groups);
$warn->("unused xkb group toggle '$_'") foreach grep { !/switch/ } difference2(\@xkb_groups, [ keys %grp_toggles ]);
my @xkb_layouts = (#- (map { (split)[0] } grep { /^! layout/ .. /^\s*$/ } cat_('/usr/lib/X11/xkb/rules/xfree86.lst')),
all('/usr/lib/X11/xkb/symbols'),
(map { (split)[2] } cat_('/usr/lib/X11/xkb/symbols.dir')));
$err->("invalid xkb layout $_") foreach difference2([ map { keyboard2xkb($_) } keyboards() ], \@xkb_layouts);
my @kmaps_available = map { if_(m|.*/(.*)\.bkmap|, $1) } `tar tfj share/keymaps.tar.bz2`;
my @kmaps_wanted = map { keyboard2kmap($_) } keyboards();
$err->("missing KEYTABLE $_ (either share/keymaps.tar.bz2 need updating or $_ is bad)") foreach difference2(\@kmaps_wanted, \@kmaps_available);
$err->("unused KEYTABLE $_ (update share/keymaps.tar.bz2 using share/keymaps_generate)") foreach difference2(\@kmaps_available, \@kmaps_wanted);
loadkeys_files($err);
exit($not_ok);
}
1;
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
package network::netconnect;
use common;
use log;
use detect_devices;
use run_program;
use modules;
use any;
use mouse;
use network;
use network::tools;
use MDK::Common::Globals "network", qw($in $prefix $connect_file $disconnect_file $connect_prog);
@EXPORT = qw(start_internet stop_internet);
#- intro is called only in standalone.
sub intro {
my ($prefix, $netcnx, $in) = @_;
my ($netc, $mouse, $intf) = ({}, {}, {});
my $text;
my $connected;
my $connect_file = "/etc/sysconfig/network-scripts/net_cnx_up";
my $disconnect_file = "/etc/sysconfig/network-scripts/net_cnx_down";
my $connect_prog = "/etc/sysconfig/network-scripts/net_cnx_pg";
read_net_conf($prefix, $netcnx, $netc);
if (!$::isWizard) {
if (connected()) {
$text = N("You are currently connected to internet.") . (-e $disconnect_file ? N("\nYou can disconnect or reconfigure your connection.") : N("\nYou can reconfigure your connection."));
$connected = 1;
} else {
$text = N("You are not currently connected to Internet.") . (-e $connect_file ? N("\nYou can connect to Internet or reconfigure your connection.") : N("\nYou can reconfigure your connection."));
$connected = 0;
}
my @l = (
!$connected && -e $connect_file ? { description => N("Connect"),
c => 1 } : (),
$connected && -e $disconnect_file ? { description => N("Disconnect"),
c => 2 } : (),
{ description => N("Configure the connection"),
c => 3 },
{ description => N("Cancel"),
c => 4 },
);
my $e = $in->ask_from_listf(N("Internet connection & configuration"),
translate($text),
sub { $_[0]{description} },
\@l);
run_program::rooted($prefix, $connect_prog) if $e->{c} == 1;
run_program::rooted($prefix, $disconnect_file) if $e->{c} == 2;
main($prefix, $netcnx, $netc, $mouse, $in, $intf, 0, 0) if $e->{c} == 3;
$in->exit(0) if $e->{c} == 4;
} else {
main($prefix, $netcnx, $netc, $mouse, $in, $intf, 0, 0);
}
}
sub detect {
my ($auto_detect, $net_install) = @_;
my $isdn = {};
require network::isdn;
network::isdn->import;
isdn_detect_backend($isdn);
$auto_detect->{isdn}{$_} = $isdn->{$_} foreach qw(description vendor id driver card_type type);
$auto_detect->{isdn}{description} =~ s/.*\|//;
modules::load_category('network/main|usb');
require network::ethernet;
network::ethernet->import;
my @all_cards = conf_network_card_backend (undef, undef, undef, undef, undef, undef);
map { $auto_detect->{lan}{$_->[0]} = $_->[1] } @all_cards if !$net_install;
my $adsl = {};
require network::adsl;
network::adsl->import;
$auto_detect->{adsl} = adsl_detect($adsl);
my $modem = {};
require network::modem;
network::modem->import;
my ($modem, @pci_modems) = detect_devices::getModem();
$modem->{device} and $auto_detect->{modem} = $modem->{device};
@pci_modems and $auto_detect->{winmodem}{$_->{driver}} = $_->{description} foreach @pci_modems;
}
sub pre_func {
my ($text) = @_;
$in->isa('interactive_gtk') or return;
$::Wizard_no_previous = 1;
if ($::isStandalone) {
$::Wizard_splash = 1;
require my_gtk;
my_gtk->import(qw(:wrappers));
my $W = my_gtk->new(N("Network Configuration Wizard"));
gtkadd($W->{window},
gtkpack_(new Gtk::VBox(0, 0),
1, write_on_pixmap(gtkpng("drakconnect_step"),
20,200,
N("We are now going to configure the %s connection.", translate($text)),
),
0, $W->create_okcancel(N("OK"))
)
);
$W->main;
$::Wizard_splash = 0;
} else {
#- for i18n : %s is the type of connection of the list: (modem, isdn, adsl, cable, local network);
$in->ask_okcancel(N("Network Configuration Wizard"), N("\n\n\nWe are now going to configure the %s connection.\n\n\nPress OK to continue.", translate($_[0])), 1);
}
undef $::Wizard_no_previous;
}
sub init_globals {
my ($in, $prefix) = @_;
MDK::Common::Globals::init(
in => $in,
prefix => $prefix,
connect_file => "/etc/sysconfig/network-scripts/net_cnx_up",
disconnect_file => "/etc/sysconfig/network-scripts/net_cnx_down",
connect_prog => "/etc/sysconfig/network-scripts/net_cnx_pg");
}
sub main {
my ($prefix, $netcnx, $netc, $mouse, $in, $intf, $first_time, $direct_fr, $noauto) = @_;
init_globals ($in, $prefix);
$netc->{minus_one} = 0; #When one configure an eth in dhcp without gateway
$::isInstall and $in->set_help('configureNetwork');
$::isStandalone and read_net_conf($prefix, $netcnx, $netc); # REDONDANCE with intro. FIXME
$netc->{NET_DEVICE} = $netcnx->{NET_DEVICE} if $netcnx->{NET_DEVICE}; # REDONDANCE with read_conf. FIXME
$netc->{NET_INTERFACE} = $netcnx->{NET_INTERFACE} if $netcnx->{NET_INTERFACE}; # REDONDANCE with read_conf. FIXME
network::read_all_conf($prefix, $netc ||= {}, $intf ||= {});
modules::mergein_conf("$prefix/etc/modules.conf");
my $direct_net_install;
if ($first_time && $::isInstall && ($in->{method} eq "ftp" || $in->{method} eq "http" || $in->{method} eq "nfs")) {
(!($::expert || $noauto) or $in->ask_okcancel(N("Network Configuration"),
N("Because you are doing a network installation, your network is already configured.
Click on Ok to keep your configuration, or cancel to reconfigure your Internet & Network connection.
"), 1)) and do {
$netcnx->{type} = 'lan';
output "$prefix$connect_file",
qq(
ifup eth0
);
output "$prefix$disconnect_file",
qq(
ifdown eth0
);
chmod 0755, "$prefix$disconnect_file";
chmod 0755, "$prefix$connect_file";
$direct_net_install = 1;
goto step_5;
};
}
$netc->{autodetection} = 1;
$netc->{autodetect} = {};
step_1:
$::Wizard_no_previous = 1;
my @profiles = get_profiles();
$in->ask_from(N("Network Configuration Wizard"),
N("Welcome to The Network Configuration Wizard.
We are about to configure your internet/network connection.
If you don't want to use the auto detection, deselect the checkbox.
"),
[
if_(@profiles > 1, { label => N("Choose the profile to configure"), val => \$netcnx->{PROFILE}, list => \@profiles }),
{ label => N("Use auto detection"), val => \$netc->{autodetection}, type => 'bool' },
if_($::isStandalone, { label => N("Expert Mode"), val => \$::expert, type => 'bool' }),
]
) or goto step_5;
undef $::Wizard_no_previous;
set_profile($netcnx);
if ($netc->{autodetection}) {
my $w = $in->wait_message(N("Network Configuration Wizard"), N("Detecting devices..."));
detect($netc->{autodetect}, $::isInstall && ($in->{method} eq "ftp" || $in->{method} eq "http" || $in->{method} eq "nfs"));
}
step_2:
my $set_default;
my %conf;
$conf{$_} = $netc->{autodetect}{$_} ? 1 : 0 foreach 'modem', 'winmodem', 'adsl', 'cable', 'lan';
$conf{isdn} = $netc->{autodetect}{isdn}{description} ? 1 : 0;
# my @l = (
# [N("Normal modem connection"), $netc->{autodetect}{modem}, N_("detected on port %s"), \$conf{modem}],
# [N("ISDN connection"), $netc->{autodetect}{isdn}{description}, N_("detected %s"), \$conf{isdn}],
# [N("ADSL connection"), $netc->{autodetect}{adsl}, N_("detected"), \$conf{adsl}],
# [N("Cable connection"), $netc->{autodetect}{cable}, N_("cable connection detected"), \$conf{cable}],
# [N("LAN connection"), $netc->{autodetect}{lan}, N_("ethernet card(s) detected"), \$conf{lan}]
# );
my $i = 0;
map { defined $set_default or do { $_->[1] and $set_default = $i }; $i++ } @l;
@l = (
[N("Normal modem connection") . if_($netc->{autodetect}{modem}, " - " . N("detected on port %s", $netc->{autodetect}{modem})), \$conf{modem}],
[N("Winmodem connection") . if_($netc->{autodetect}{winmodem}, " - " . N("detected")), \$conf{winmodem}],
[N("ISDN connection") . if_($netc->{autodetect}{isdn}{description}, " - " . N("detected %s", $netc->{autodetect}{isdn}{description})), \$conf{isdn}],
[N("ADSL connection") . if_($netc->{autodetect}{adsl}, " - " . N("detected")), \$conf{adsl}],
[N("Cable connection") . if_($netc->{autodetect}{cable}, " - " . N("cable connection detected")), \$conf{cable}],
[N("LAN connection") . if_($netc->{autodetect}{lan}, " - " . N("ethernet card(s) detected")), \$conf{lan}]
);
$::isInstall and $in->set_help('configureNetwork');
my $e = $in->ask_from(N("Network Configuration Wizard"), N("Choose the connection you want to configure"),
[ map { { label => $_->[0], val => $_->[1], type => 'bool' } } @l ],
changed => sub {
return if !$netc->{autodetection};
my $c = 0;
#- $conf{adsl} and $c++;
$conf{cable} and $c++;
my $a = keys(%{$netc->{autodetect}{lan}});
0 < $a && $a <= $c and $conf{lan} = undef;
}
) or goto step_1;
# load_conf ($netcnx, $netc, $intf);
$conf{modem} and do { pre_func("modem"); require network::modem; network::modem::configure($netcnx, $mouse, $netc) or goto step_2 };
$conf{winmodem} and do { pre_func("winmodem"); require network::modem; network::modem::winmodemConfigure($netc) or goto step_2 };
$conf{isdn} and do { pre_func("isdn"); require network::isdn; network::isdn::configure($netcnx, $netc) or goto step_2 };
$conf{adsl} and do { pre_func("adsl"); require network::adsl; network::adsl::configure($netcnx, $netc, $intf, $first_time) or goto step_2 };
$conf{cable} and do { pre_func("cable"); require network::ethernet; network::ethernet::configure_cable($netcnx, $netc, $intf, $first_time) or goto step_2; $netconnect::need_restart_network = 1 };
$conf{lan} and do { pre_func("local network"); require network::ethernet; network::ethernet::configure_lan($netcnx, $netc, $intf, $first_time) or goto step_2; $netconnect::need_restart_network = 1 };
step_2_1:
my $nb = keys %{$netc->{internet_cnx}};
if ($nb < 1) {
} elsif ($nb > 1) {
$in->ask_from(N("Network Configuration Wizard"),
N("You have configured multiple ways to connect to the Internet.\nChoose the one you want to use.\n\n") . if_(!$::isStandalone, "You may want to configure some profiles after the installation, in the Mandrake Control Center"),
[ { label => N("Internet connection"), val => \$netc->{internet_cnx_choice}, list => [ keys %{$netc->{internet_cnx}} ] } ]
) or goto step_2;
} elsif ($nb == 1) {
$netc->{internet_cnx_choice} = (keys %{$netc->{internet_cnx}})[0];
}
member($netc->{internet_cnx_choice}, ('adsl', 'isdn')) and
$netc->{at_boot} = $in->ask_yesorno(N("Network Configuration Wizard"), N("Do you want to start the connection at boot?"));
if ($netc->{internet_cnx_choice}) {
write_cnx_script($netc);
$netcnx->{type} = $netc->{internet_cnx}{$netc->{internet_cnx_choice}}{type};
} else {
unlink "$prefix/etc/sysconfig/network-scripts/net_cnx_up";
unlink "$prefix/etc/sysconfig/network-scripts/net_cnx_down";
undef $netc->{NET_DEVICE};
}
my $success = 1;
network::configureNetwork2($in, $prefix, $netc, $intf);
my $network_configured = 1;
if ($netconnect::need_restart_network && $::isStandalone and ($::expert or $in->ask_yesorno(N("Network configuration"),
N("The network needs to be restarted"), 1))) {
#- run_program::rooted($prefix, "/etc/rc.d/init.d/network stop");
if (!run_program::rooted($prefix, "/etc/rc.d/init.d/network restart")) {
$success = 0;
$in->ask_okcancel(N("Network Configuration"), N("A problem occured while restarting the network: \n\n%s", `/etc/rc.d/init.d/network restart`), 0);
}
}
write_initscript();
$::isStandalone && member($netc->{internet_cnx_choice}, ('modem', 'adsl', 'isdn')) and
$success = ask_connect_now($netc->{internet_cnx_choice});
step_3:
my $m = $success ? N("Congratulations, the network and Internet configuration is finished.
The configuration will now be applied to your system.
") . if_($::isStandalone && $in->isa('interactive_gtk'),
N("After this is done, we recommend that you restart your X environment to avoid any hostname-related problems.")) :
N("Problems occured during configuration.
Test your connection via net_monitor or mcc. If your connection doesn't work, you might want to relaunch the configuration.");
if ($::isWizard) {
$::Wizard_no_previous = 1;
$::Wizard_finished = 1;
$in->ask_okcancel(N("Network Configuration"), $m, 1);
undef $::Wizard_no_previous;
undef $::Wizard_finished;
} else { $::isStandalone and $in->ask_warn('', $m) }
step_5:
$network_configured or network::configureNetwork2($in, $prefix, $netc, $intf);
if ($netcnx->{type} =~ /modem/ || $netcnx->{type} =~ /isdn_external/) {
output "$prefix$connect_prog",
qq(
#!/bin/bash
if [ -n "\$DISPLAY" ]; then
if [ -e /usr/bin/kppp ]; then
/sbin/route del default
/usr/bin/kppp &
else
/usr/sbin/net_monitor --connect
fi
else
$connect_file
fi
);
} elsif ($netcnx->{type}) {
output "$prefix$connect_prog",
qq(
#!/bin/bash
if [ -n "\$DISPLAY" ]; then
/usr/sbin/net_monitor --connect
else
$connect_file
fi
);
} else {
output "$prefix$connect_prog",
qq(
#!/bin/bash
/usr/sbin/drakconnect
);
}
if ($direct_net_install) {
output "$prefix$connect_prog",
qq(
#!/bin/bash
if [ -n "\$DISPLAY" ]; then
/usr/sbin/net_monitor --connect
else
$connect_file
fi
);
}
chmod 0755, "$prefix$connect_prog";
$netcnx->{$_} = $netc->{$_} foreach qw(NET_DEVICE NET_INTERFACE);
$netcnx->{NET_INTERFACE} and set_net_conf($netcnx, $netc);
$netcnx->{type} =~ /adsl/ or system("/sbin/chkconfig --del adsl 2> /dev/null");
save_conf($netcnx, $netc, $intf);
if ($::isInstall && $::o->{security} >= 3) {
require network::drakfirewall;
network::drakfirewall::main($in, $::o->{security} <= 3);
}
#- if ($netc->{NET_DEVICE} and $netc->{NETWORKING} ne 'no' and $::isStandalone and $::expert) {
#- exists $netc->{nb_cards} or do {
#- any::load_category($in, 'network/main|usb', !$::expert, 1);
#- $netc->{nb_cards} = listlength(detect_devices::getNet());
#- };
#- ($netc->{nb_cards} - $netc->{minus_one} - (get_net_device($prefix) =~ /eth.+/ ? 1 : 0) > 0) and $in->ask_okcancel(N("Network Configuration"),
#-N("Now that your Internet connection is configured,
#-your computer can be configured to share its Internet connection.
#-Note: you need a dedicated Network Adapter to set up a Local Area Network (LAN).
#-
#-Would you like to setup the Internet Connection Sharing?
#-"), 1) and system("/usr/sbin/drakgw --direct");
#- }
}
sub save_conf {
my ($netcnx, $netc, $intf) = @_;
my $adsl;
my $modem;
my $isdn;
$netcnx->{type} =~ /adsl/ and $adsl = $netcnx->{$netcnx->{type}};
$netcnx->{type} eq 'isdn_external' || $netcnx->{type} eq 'modem' and $modem = $netcnx->{$netcnx->{type}};
$netcnx->{type} eq 'isdn_internal' and $isdn = $netcnx->{$netcnx->{type}};
modules::load_category('network/main|usb');
require network::ethernet;
network::ethernet->import;
my @all_cards = conf_network_card_backend ($netc, $intf, undef, undef, undef, undef);
$intf = { %$intf };
output("$prefix/etc/sysconfig/network-scripts/drakconnect_conf",
"SystemName=" . do { $netc->{HOSTNAME} =~ /([^\.]*)\./; $1 } . "
DomainName=" . do { $netc->{HOSTNAME} =~ /\.(.*)/; $1 } . "
InternetAccessType=" . do { if ($netcnx->{type}) { $netcnx->{type} } else { $netc->{GATEWAY} ? "lan" : "" } } . "
InternetInterface=" . ($netc->{GATEWAY} && (!$netcnx->{type} || $netcnx->{type} eq 'lan') ? $netc->{GATEWAYDEV} : $netcnx->{NET_INTERFACE}) . "
InternetGateway=$netc->{GATEWAY}
DNSPrimaryIP=$netc->{dnsServer}
DNSSecondaryIP=$netc->{dnsServer2}
DNSThirdIP=$netc->{dnsServer3}
AdminInterface=
" . join ('', map {
"Eth${_}Known=" . ($intf->{"eth$_"}{DEVICE} eq "eth$_" ? 'true' : 'false') . "
Eth${_}IP=" . $intf->{"eth$_"}{IPADDR} . "
Eth${_}Mask=" . $intf->{"eth$_"}{NETMASK} . "
Eth${_}Mac=
Eth${_}BootProto=" . $intf->{"eth$_"}{BOOTPROTO} . "
Eth${_}OnBoot=" . $intf->{"eth$_"}{ONBOOT} . "
Eth${_}Hostname=$netc->{HOSTNAME}
Eth${_}HostAlias=" . do { $netc->{HOSTNAME} =~ /([^\.]*)\./; $1 } . "
Eth${_}Driver=$all_cards[$_][1]
Eth${_}Irq=
Eth${_}Port=
Eth${_}DHCPClient=" . ($intf->{"eth$_"}{BOOTPROTO} eq 'dhcp' ? $netcnx->{dhcp_client} : '') . "
Eth${_}DHCPServerName=" . ($intf->{"eth$_"}{BOOTPROTO} eq 'dhcp' ? $netc->{HOSTNAME} : '') . "\n"
} (0..9)) .
"
ISDNDriver=$isdn->{driver}
ISDNDeviceType=$isdn->{type}
ISDNIrq=$isdn->{irq}
ISDNMem=$isdn->{mem}
ISDNIo=$isdn->{io}
ISDNIo0=$isdn->{io0}
ISDNIo1=$isdn->{io1}
ISDNProtocol=$isdn->{protocol}
ISDNCardDescription=$isdn->{description}
ISDNCardVendor=$isdn->{vendor}
ISDNId=$isdn->{id}
ISDNProvider=$netc->{DOMAINNAME2}
ISDNProviderPhone=$isdn->{phone_out}
ISDNProviderDomain=" . do { $netc->{DOMAINNAME2} =~ /\.(.*)/; $1 } . "
ISDNProviderDNS1=$netc->{dnsServer2}
ISDNProviderDNS2=$netc->{dnsServer3}
ISDNDialing=$isdn->{dialing_mode}
ISDNSpeed=$isdn->{speed}
ISDNTimeout=$isdn->{huptimeout}
ISDNHomePhone=$isdn->{phone_in}
ISDNLogin=$isdn->{login}
ISDNPassword=$isdn->{passwd}
ISDNConfirmPassword=$isdn->{passwd2}
PPPInterfacesList=
PPPDevice=$modem->{device}
PPPDeviceSpeed=
PPPConnectionName=$modem->{connection}
PPPProviderPhone=$modem->{phone}
PPPProviderDomain=$modem->{domain}
PPPProviderDNS1=$modem->{dns1}
PPPProviderDNS2=$modem->{dns2}
PPPLogin=$modem->{login}
PPPPassword=$modem->{passwd}
PPPConfirmPassword=$modem->{passwd}
PPPAuthentication=$modem->{auth}
PPPSpecialCommand=" . ($netcnx->{type} eq 'isdn_external' ? $netcnx->{isdn_external}{special_command} : '') . "
ADSLInterfacesList=
ADSLModem=" . q( # Obsolete information. Please don't use it.) . "
ADSLType=" . ($netcnx->{type} =~ /adsl/ ? $netcnx->{type} : '') . "
ADSLProviderDomain=$netc->{DOMAINNAME2}
ADSLProviderDNS1=$netc->{dnsServer2}
ADSLProviderDNS2=$netc->{dnsServer3}
ADSLLogin=$adsl->{login}
ADSLPassword=$adsl->{passwd}
DOMAINNAME2=$netc->{DOMAINNAME2}"
);
chmod 0600, "$prefix/etc/sysconfig/network-scripts/drakconnect_conf";
my $a = $netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default";
cp_af("$prefix/etc/sysconfig/network-scripts/drakconnect_conf", "$prefix/etc/sysconfig/network-scripts/drakconnect_conf." . $a);
chmod 0600, "$prefix/etc/sysconfig/network-scripts/drakconnect_conf";
chmod 0600, "$prefix/etc/sysconfig/network-scripts/drakconnect_conf." . $a;
foreach (["$prefix$connect_file", "up"],
["$prefix$disconnect_file", "down"],
["$prefix$connect_prog", "prog"],
["$prefix/etc/ppp/ioptions1B", "iop1B"],
["$prefix/etc/ppp/ioptions2B", "iop2B"],
["$prefix/etc/isdn/isdn1B.conf", "isdn1B"],
["$prefix/etc/isdn/isdn2B.conf", "isdn2B"],
["$prefix/etc/resolv.conf", "resolv"],
["$prefix/etc/ppp/peers/adsl", "speedtouch"],
["$prefix/etc/ppp/peers/adsl", "eci"],
) {
my $file = "$prefix/etc/sysconfig/network-scripts/net_" . $_->[1] . "." . $a;
-e ($_->[0]) and cp_af($_->[0], $file) and chmod 0755, $file;
}
}
sub set_profile {
my ($netcnx, $profile) = @_;
$profile ||= $netcnx->{PROFILE};
$profile or return;
my $f = "$prefix/etc/sysconfig/network-scripts/drakconnect_conf";
-e ($f . "." . $profile) or return;
$netcnx->{PROFILE} = $profile;
cp_af($f . "." . $profile, $f);
foreach (["$prefix$connect_file", "up"],
["$prefix$disconnect_file", "down"],
["$prefix$connect_prog", "prog"],
["$prefix/etc/ppp/ioptions1B", "iop1B"],
["$prefix/etc/ppp/ioptions2B", "iop2B"],
["$prefix/etc/isdn/isdn1B.conf", "isdn1B"],
["$prefix/etc/isdn/isdn2B.conf", "isdn2B"],
["$prefix/etc/resolv.conf", "resolv"],
["$prefix/etc/ppp/peers/adsl", "speedtouch"],
["$prefix/etc/ppp/peers/adsl", "eci"],
) {
my $c = "$prefix/etc/sysconfig/network-scripts/net_" . $_->[1] . "." . $profile;
-e ($c) and cp_af($c, $_->[0]);
}
}
sub del_profile {
my ($netcnx, $profile) = @_;
$profile or return;
$profile eq "default" and return;
rm_rf("$prefix/etc/sysconfig/network-scripts/drakconnect_conf." . $profile);
rm_rf(glob_("$prefix/etc/sysconfig/network-scripts/net_{up,down,prog,iop1B,iop2B,isdn1B,isdn2B,resolv,speedtouch}." . $profile));
}
sub add_profile {
my ($netcnx, $profile) = @_;
$profile or return;
$profile eq "default" and return;
my $cmd1 = "$prefix/etc/sysconfig/network-scripts/drakconnect_conf." . ($netcnx->{PROFILE} ? $netcnx->{PROFILE} : "default");
my $cmd2 = "$prefix/etc/sysconfig/network-scripts/drakconnect_conf." . $profile;
cp_af($cmd1, $cmd2);
}
sub get_profiles {
map { if_(/drakconnect_conf\.(.*)/, $1) } all("$::prefix/etc/sysconfig/network-scripts");
}
sub load_conf {
my ($netcnx, $netc, $intf) = @_;
my $adsl_pptp = {};
my $adsl_pppoe = {};
my $modem = {};
my $isdn_external = {};
my $isdn = {};
my $system_name;
my $domain_name;
if (-e "$prefix/etc/sysconfig/network-scripts/drakconnect_conf") {
foreach (cat_("$prefix/etc/sysconfig/network-scripts/drakconnect_conf")) {
/^DNSPrimaryIP=(.*)$/ and $netc->{dnsServer} = $1;
/^DNSSecondaryIP=(.*)$/ and $netc->{dnsServer2} = $1;
/^DNSThirdIP=(.*)$/ and $netc->{dnsServer3} = $1;
/^InternetAccessType=(.*)$/ and $netcnx->{type} = $1;
/^InternetInterface=(.*)$/ and $netcnx->{NET_INTERFACE} = $1;
/^InternetGateway=(.*)$/ and $netc->{GATEWAY} = $1;
/^SystemName=(.*)$/ and $system_name = $1;
/^DomainName=(.*)$/ and $domain_name = $1;
/^Eth([0-9])Known=true$/ and $intf->{"eth$1"}{DEVICE} = "eth$1";
/^Eth([0-9])IP=(.*)$/ && $intf->{"eth$1"}{DEVICE} and $intf->{"eth$1"}{IPADDR} = $2;
/^Eth([0-9])Mask=(.*)\n/ && $intf->{"eth$1"}{DEVICE} and $intf->{"eth$1"}{NETMASK} = $2;
/^Eth([0-9])BootProto=(.*)\n/ && $intf->{"eth$1"}{DEVICE} and $intf->{"eth$1"}{BOOTPROTO} = $2;
/^Eth([0-9])OnBoot=(.*)\n/ && $intf->{"eth$1"}{DEVICE} and $intf->{"eth$1"}{ONBOOT} = $2;
/^Eth([0-9])Hostname=(.*)\n/ && $intf->{"eth$1"}{DEVICE} and $netc->{HOSTNAME} = $2;
/^Eth([0-9])Driver=(.*)\n/ && $intf->{"eth$1"}{DEVICE} and $intf->{"eth$1"}{driver} = $2;
/^ISDNDriver=(.*)$/ and $isdn->{driver} = $1;
/^ISDNDeviceType=(.*)$/ and $isdn->{type} = $1;
/^ISDNIrq=(.*)/ and $isdn->{irq} = $1;
/^ISDNMem=(.*)$/ and $isdn->{mem} = $1;
/^ISDNIo=(.*)$/ and $isdn->{io} = $1;
/^ISDNIo0=(.*)$/ and $isdn->{io0} = $1;
/^ISDNIo1=(.*)$/ and $isdn->{io1} = $1;
/^ISDNProtocol=(.*)$/ and $isdn->{protocol} = $1;
/^ISDNCardDescription=(.*)$/ and $isdn->{description} = $1;
/^ISDNCardVendor=(.*)$/ and $isdn->{vendor} = $1;
/^ISDNId=(.*)$/ and $isdn->{id} = $1;
/^ISDNProviderPhone=(.*)$/ and $isdn->{phone_out} = $1;
/^ISDNDialing=(.*)$/ and $isdn->{dialing_mode} = $1;
/^ISDNISDNSpeed=(.*)$/ and $isdn->{speed} = $1;
/^ISDNTimeout=(.*)$/ and $isdn->{huptimeout} = $1;
/^ISDNHomePhone=(.*)$/ and $isdn->{phone_in} = $1;
/^ISDNLogin=(.*)$/ and $isdn->{login} = $1;
/^ISDNPassword=(.*)$/ and $isdn->{passwd} = $1;
/^ISDNConfirmPassword=(.*)$/ and $isdn->{passwd2} = $1;
/^PPPDevice=(.*)$/ and $modem->{device} = $1;
/^PPPConnectionName=(.*)$/ and $modem->{connection} = $1;
/^PPPProviderPhone=(.*)$/ and $modem->{phone} = $1;
/^PPPProviderDomain=(.*)$/ and $modem->{domain} = $1;
/^PPPProviderDNS1=(.*)$/ and $modem->{dns1} = $1;
/^PPPProviderDNS2=(.*)$/ and $modem->{dns2} = $1;
/^PPPLogin=(.*)$/ and $modem->{login} = $1;
/^PPPPassword=(.*)$/ and $modem->{passwd} = $1;
/^PPPAuthentication=(.*)$/ and $modem->{auth} = $1;
if (/^PPPSpecialCommand=(.*)$/) {
$netcnx->{type} eq 'isdn_external' and $netcnx->{$netcnx->{type}}{special_command} = $1;
}
/^ADSLLogin=(.*)$/ and $adsl_pppoe->{login} = $1;
/^ADSLPassword=(.*)$/ and $adsl_pppoe->{passwd} = $1;
/^DOMAINNAME2=(.*)$/ and $netc->{DOMAINNAME2} = $1;
}
}
$system_name && $domain_name and $netc->{HOSTNAME} = join ('.', $system_name, $domain_name);
$adsl_pptp->{$_} = $adsl_pppoe->{$_} foreach 'login', 'passwd', 'passwd2';
$isdn_external->{$_} = $modem->{$_} foreach 'device', 'connection', 'phone', 'domain', 'dns1', 'dns2', 'login', 'passwd', 'auth';
$netcnx->{adsl_pptp} = $adsl_pptp;
$netcnx->{adsl_pppoe} = $adsl_pppoe;
$netcnx->{modem} = $modem;
$netcnx->{modem} = $isdn_external;
$netcnx->{isdn_internal} = $isdn;
-e "$prefix/etc/sysconfig/network" and put_in_hash($netc, network::read_conf("$prefix/etc/sysconfig/network"));
foreach (glob_("$prefix/etc/sysconfig/ifcfg-*")) {
my $l = network::read_interface_conf($_);
$intf->{$l->{DEVICE}} = $l;
}
my $file = "$prefix/etc/resolv.conf";
if (-e $file) {
put_in_hash($netc, network::read_resolv_conf($file));
}
}
#- ensures the migration from old config files
sub read_raw_net_conf {
my ($suffix) = @_;
my $dir = "$::prefix/etc/sysconfig/network-scripts";
# $suffix = $suffix ? ".$suffix" : '';
rename "$dir/draknet$suffix", "$dir/drakconnect$suffix";
getVarsFromSh("$dir/drakconnect_conf");
}
sub get_net_device {
${{ read_raw_net_conf() }}{InternetInterface};
}
sub read_net_conf {
my ($prefix, $netcnx, $netc) = @_;
add2hash($netcnx, { read_raw_net_conf('_conf') });
$netc->{$_} = $netcnx->{$_} foreach 'NET_DEVICE', 'NET_INTERFACE';
$netcnx->{$netcnx->{type}} ||= {};
add2hash($netcnx->{$netcnx->{type}}, { read_raw_net_conf($netcnx->{type}) });
}
sub set_net_conf {
my ($netcnx, $netc) = @_;
setVarsInShMode("$prefix/etc/sysconfig/drakconnect", 0600, $netcnx, "NET_DEVICE", "NET_INTERFACE", "type", "PROFILE");
setVarsInShMode("$prefix/etc/sysconfig/drakconnect." . $netcnx->{type}, 0600, $netcnx->{$netcnx->{type}}); #- doesn't work, don't know why
setVarsInShMode("$prefix/etc/sysconfig/drakconnect.netc", 0600, $netc); #- doesn't work, don't know why
}
sub start_internet {
my ($o) = @_;
init_globals ($o, $o->{prefix});
run_program::rooted($prefix, $connect_file);
}
sub stop_internet {
my ($o) = @_;
init_globals ($o, $o->{prefix});
run_program::rooted($prefix, $disconnect_file);
}
#---------------------------------------------
# WONDERFULL pad
#---------------------------------------------
1;
=head1 network::netconnect::detect()
=head2 example of usage
use lib qw(/usr/lib/libDrakX);
use network::netconnect;
use Data::Dumper;
use class_discard;
local $in = class_discard->new;
network::netconnect::init_globals($in);
my %i;
&network::netconnect::detect(\%i);
print Dumper(\%i),"\n";
=cut
|