package any; # $Id$ use diagnostics; use strict; #-###################################################################################### #- misc imports #-###################################################################################### use common qw(:common :system :file :functional); use commands; use detect_devices; use partition_table qw(:types); use fsedit; use fs; use run_program; use modules; use log; sub drakx_version { sprintf "DrakX v%s built %s", $::testing ? ('TEST', scalar gmtime()) : (split('/', cat_("/usr/share/VERSION")))[2,3]; } sub facesdir { my ($prefix) = @_; "$prefix/usr/share/faces/"; } sub face2xpm { my ($face, $prefix) = @_; facesdir($prefix) . $face . ".xpm"; } sub face2png { my ($face, $prefix) = @_; facesdir($prefix) . $face . ".png"; } sub facesnames { my ($prefix) = @_; my $dir = facesdir($prefix); my @l = grep { /^[A-Z]/ } all($dir); grep { -e "$dir/$_.png" } map { /(.*)\.xpm/ } (@l ? @l : all($dir)); } sub addKdmIcon { my ($prefix, $user, $icon) = @_; my $dest = "$prefix/usr/share/faces/$user.png"; eval { commands::cp("-f", facesdir($prefix) . $icon . ".png", $dest) } if $icon; } sub allocUsers { my ($prefix, $users) = @_; my @m = my @l = facesnames($prefix); foreach (grep { !$_->{icon} || $_->{icon} eq "automagic" } @$users) { $_->{auto_icon} = splice(@m, rand(@m), 1); #- known biased (see cookbook for better) log::l("auto_icon is $_->{auto_icon}"); @m = @l unless @m; } } sub addUsers { my ($prefix, $users) = @_; my $msec = "$prefix/etc/security/msec"; allocUsers($prefix, $users); foreach my $u (@$users) { substInFile { s/^$u->{name}\n//; $_ .= "$u->{name}\n" if eof } "$msec/user.conf" if -d $msec; addKdmIcon($prefix, $u->{name}, delete $u->{auto_icon} || $u->{icon}); } run_program::rooted($prefix, "/usr/share/msec/grpuser.sh --refresh >/dev/null"); } sub crypt { my ($password, $md5) = @_; crypt($password, $md5 ? '$1$' . salt(8) : salt(2)); } sub enableShadow { my ($prefix) = @_; run_program::rooted($prefix, "pwconv") or log::l("pwconv failed"); run_program::rooted($prefix, "grpconv") or log::l("grpconv failed"); } sub enableMD5Shadow { my ($prefix, $shadow, $md5) = @_; substInFile { if (/^password.*pam_pwdb.so/) { s/\s*shadow//; s/\s*md5//; s/$/ shadow/ if $shadow; s/$/ md5/ if $md5; } } grep { -r $_ } map { "$prefix/etc/pam.d/$_" } qw(login rlogin passwd); } sub setupBootloader { my ($in, $b, $hds, $fstab, $security, $prefix, $more) = @_; $more++ if $b->{bootUnsafe}; if (!$::expert && $more < 1) { #- automatic } elsif (!$::expert) { my @l = (__("First sector of drive (MBR)"), __("First sector of boot partition")); $in->set_help('setupBootloaderBeginner') unless $::isStandalone; if (arch() =~ /sparc/) { $b->{use_partition} = $in->ask_from_list_(_("SILO Installation"), _("Where do you want to install the bootloader?"), \@l, $l[$b->{use_partition}]) or return; } else { my $boot = $hds->[0]{device}; my $onmbr = "/dev/$boot" eq $b->{boot}; $b->{boot} = "/dev/" . ($in->ask_from_list_(_("LILO/grub Installation"), _("Where do you want to install the bootloader?"), \@l, $l[!$onmbr]) eq $l[0] ? $boot : fsedit::get_root($fstab, 'boot')->{device}); } } else { $in->set_help(arch() =~ /sparc/ ? "setupSILOGeneral" : "setupBootloaderGeneral") unless $::isStandalone; #- TO MERGE ? if ($::expert) { my $default = arch() =~ /sparc/ ? 'silo' : 'grub'; my $m = $in->ask_from_list_('', _("Which bootloader(s) do you want to use?"), [ keys(%{$b->{methods}}), __("None") ], $default) or return; $b->{methods}{$_} = 0 foreach keys %{$b->{methods}}; $b->{methods}{$m} = 1 if $m ne "None"; } #- at least one method grep_each { $::b } %{$b->{methods}} or return; #- put lilo if grub is chosen, so that /etc/lilo.conf is generated exists $b->{methods}{lilo} and $b->{methods}{lilo} = 1 if $b->{methods}{grub}; my @silo_install_lang = (_("First sector of drive (MBR)"), _("First sector of boot partition")); my $silo_install_lang = $silo_install_lang[$b->{use_partition}]; my $profiles = bootloader::has_profiles($b); my $memsize = bootloader::get_append('mem'); $b->{vga} ||= 'Normal'; $in->ask_from_entries_refH('', _("Bootloader main options"), [ arch() =~ /sparc/ ? ( { label => _("Bootloader installation"), val => \$silo_install_lang, list => \@silo_install_lang }, ) : ( { label => _("Boot device"), val => \$b->{boot}, list => [ map { "/dev/$_" } (map { $_->{device} } (@$hds, grep { !isFat($_) } @$fstab)), detect_devices::floppies() ], not_edit => !$::expert }, { label => _("LBA (doesn't work on old BIOSes)"), val => \$b->{lba32}, type => "bool", text => "lba", advanced => 1 }, { label => _("Compact"), val => \$b->{compact}, type => "bool", text => _("compact"), advanced => 1 }, { label => _("Video mode"), val => \$b->{vga}, list => [ keys %bootloader::vga_modes ], not_edit => !$::expert, advanced => 1 }, ), { label => _("Delay before booting default image"), val => \$b->{timeout} }, if_($security >= 4, { label => _("Password"), val => \$b->{password}, hidden => 1 }, { label => _("Password (again)"), val => \$b->{password2}, hidden => 1 }, { label => _("Restrict command line options"), val => \$b->{restricted}, type => "bool", text => _("restrict") }, ), { label => _("Clean /tmp at each boot"), val => \$b->{CLEAN_TMP}, type => 'bool', advanced => 1 }, { label => _("Precise RAM size if needed (found %d MB)", availableRamMB()), val => \$memsize, advanced => 1 }, if_(detect_devices::hasPCMCIA, { label => _("Enable multi profiles"), val => \$profiles, type => 'bool', advanced => 1 }, ), ], complete => sub { !$memsize || $memsize =~ /K$/ || $memsize =~ s/^(\d+)M?$/$1M/i or $in->ask_warn('', _("Give the ram size in MB")), return 1; #- $security > 4 && length($b->{password}) < 6 and $in->ask_warn('', _("At this level of security, a password (and a good one) in lilo is requested")), return 1; $b->{restricted} && !$b->{password} and $in->ask_warn('', _("Option ``Restrict command line options'' is of no use without a password")), return 1; $b->{password} eq $b->{password2} or !$b->{restricted} or $in->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return 1; 0; } ) or return 0; $b->{use_partition} = $silo_install_lang eq _("First sector of drive (MBR)") ? 0 : 1; $b->{vga} = $bootloader::vga_modes{$b->{vga}} || $b->{vga}; bootloader::set_profiles($b, $profiles); bootloader::add_append($b, "mem", $memsize); } while ($::expert || $more > 1) { $in->set_help(arch() =~ /sparc/ ? 'setupSILOAddEntry' : 'setupBootloaderAddEntry') unless $::isStandalone; my $c; $in->ask_from_entries_refH_powered( { messages => _("Here are the different entries. You can add some more or change the existing ones."), ok => '', }, [ { val => \$c, format => sub { my ($e) = @_; ref $e ? "$e->{label} ($e->{kernel_or_dev})" . ($b->{default} eq $e->{label} && " *") : translate($e); }, list => [ @{$b->{entries}}, __("Add"), __("Done") ] } ] ); $c eq "Done" and last; my ($e); if ($c eq "Add") { my @labels = map { $_->{label} } @{$b->{entries}}; my $prefix; if ($in->ask_from_list_('', _("Which type of entry do you want to add?"), [ __("Linux"), arch() =~ /sparc/ ? __("Other OS (SunOS...)") : __("Other OS (windows...)") ] ) eq "Linux") { $e = { type => 'image', root => '/dev/' . fsedit::get_root($fstab)->{device}, #- assume a good default. }; $prefix = "linux"; } else { $e = { type => 'other' }; $prefix = arch() =~ /sparc/ ? "sunos" : "windows"; } $e->{label} = $prefix; for (my $nb = 0; member($e->{label}, @labels); $nb++) { $e->{label} = "$prefix-$nb" } } else { $e = $c; } my %old_e = %$e; my $default = my $old_default = $e->{label} eq $b->{default}; my @l; if ($e->{type} eq "image") { @l = ( { label => _("Image"), val => \$e->{kernel_or_dev}, list => [ map { s/$prefix//; $_ } glob_("$prefix/boot/vmlinuz*") ], not_edit => 0 }, { label => _("Root"), val => \$e->{root}, list => [ map { "/dev/$_->{device}" } @$fstab ], not_edit => !$::expert }, { label => _("Append"), val => \$e->{append} }, { label => _("Video mode"), val => \$e->{vga}, list => [ keys %bootloader::vga_modes ], not_edit => !$::expert }, { label => _("Initrd"), val => \$e->{initrd}, list => [ map { s/$prefix//; $_ } glob_("$prefix/boot/initrd*") ] }, { label => _("Read-write"), val => \$e->{'read-write'}, type => 'bool' } ); @l = @l[0..2] unless $::expert; } else { @l = ( { label => _("Root"), val => \$e->{kernel_or_dev}, list => [ map { "/dev/$_->{device}" } @$fstab ], not_edit => !$::expert }, arch() !~ /sparc/ ? ( { label => _("Table"), val => \$e->{table}, list => [ '', map { "/dev/$_->{device}" } @$hds ], not_edit => !$::expert }, { label => _("Unsafe"), val => \$e->{unsafe}, type => 'bool' } ) : (), ); @l = $l[0] unless $::expert; } @l = ( { label => _("Label"), val => \$e->{label} }, @l, { label => _("Default"), val => \$default, type => 'bool' }, ); if ($in->ask_from_entries_refH_powered( { if_($c ne "Add", cancel => _("Remove entry")), callbacks => { complete => sub { $e->{label} or $in->ask_warn('', _("Empty label not allowed")), return 1; member($e->{label}, map { $_->{label} } grep { $_ != $e } @{$b->{entries}}) and $in->ask_warn('', _("This label is already used")), return 1; 0; } } }, \@l)) { $b->{default} = $old_default || $default ? $default && $e->{label} : $b->{default}; $e->{vga} = $bootloader::vga_modes{$e->{vga}} || $e->{vga}; require bootloader; bootloader::configure_entry($prefix, $e); #- hack to make sure initrd file are built. push @{$b->{entries}}, $e if $c eq "Add"; } else { @{$b->{entries}} = grep { $_ != $e } @{$b->{entries}}; } } 1; } sub partitions_suggestions { my ($in) = @_; my $t = $::expert ? $in->ask_from_list_('', _("What type of partitioning?"), [ keys %fsedit::suggestions ]) : 'simple'; $fsedit::suggestions{$t}; } my @etc_pass_fields = qw(name pw uid gid realname home shell); sub unpack_passwd { my ($l) = @_; chomp $l; my %l; @l{@etc_pass_fields} = split ':', $l; \%l; } sub pack_passwd { my ($l) = @_; join(':', @$l{@etc_pass_fields}) . "\n"; } sub get_autologin { my ($prefix, $o) = @_; my %l = getVarsFromSh("$prefix/etc/sysconfig/autologin"); $o->{autologin} ||= $l{USER}; %l = getVarsFromSh("$prefix/etc/sysconfig/desktop"); $o->{desktop} ||= $l{DESKTOP}; } sub set_autologin { my ($prefix, $user, $desktop) = @_; output "$prefix/etc/sysconfig/desktop", uc($desktop), "\n" if $user; setVarsInSh("$prefix/etc/sysconfig/autologin", { USER => $user, AUTOLOGIN => bool2yesno($user), EXEC => "/usr/X11R6/bin/startx" }); log::l("cat $prefix/etc/sysconfig/autologin: ", cat_("$prefix/etc/sysconfig/autologin")); } sub rotate_log { my ($f) = @_; if (-e $f) { my $i = 1; for (; -e "$f$i" || -e "$f$i.gz"; $i++) {} rename $f, "$f$i"; } } sub rotate_logs { my ($prefix) = @_; rotate_log("$prefix/root/$_") foreach qw(ddebug.log install.log); } sub writeandclean_ldsoconf { my ($prefix) = @_; my $file = "$prefix/etc/ld.so.conf"; output $file, grep { !m|^(/usr)?/lib$| } #- no need to have /lib and /usr/lib in ld.so.conf uniq cat_($file), "/usr/X11R6/lib\n"; } sub shells { my ($prefix) = @_; grep { -x "$prefix$_" } map { chomp; $_ } cat_("$prefix/etc/shells"); } sub inspect { my ($part, $prefix, $rw) = @_; isMountableRW($part) or return; my $dir = "/tmp/inspect_tmp_dir"; if ($part->{isMounted}) { $dir = ($prefix || '') . $part->{mntpoint}; } elsif ($part->{notFormatted} && !$part->{isFormatted}) { $dir = ''; } else { mkdir $dir, 0700; eval { fs::mount($part->{device}, $dir, type2fs($part->{type}), !$rw) }; $@ and return; } my $h = before_leaving { if (!$part->{isMounted} && $dir) { fs::umount($dir); unlink($dir) } }; $h->{dir} = $dir; $h; } #-----modem conf sub pppConfig { my ($in, $modem, $prefix, $install) = @_; $modem or return; symlinkf($modem->{device}, "$prefix/dev/modem") or log::l("creation of $prefix/dev/modem failed"); $install->(qw(ppp)) unless $::testing; my %toreplace; $toreplace{$_} = $modem->{$_} foreach qw(connection phone login passwd auth domain dns1 dns2); $toreplace{kpppauth} = ${{ 'Script-based' => 0, 'PAP' => 1, 'Terminal-based' => 2, }}{$modem->{auth}}; $toreplace{phone} =~ s/\D//g; $toreplace{dnsserver} = join ',', map { $modem->{$_} } "dns1", "dns2"; $toreplace{dnsserver} .= $toreplace{dnsserver} && ','; #- using peerdns or dns1,dns2 avoid writing a /etc/resolv.conf file. $toreplace{peerdns} = "yes"; $toreplace{connection} ||= 'DialupConnection'; $toreplace{domain} ||= 'localdomain'; $toreplace{intf} ||= 'ppp0'; $toreplace{papname} = $modem->{auth} eq 'PAP' && $toreplace{login}; #- build ifcfg-ppp0. my $ifcfg = "$prefix/etc/sysconfig/network-scripts/ifcfg-ppp0"; local *IFCFG; open IFCFG, ">$ifcfg" or die "Can't open $ifcfg"; print IFCFG <$chat" or die "Can't open $chat"; print CHAT <{special_command}) { print CHAT <{special_command}' END } print CHAT <{auth} eq 'Terminal-based' || $modem->{auth} eq 'Script-based') { print CHAT <{auth} eq 'PAP') { #- need to create a secrets file for the connection. my $secrets = "$prefix/etc/ppp/" . lc($modem->{auth}) . "-secrets"; my @l = cat_($secrets); my $replaced = 0; do { $replaced ||= 1 if s/^\s*"?$toreplace{login}"?\s+ppp0\s+(\S+)/"$toreplace{login}" ppp0 "$toreplace{passwd}"/; } foreach @l; if ($replaced) { local *F; open F, ">$secrets" or die "Can't open $secrets: $!"; print F @l; } else { local *F; open F, ">>$secrets" or die "Can't open $secrets: $!"; print F "$toreplace{login} ppp0 \"$toreplace{passwd}\"\n"; } #- restore access right to secrets file, just in case. chmod 0600, $secrets; } #- install kppprc file according to used configuration. commands::mkdir_("-p", "$prefix/usr/share/config"); local *KPPPRC; open KPPPRC, ">$prefix/usr/share/config/kppprc" or die "Can't open $prefix/usr/share/config/kppprc: $!"; #chmod 0600, "$prefix/usr/share/config/kppprc"; print KPPPRC <{miscellaneous}, qw(http_proxy ftp_proxy)); setVarsInCsh("$prefix/etc/profile.d/proxy.csh", $::o->{miscellaneous}, qw(http_proxy ftp_proxy)); } sub setup_thiskind { my ($in, $type, $auto, $at_least_one) = @_; return if arch() eq "ppc"; my @l = setup_thiskind_backend ($type, $auto, $at_least_one, sub { my $w = wait_load_module($in, $type, @_) } ); if (!$::noauto) { if (my @err = grep { $_ } map { $_->{error} } @l) { $in->ask_warn('', join("\n", @err)); } return @l if $auto && (@l || !$at_least_one); } @l = map { $_->{description} } @l; while (1) { (my $msg_type = $type) =~ s/\|.*//; my $msg = @l ? [ _("Found %s %s interfaces", join(", ", @l), $msg_type), _("Do you have another one?") ] : _("Do you have any %s interfaces?", $msg_type); my $opt = [ __("Yes"), __("No") ]; push @$opt, __("See hardware info") if $::expert; my $r = "Yes"; $r = $in->ask_from_list_('', $msg, $opt, "No") || die 'already displayed' unless $at_least_one && @l == 0; if ($r eq "No") { return @l } if ($r eq "Yes") { push @l, load_module($in, $type) || next; } else { $in->ask_warn('', [ detect_devices::stringlist() ]); } } } # setup_thiskind_backend : setup the kind of hardware # input : # $type : typeof hardware to setup # $auto : automatic behaviour # $at_least_one : # output: # @l : list of loaded sub setup_thiskind_backend { my ($type, $auto, $at_least_one, $wait_function) = @_; #- for example $wait_function=sub { $w = wait_load_module($in, $type, @_) } my @l; if (!$::noauto) { @l = modules::load_thiskind($type, $wait_function ); return @l;# sorry to be a sucker, pixel... :) } } sub wait_load_module { my ($in, $type, $text, $module) = @_; #-PO: the first %s is the card type (scsi, network, sound,...) #-PO: the second is the vendor+model name $in->wait_message('', [ _("Installing driver for %s card %s", $type, $text), if_($::expert, _("(module %s)", $module)) ]); } sub load_module { my ($in, $type) = @_; my @options; (my $msg_type = $type) =~ s/\|.*//; my $m = $in->ask_from_listf('', #-PO: the %s is the driver type (scsi, network, sound,...) _("Which %s driver should I try?", $msg_type), \&modules::module2text, [ modules::module_of_type($type) ]) or return; my $l = modules::module2text($m); require modparm; my @names = modparm::get_options_name($m); if ((@names != 0) && $in->ask_from_list_('', _("In some cases, the %s driver needs to have extra information to work properly, although it normally works fine without. Would you like to specify extra options for it or allow the driver to probe your machine for the information it needs? Occasionally, probing will hang a computer, but it should not cause any damage.", $l), [ __("Autoprobe"), __("Specify options") ], "Autoprobe") ne "Autoprobe") { ASK: if (@names >= 0) { my @l = $in->ask_from_entries('', _("You may now provide its options to module %s.", $l), \@names) or return; @options = modparm::get_options_result($m, @l); } else { @options = split ' ', $in->ask_from_entry('', _("You may now provide its options to module %s. Options are in format ``name=value name2=value2 ...''. For instance, ``io=0x300 irq=7''", $l), _("Module options:"), ); } } eval { my $w = wait_load_module($in, $type, $l, $m); modules::load($m, $type, @options); }; if ($@) { $in->ask_yesorno('', _("Loading module %s failed. Do you want to try again with other parameters?", $l), 1) or return; goto ASK; } $l; } sub ask_users { my ($prefix, $in, $users, $security) = @_; my $u if 0; $u ||= {}; my @shells = map { chomp; $_ } cat_("$prefix/etc/shells"); while (1) { $u->{password2} ||= $u->{password} ||= ''; $u->{shell} ||= '/bin/bash'; my $names = @$users ? _("(already added %s)", join(", ", map { $_->{realname} || $_->{name} } @$users)) : ''; $in->ask_from_entries_refH_powered( { title => _("Add user"), messages => _("Enter a user\n%s", $names), ok => _("Accept user"), cancel => $security < 4 || @$users ? _("Done") : '', callbacks => { focus_out => sub { if ($_[0] eq 0) { $u->{name} ||= lc first($u->{realname} =~ /((\w|-)+)/); } }, complete => sub { $u->{password} eq $u->{password2} or $in->ask_warn('', [ _("The passwords do not match"), _("Please try again") ]), return (1,2); $security > 3 && length($u->{password}) < 6 and $in->ask_warn('', _("This password is too simple")), return (1,2); $u->{name} or $in->ask_warn('', _("Please give a user name")), return (1,0); $u->{name} =~ /^[a-z0-9_-]+$/ or $in->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0); member($u->{name}, map { $_->{name} } @$users) and $in->ask_warn('', _("This user name is already added")), return (1,0); return 0; }, } }, [ { label => _("Real name"), val => \$u->{realname} }, { label => _("User name"), val => \$u->{name} }, { label => _("Password"),val => \$u->{password}, hidden => 1 }, { label => _("Password (again)"), val => \$u->{password2}, hidden => 1 }, { label => _("Shell"), val => \$u->{shell}, list => [ shells($prefix) ], not_edit => !$::expert, advanced => 1 }, if_($security <= 3, { label => _("Icon"), val => \$u->{icon}, list => [ facesnames($prefix) ], icon2f => sub { face2png($_[0], $prefix) }, format => \&translate }, ), ], ) or return; push @$users, $u; $u = {}; } } sub autologin { my ($prefix, $o, $in, $install) = @_; my $cmd = $prefix ? "chroot $prefix" : ""; my @wm = (split (' ', `$cmd /usr/sbin/chksession -l`)); my @users; if (@wm && @users && !$o->{authentication}{NIS} && $ENV{SECURE_LEVEL} <= 3) { $in->ask_from_entries_refH(_("Autologin"), _("I can set up your computer to automatically log on one user. If you don't want to use this feature, click on the cancel button."), [ { label => _("Choose the default user:"), val => \$o->{autologin}, list => [ '', @users ] }, { label => _("Choose the window manager to run:"), val => \$o->{desktop}, list => \@wm }, ]) or delete $o->{autologin}; } } sub write_passwd_user { my ($prefix, $u, $isMD5) = @_; local $u->{pw} ||= $u->{password} && &crypt($u->{password}, $isMD5); $u->{shell} ||= '/bin/bash'; substInFile { my $l = unpack_passwd($_); if ($l->{name} eq $u->{name}) { add2hash_($u, $l); $_ = pack_passwd($u); $u = {}; } if (eof && $u->{name}) { $_ .= pack_passwd($u); } } "$prefix/etc/passwd"; } 1; n521' href='#n521'>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 
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 ],
 "jp" => [ N_("Japanese 106 keys"), "jp106",        "jp",    1 ],
 "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",            "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, @keymaps) = unpack "I i" . c::MAX_NR_KEYMAPS() . "a*", $keymap;
    $keymap = pop @keymaps;

    $magic != $KMAP_MAGIC and die "failed to read kmap magic";

    sysopen(my $F, "/dev/console", 2) or die "failed to open /dev/console: $!";

    my $count = 0;
    foreach (0 .. c::MAX_NR_KEYMAPS() - 1) {
	$keymaps[$_] or next;

	my @keymap = unpack "s" . c::NR_KEYS() . "a*", $keymap;
	$keymap = pop @keymap;

	my $key = -1;
	foreach my $value (@keymap) {
	    $key++;
	    c::KTYP($value) != c::KT_SPEC() or next;
	    ioctl($F, c::KDSKBENT(), pack("CCS", $_, $key, $value)) or die "keymap ioctl failed ($_ $key $value): $!";
	 }
	$count++;
    }
    #- log::l("loaded $count keymap tables");
}

sub keyboard2full_xkb {
    my ($keyboard) = @_;

    my $XkbLayout = keyboard2xkb($keyboard);

    my $XkbModel = 
      arch() =~ /sparc/ ? 'sun' :
	$XkbLayout eq 'jp' ? 'jp106' : 
	$XkbLayout eq 'br' ? 'abnt2' : 'pc105';

    $XkbLayout ? {
	XkbLayout => join(',', if_($keyboard->{GRP_TOGGLE}, 'us'), $XkbLayout),
	XkbModel => $XkbModel,
	XkbOptions => $keyboard->{GRP_TOGGLE} ? 
		  join(',', 
		       if_($keyboard->{GRP_TOGGLE} eq 'rwin_toggle', 'compose:rwin'), 
		       "grp:$keyboard->{GRP_TOGGLE}", 
		       'grp_led:scroll') : '',
    } : { XkbDisable => '' };
}

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 $F;
	if (my $pid = open $F, "-|") {
	    local $/ = undef;
	    eval { load(join('', <$F>)) };
	    waitpid $pid, 0;
	} else {
	    eval {
		require packdrake;
		my $packer = new packdrake("$ENV{SHARE_PATH}/keymaps.cz2", quiet => 1);
		$packer->extract_archive(undef, "$kmap.bkmap");
	    };
	    c::_exit(0);
	}
    }
    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;
generated by cgit v1.2.1 (git 2.21.0) at 2025-03-03 11:54:37 +0000