package install_any; # $Id$ use diagnostics; use strict; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @needToCopy @needToCopyIfRequiresSatisfied $boot_medium @advertising_images); @ISA = qw(Exporter); %EXPORT_TAGS = ( all => [ qw(getNextStep spawnShell addToBeDone) ], ); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; #-###################################################################################### #- misc imports #-###################################################################################### use MDK::Common::System; use common; use run_program; use partition_table qw(:types); use partition_table_raw; use devices; use fsedit; use modules; use detect_devices; use lang; use any; use log; use fs; #- package that have to be copied for proper installation (just to avoid changing cdrom) #- here XFree86 is copied entirey if not already installed, maybe better to copy only server. @needToCopy = qw( XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach64 XFree86-Mach8 XFree86-Mono XFree86-P9000 XFree86-S3 XFree86-S3V XFree86-SVGA XFree86-W32 XFree86-I128 XFree86-Sun XFree86-SunMono XFree86-Sun24 XFree86-3DLabs XFree86-FBDev XFree86-server XFree86 XFree86-glide-module Device3Dfx Glide_V3-DRI Glide_V5 Mesa dhcpcd pump dhcpxd dhcp-client isdn4net isdn4k-utils dev pptp-adsl-fr rp-pppoe ppp ypbind rhs-printfilters lpr cups cups-drivers samba ncpfs ghostscript-utils autologin ); #- package that have to be copied only if all their requires are satisfied. @needToCopyIfRequiresSatisfied = qw( Mesa-common xpp libqtcups2 qtcups kups ); #- boot medium (the first medium to take into account). $boot_medium = 1; #-###################################################################################### #- Media change variables&functions #-###################################################################################### my $postinstall_rpms = ''; my $current_medium = $boot_medium; my $asked_medium = $boot_medium; my $cdrom = undef; sub useMedium($) { #- before ejecting the first CD, there are some files to copy! #- does nothing if the function has already been called. $_[0] > 1 and $::o->{method} eq 'cdrom' and setup_postinstall_rpms($::o->{prefix}, $::o->{packages}); $asked_medium eq $_[0] or log::l("selecting new medium '$_[0]'"); $asked_medium = $_[0]; } sub changeMedium($$) { my ($method, $medium) = @_; log::l("change to medium $medium for method $method (refused by default)"); 0; } sub relGetFile($) { local $_ = $_[0]; m|\.rpm$| ? "$::o->{packages}{mediums}{$asked_medium}{rpmsdir}/$_" : $_; } sub askChangeMedium($$) { my ($method, $medium) = @_; my $allow; do { eval { $allow = changeMedium($method, $medium) }; } while ($@); #- really it is not allowed to die in changeMedium!!! or install will cores with rpmlib!!! $allow; } sub errorOpeningFile($) { my ($file) = @_; $file eq 'XXX' and return; #- special case to force closing file after rpmlib transaction. $current_medium eq $asked_medium and log::l("errorOpeningFile $file"), return; #- nothing to do in such case. $::o->{packages}{mediums}{$asked_medium}{selected} or return; #- not selected means no need for worying about. my $max = 32; #- always refuse after $max tries. if ($::o->{method} eq "cdrom") { cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), and $cdrom = $1; return unless $cdrom; ejectCdrom($cdrom); while ($max > 0 && askChangeMedium($::o->{method}, $asked_medium)) { $current_medium = $asked_medium; eval { fs::mount($cdrom, "/tmp/image", "iso9660", 'readonly') }; my $getFile = getFile($file); $getFile && @advertising_images and copy_advertising($::o); $getFile and return $getFile; $current_medium = 'unknown'; #- don't know what CD is inserted now. ejectCdrom($cdrom); --$max; } } else { while ($max > 0 && askChangeMedium($::o->{method}, $asked_medium)) { $current_medium = $asked_medium; my $getFile = getFile($file); $getFile and return $getFile; $current_medium = 'unknown'; #- don't know what CD image has been copied. --$max; } } #- keep in mind the asked medium has been refused on this way. #- this means it is no more selected. $::o->{packages}{mediums}{$asked_medium}{selected} = undef; #- on cancel, we can expect the current medium to be undefined too, #- this enable remounting if selecting a package back. $current_medium = 'unknown'; return; } sub getFile { my ($f, $method) = @_; log::l("getFile $f:$method"); my $rel = relGetFile($f); do { if ($method =~ /crypto/i) { require crypto; crypto::getFile($f); } elsif ($::o->{method} eq "ftp") { require ftp; ftp::getFile($rel); } elsif ($::o->{method} eq "http") { require http; http::getFile($rel); } else { #- try to open the file, but examine if it is present in the repository, this allow #- handling changing a media when some of the file on the first CD has been copied #- to other to avoid media change... my $f2 = "$postinstall_rpms/$f"; $f2 = "/tmp/image/$rel" unless $postinstall_rpms && -e $f2; open GETFILE, $f2 and *GETFILE; } } || errorOpeningFile($f); } sub getAndSaveFile { my ($file, $local) = @_ == 1 ? ("Mandrake/mdkinst$_[0]", $_[0]) : @_; local *F; open F, ">$local" or return; local $/ = \ (16 * 1024); my $f = ref($file) ? $file : getFile($file) or return; local $_; while (<$f>) { syswrite F, $_ } 1; } #-###################################################################################### #- Post installation RPMS from cdrom only, functions #-###################################################################################### sub setup_postinstall_rpms($$) { my ($prefix, $packages) = @_; $postinstall_rpms and return; $postinstall_rpms = "$prefix/usr/postinstall-rpm"; require pkgs; require commands; log::l("postinstall rpms directory set to $postinstall_rpms"); clean_postinstall_rpms(); #- make sure in case of previous upgrade problem. commands::mkdir_('-p', $postinstall_rpms); #- compute closure of unselected package that may be copied, #- don't complain if package does not exists as it may happen #- for the various architecture taken into account (X servers). my %toCopy; foreach (@needToCopy) { my $pkg = pkgs::packageByName($packages, $_); pkgs::selectPackage($packages, $pkg, 0, \%toCopy) if $pkg; } @toCopy{@needToCopyIfRequiresSatisfied} = (); my @toCopy = map { pkgs::packageByName($packages, $_) } keys %toCopy; #- extract headers of package, this is necessary for getting #- the complete filename of each package. #- copy the package files in the postinstall RPMS directory. #- last arg is default medium '' known as the CD#1. pkgs::extractHeaders($prefix, \@toCopy, $packages->{mediums}{1}); commands::cp((map { "/tmp/image/" . relGetFile(pkgs::packageFile($_)) } @toCopy), $postinstall_rpms); } sub clean_postinstall_rpms() { require commands; $postinstall_rpms and -d $postinstall_rpms and commands::rm('-rf', $postinstall_rpms); } #-###################################################################################### #- Specific Hardware to take into account and associated rpms to install #-###################################################################################### sub allowNVIDIA_rpms { my ($packages) = @_; require pkgs; if (pkgs::packageByName($packages, "NVIDIA_GLX")) { #- at this point, we can allow using NVIDIA 3D acceleration packages. my @rpms; foreach (qw(kernel kernel-smp kernel-entreprise kernel22 kernel22-smp kernel22-secure)) { my $p = pkgs::packageByName($packages, $_); pkgs::packageSelectedOrInstalled($p) or next; my $name = "NVIDIA_kernel-" . pkgs::packageVersion($p) . "-" . pkgs::packageRelease($p) . (/(-.*)/ && $1); pkgs::packageByName($packages, $name) or return; push @rpms, $name; } @rpms > 0 or return; return [ @rpms, "NVIDIA_GLX" ]; } } #-###################################################################################### #- Functions #-###################################################################################### sub kernelVersion { my ($o) = @_; require pkgs; my $p = pkgs::packageByName($o->{packages}, "kernel"); $p ||= pkgs::packageByName($o->{packages}, "kernel22"); $p or die "I couldn't find the kernel package!"; pkgs::packageVersion($p) . "-" . pkgs::packageRelease($p); } sub getNextStep { my ($s) = $::o->{steps}{first}; $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done} || !$::o->{steps}{$s}{reachable}; $s; } sub spawnShell { return if $::o->{localInstall} || $::testing; -x "/bin/sh" or die "cannot open shell - /bin/sh doesn't exist"; fork and return; $ENV{DISPLAY} ||= ":0"; #- why not :pp local *F; sysopen F, "/dev/tty2", 2 or die "cannot open /dev/tty2 -- no shell will be provided"; open STDIN, "<&F" or die ''; open STDOUT, ">&F" or die ''; open STDERR, ">&F" or die ''; close F; print any::drakx_version(), "\n"; c::setsid(); ioctl(STDIN, c::TIOCSCTTY(), 0) or warn "could not set new controlling tty: $!"; my $busybox = "/usr/bin/busybox"; exec {-e $busybox ? $busybox : "/bin/sh"} "/bin/sh" or log::l("exec of /bin/sh failed: $!"); } sub fsck_option { my ($o) = @_; my $y = $o->{security} < 3 && !$::expert && "-y "; substInFile { s/^(\s*fsckoptions="?)(-y )?/$1$y/ } "$o->{prefix}/etc/rc.d/rc.sysinit"; #- " help po, DONT REMOVE } sub getAvailableSpace { my ($o) = @_; #- make sure of this place to be available for installation, this could help a lot. #- currently doing a very small install use 36Mb of postinstall-rpm, but installing #- these packages may eat up to 90Mb (of course not all the server may be installed!). #- 65mb may be a good choice to avoid almost all problem of insuficient space left... my $minAvailableSize = 65 * sqr(1024); my $n = !$::testing && getAvailableSpace_mounted($o->{prefix}) || getAvailableSpace_raw($o->{fstab}) * 512 / 1.07; $n - max(0.1 * $n, $minAvailableSize); } sub getAvailableSpace_mounted { my ($prefix) = @_; my $dir = -d "$prefix/usr" ? "$prefix/usr" : "$prefix"; my (undef, $free) = MDK::Common::System::df($dir) or return; log::l("getAvailableSpace_mounted $free KB"); $free * 1024 || 1; } sub getAvailableSpace_raw { my ($fstab) = @_; do { $_->{mntpoint} eq '/usr' and return $_->{size} } foreach @$fstab; do { $_->{mntpoint} eq '/' and return $_->{size} } foreach @$fstab; if ($::testing) { my $nb = 450; log::l("taking ${nb}MB for testing"); return $nb << 11; } die "missing root partition"; } sub preConfigureTimezone { my ($o) = @_; require timezone; #- can't be done in install cuz' timeconfig %post creates funny things add2hash($o->{timezone}, { timezone::read($o->{prefix}) }) if $o->{isUpgrade}; $o->{timezone}{timezone} ||= timezone::bestTimezone(lang::lang2text($o->{lang})); my $utc = $::expert && !grep { isFat($_) || isNT($_) } @{$o->{fstab}}; my $ntp = timezone::ntp_server($o->{prefix}); add2hash_($o->{timezone}, { UTC => $utc, ntp => $ntp }); } sub setPackages { my ($o) = @_; require pkgs; if (!$o->{packages} || is_empty_hash_ref($o->{packages}{names})) { $o->{packages} = pkgs::psUsingHdlists($o->{prefix}, $o->{method}); push @{$o->{default_packages}}, "nfs-utils-clients" if $o->{method} eq "nfs"; push @{$o->{default_packages}}, "numlock" if $o->{miscellaneous}{numlock}; push @{$o->{default_packages}}, "kernel-enterprise" if (availableRamMB() > 800) && (arch() !~ /ia64/); push @{$o->{default_packages}}, "kernel22" if c::kernel_version() =~ /^\Q2.2/; push @{$o->{default_packages}}, "kernel22-secure" if $o->{security} > 3; push @{$o->{default_packages}}, "kernel-smp" if detect_devices::hasSMP(); push @{$o->{default_packages}}, "kernel-pcmcia-cs" if $o->{pcmcia}; push @{$o->{default_packages}}, "raidtools" if $o->{raid} && !is_empty_array_ref($o->{raid}{raid}); push @{$o->{default_packages}}, "lvm" if -e '/etc/lvmtab'; push @{$o->{default_packages}}, "usbd" if modules::get_alias("usb-interface"); push @{$o->{default_packages}}, "reiserfsprogs" if grep { isReiserfs($_) } @{$o->{fstab}}; push @{$o->{default_packages}}, "xfsprogs" if grep { isXfs($_) } @{$o->{fstab}}; push @{$o->{default_packages}}, "alsa", "alsa-utils" if modules::get_alias("sound-slot-0") =~ /^snd-card-/; push @{$o->{default_packages}}, "imwheel" if $o->{mouse}{nbuttons} > 3; pkgs::getDeps($o->{prefix}, $o->{packages}); pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'basesystem') || die("missing basesystem package"), 1); #- must be done after selecting base packages (to save memory) pkgs::getProvides($o->{packages}); #- must be done after getProvides pkgs::read_rpmsrate($o->{packages}, getFile("Mandrake/base/rpmsrate")); ($o->{compssUsers}, $o->{compssUsersSorted}) = pkgs::readCompssUsers($o->{meta_class}); if ($::auto_install && !$o->{compssUsersChoice}) { $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}{flags}} } @{$o->{compssUsersSorted}}; } if (!$::auto_install && !$o->{isUpgrade}) { #- by default, choose: $o->{compssUsersChoice}{$_} = 1 foreach 'GNOME', 'KDE', 'CONFIG'; $o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}{flags}} } 'Workstation|Office Workstation', 'Workstation|Internet station'; } $o->{compssUsersChoice}{uc($_)} = 1 foreach grep { modules::get_that_type($_) } ('tv', 'scanner', 'photo', 'sound'); $o->{compssUsersChoice}{uc($_)} = 1 foreach map { $_->{driver} =~ /Flag:(.*)/ } detect_devices::probeall(); $o->{compssUsersChoice}{SYSTEM} = 1; $o->{compssUsersChoice}{BURNER} = 1 if detect_devices::burners(); $o->{compssUsersChoice}{DVD} = 1 if detect_devices::dvdroms(); $o->{compssUsersChoice}{PCMCIA} = 1 if detect_devices::hasPCMCIA(); $o->{compssUsersChoice}{'3D'} = 1 if detect_devices::matching_desc('Matrox.* G[24][05]0') || detect_devices::matching_desc('Riva.*128') || detect_devices::matching_desc('Rage X[CL]') || detect_devices::matching_desc('Rage Mobility (?:P\/M|L) ') || detect_devices::matching_desc('3D Rage (?:LT|Pro)') || detect_devices::matching_desc('Voodoo [35]') || detect_devices::matching_desc('Voodoo Banshee') || detect_devices::matching_desc('8281[05].* CGC') || detect_devices::matching_desc('Rage 128') || detect_devices::matching_desc('[nN]Vidia.*T[nN]T2') || #- TNT2 cards detect_devices::matching_desc('[nN]Vidia.*NV[56]') || detect_devices::matching_desc('[nN]Vidia.*Vanta') || detect_devices::matching_desc('[nN]Vidia.*GeForce') || #- GeForce cards detect_devices::matching_desc('[nN]Vidia.*NV1[15]') || detect_devices::matching_desc('[nN]Vidia.*Quadro'); foreach (map { substr($_, 0, 2) } lang::langs($o->{langs})) { pkgs::packageByName($o->{packages}, "locales-$_") or next; push @{$o->{default_packages}}, "locales-$_"; } foreach (lang::langsLANGUAGE($o->{langs})) { $o->{compssUsersChoice}{qq(LOCALES"$_")} = 1; } } else { #- this has to be done to make sure necessary files for urpmi are #- present. pkgs::psUpdateHdlistsDeps($o->{prefix}, $o->{method}); } } sub unselectMostPackages { my ($o) = @_; pkgs::unselectAllPackages($o->{packages}); pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_) || next) foreach @{$o->{default_packages}}; } sub warnAboutNaughtyServers { my ($o) = @_; my @naughtyServers = pkgs::naughtyServers($o->{packages}) or return 1; if (!$o->ask_yesorno('', formatAlaTeX(_("You have selected the following server(s): %s These servers are activated by default. They don't have any known security issues, but some new could be found. In that case, you must make sure to upgrade as soon as possible. Do you really want to install these servers? ", join(", ", @naughtyServers))), 1)) { pkgs::unselectPackage($o->{packages}, pkgs::packageByName($o->{packages}, $_)) foreach @naughtyServers; } } sub addToBeDone(&$) { my ($f, $step) = @_; return &$f() if $::o->{steps}{$step}{done}; push @{$::o->{steps}{$step}{toBeDone}}, $f; } sub setAuthentication { my ($o) = @_; my ($shadow, $md5, $ldap, $nis) = @{$o->{authentication} || {}}{qw(shadow md5 LDAP NIS)}; my $p = $o->{prefix}; #- obsoleted always enabled (in /etc/pam.d/system-auth furthermore) #any::enableMD5Shadow($p, $shadow, $md5); any::enableShadow($p) if $shadow; if ($ldap) { $o->pkg_install(qw(chkauth openldap-clients nss_ldap pam_ldap)); run_program::rooted($o->{prefix}, "/usr/sbin/chkauth", "ldap", "-D", $o->{netc}{LDAPDOMAIN}, "-s", $ldap); } elsif ($nis) { #$o->pkg_install(qw(chkauth ypbind yp-tools net-tools)); #run_program::rooted($o->{prefix}, "/usr/sbin/chkauth", "yp", $domain, "-s", $nis); $o->pkg_install("ypbind"); my $domain = $o->{netc}{NISDOMAIN}; $domain || $nis ne "broadcast" or die _("Can't use broadcast with no NIS domain"); my $t = $domain ? "domain $domain" . ($nis ne "broadcast" && " server") : "ypserver"; substInFile { $_ = "#~$_" unless /^#/; $_ .= "$t $nis\n" if eof; } "$p/etc/yp.conf"; require network; network::write_conf("$p/etc/sysconfig/network", $o->{netc}); } } sub killCardServices { my $pid = chomp_(cat_("/tmp/cardmgr.pid")); $pid and kill(15, $pid); #- send SIGTERM } sub hdInstallPath() { cat_("/proc/mounts") =~ m|/\w+/(\S+)\s+/tmp/hdimage| or return; my ($part) = grep { $_->{device} eq $1 } @{$::o->{fstab}}; $part->{mntpoint} or grep { $_->{mntpoint} eq "/mnt/hd" } @{$::o->{fstab}} and return; $part->{mntpoint} ||= "/mnt/hd"; $part->{mntpoint} . first(readlink("/tmp/image") =~ m|^/tmp/hdimage/(.*)|); } sub unlockCdrom(;$) { my ($cdrom) = @_; $cdrom or cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), and $cdrom = $1; eval { $cdrom and ioctl detect_devices::tryOpen($1), c::CDROM_LOCKDOOR(), 0 }; } sub ejectCdrom(;$) { my ($cdrom) = @_; $cdrom or cat_("/proc/mounts") =~ m,(/(?:dev|tmp)/\S+)\s+(?:/mnt/cdrom|/tmp/image), and $cdrom = $1; my $f = eval { $cdrom && detect_devices::tryOpen($cdrom) } or return; getFile("XXX"); #- close still opened filehandle eval { fs::umount("/tmp/image") }; ioctl $f, c::CDROMEJECT(), 1; } sub setupFB { my ($o, $vga) = @_; $vga ||= 785; #- assume at least 640x480x16. require bootloader; #- update bootloader entries with vga, all kernel are now framebuffer. foreach (qw(vmlinuz vmlinuz-secure vmlinuz-smp vmlinuz-hack)) { if (my $e = bootloader::get("/boot/$_", $o->{bootloader})) { $e->{vga} = $vga; } } bootloader::install($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}); 1; } sub install_urpmi { my ($prefix, $method, $mediums) = @_; my @cfg = map_index { my $name = $_->{fakemedium}; #- build synthesis file at install, this will improve performance greatly. run_program::rooted($prefix, "parsehdlist", ">", "/var/lib/urpmi/synthesis.hdlist.$name", "--compact", "--provides", "--requires", "/var/lib/urpmi/hdlist.$name.cz"); run_program::rooted($prefix, "gzip", "-S", ".cz", "/var/lib/urpmi/synthesis.hdlist.$name"); #- safe guard correct generation of synthesis file. -s "$prefix/var/lib/urpmi/synthesis.hdlist.$name.cz" > 24 or unlink "$prefix/var/lib/urpmi/synthesis.hdlist.$name.cz"; local *LIST; my $mask = umask 077; open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name"); umask $mask; my $dir = ${{ nfs => "file://mnt/nfs", hd => "file:/" . hdInstallPath(), ftp => $ENV{URLPREFIX}, http => $ENV{URLPREFIX}, cdrom => "removable_cdrom_$::i://mnt/cdrom" }}{$method} . "/$_->{rpmsdir}"; local *FILES; open FILES, "$ENV{LD_LOADER} parsehdlist /tmp/$_->{hdlist} |"; print LIST "$dir/$_\n" foreach chomp_(); close FILES or log::l("parsehdlist failed"), return; close LIST; $name =~ s/(\s)/\\$1/g; $dir =~ s/(\s)/\\$1/g; #- necessary to change protect white char, for urpmi >= 1.40 $dir .= " with ../base/$_->{hdlist}"; "$name $dir\n"; } values %$mediums; eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg }; } #-############################################################################### #- kde stuff #-############################################################################### sub kderc_largedisplay { my ($prefix) = @_; update_userkderc($_, 'KDE', Contrast => 7, kfmIconStyle => "Large", kpanelIconStyle => "Normal", #- to change to Large when icons looks better KDEIconStyle => "Large") foreach list_skels($prefix, '.kderc'); substInFile { s/^(GridWidth)=85/$1=100/; s/^(GridHeight)=70/$1=75/; } $_ foreach list_skels($prefix, '.kde/share/config/kfmrc'); } sub kdeicons_postinstall { my ($prefix) = @_; #- parse etc/fstab file to search for dos/win, floppy, zip, cdroms icons. #- handle both supermount and fsdev usage. my %l = ( 'cdrom' => [ 'cdrom', 'Cd-Rom' ], 'zip' => [ 'zip', 'Zip' ], 'floppy-ls' => [ 'floppy', 'LS-120' ], 'floppy' => [ 'floppy', 'Floppy' ], ); foreach (fs::read_fstab("$prefix/etc/fstab")) { my ($name_, $nb) = $_->{mntpoint} =~ m|.*/(\S+?)(\d*)$/|; my ($name, $text) = @{$l{$name_} || []}; my $f = ${{ supermount => sub { $name .= '.fsdev' if $name }, vfat => sub { $name = 'Dos_'; $text = $name_ }, }}{$_->{type}}; &$f if $f; template2userfile($prefix, "$ENV{SHARE_PATH}/$name.kdelnk.in", "Desktop/$text" . ($nb && " $nb"). ".kdelnk", 1, %$_) if $name; } # rename the .kdelnk to the name found in the .kdelnk as kde doesn't use it # for displaying foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) { foreach (grep { /\.kdelnk$/ } all($dir)) { cat_("$dir/$_") =~ /^Name\[\Q$ENV{LANG}\E\]=(.{2,14})$/m and rename "$dir/$_", "$dir/$1.kdelnk"; } } } sub kdemove_desktop_file { my ($prefix) = @_; my @toMove = qw(doc.kdelnk news.kdelnk updates.kdelnk home.kdelnk printer.kdelnk floppy.kdelnk cdrom.kdelnk FLOPPY.kdelnk CDROM.kdelnk); #- remove any existing save in Trash of each user and #- move appropriate file there after an upgrade. foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) { renamef("$dir/$_", "$dir/Trash/$_") foreach grep { -e "$dir/$_" } @toMove, grep { /\.rpmorig$/ } all($dir) } } #-############################################################################### #- auto_install stuff #-############################################################################### sub auto_inst_file() { ($::g_auto_install ? "/tmp" : "$::o->{prefix}/root") . "/auto_inst.cfg.pl" } sub report_bug { my ($prefix) = @_; any::report_bug($prefix, 'auto_inst' => g_auto_install()); } sub g_auto_install { my ($replay) = @_; my $o = {}; require pkgs; $o->{default_packages} = pkgs::selected_leaves($::o->{packages}); my @fields = qw(mntpoint type size); $o->{partitions} = [ map { my %l; @l{@fields} = @$_{@fields}; \%l } grep { $_->{mntpoint} } @{$::o->{fstab}} ]; exists $::o->{$_} and $o->{$_} = $::o->{$_} foreach qw(lang authentication printer mouse wacom netc timezone superuser intf keyboard users partitioning isUpgrade manualFstab nomouseprobe crypto security netcnx useSupermount autoExitInstall); #- TODO modules bootloader if (my $card = $::o->{X}{card}) { $o->{X}{$_} = $::o->{X}{$_} foreach qw(default_depth resolution_wanted); if ($o->{X}{default_depth} and my $depth = $card->{depth}{$o->{X}{default_depth}}) { $depth ||= []; $o->{X}{resolution_wanted} ||= join "x", @{$depth->[0]} unless is_empty_array_ref($depth->[0]); $o->{X}{monitor} = $::o->{X}{monitor} if $::o->{X}{monitor}{manual}; } } local $o->{partitioning}{auto_allocate} = !$replay; local $o->{autoExitInstall} = !$replay; #- deep copy because we're modifying it below $o->{users} = [ @{$o->{users} || []} ]; $_ = { %{$_ || {}} }, delete @$_{qw(oldu oldg password password2)} foreach $o->{superuser}, @{$o->{users} || []}; require Data::Dumper; my $str = join('', "#!/usr/bin/perl -cw # # You should check the syntax of this file before using it in an auto-install. # You can do this with 'perl -cw auto_inst.cfg.pl' or by executing this file # (note the '#!/usr/bin/perl -cw' on the first line). ", Data::Dumper->Dump([$o], ['$o']), if_($replay, qq(\npackage install_steps_auto_install;), q( $graphical = 1; push @graphical_steps, 'doPartitionDisks', 'choosePartitionsToFormat', 'formatMountPartitions'; )), "\0"); $str =~ s/ {8}/\t/g; #- replace all 8 space char by only one tabulation, this reduces file size so much :-) $str; } sub g_default_packages { my ($o, $quiet) = @_; my $floppy = detect_devices::floppy(); while (1) { $o->ask_okcancel('', _("Insert a FAT formatted floppy in drive %s", $floppy), 1) or return; eval { fs::mount(devices::make($floppy), "/floppy", "vfat", 0) }; last if !$@; $o->ask_warn('', _("This floppy is not FAT formatted")); } require Data::Dumper; my $str = Data::Dumper->Dump([ { default_packages => pkgs::selected_leaves($o->{packages}) } ], ['$o']); $str =~ s/ {8}/\t/g; output('/floppy/auto_inst.cfg', "# You should always check the syntax with 'perl -cw auto_inst.cfg.pl'\n", "# before testing. To use it, boot with ``linux defcfg=floppy''\n", $str, "\0"); fs::umount("/floppy"); $quiet or $o->ask_warn('', _("To use this saved packages selection, boot installation with ``linux defcfg=floppy''")); } sub loadO { my ($O, $f) = @_; $f ||= auto_inst_file; my $o; if ($f =~ /^(floppy|patch)$/) { my $f = $f eq "floppy" ? 'auto_inst.cfg' : "patch"; unless ($::testing) { fs::mount(devices::make(detect_devices::floppy()), "/mnt", (arch() =~ /sparc/ ? "romfs" : "vfat"), 'readonly'); $f = "/mnt/$f"; } -e $f or $f .= '.pl'; my $b = before_leaving { fs::umount("/mnt") unless $::testing; modules::unload($_) foreach qw(vfat fat); }; $o = loadO($O, $f); } else { -e "$f.pl" and $f .= ".pl" unless -e $f; my $fh = -e $f ? do { local *F; open F, $f; *F } : getFile($f) or die _("Error reading file $f"); { local $/ = "\0"; no strict; eval <$fh>; close $fh; $@ and die; } add2hash_($o ||= {}, $O); } bless $o, ref $O; } sub generate_automatic_stage1_params { my ($o) = @_; my @ks = (); if ($o->{method} =~ /hd/) { push @ks, "method:disk"; } else { push @ks, "method:" . $o->{method}; } if ($o->{method} =~ /http/) { "$ENV{URLPREFIX}" =~ m|http://(.*)/(.*)| or die; push @ks, "server:$1", "directory:$2"; } elsif ($o->{method} =~ /ftp/) { push @ks, "server:$ENV{HOST}", "directory:$ENV{PREFIX}", "user:$ENV{LOGIN}", "pass:$ENV{PASSWORD}"; } elsif ($o->{method} =~ /nfs/) { cat_("/proc/mounts") =~ m|(\S+):(\S+)\s+/tmp/image nfs| or die; push @ks, "server:$1", "directory:$2"; } my ($intf) = values %{$o->{intf}}; if ($intf->{BOOTPROTO} =~ /dhcp/) { push @ks, "network:dhcp"; } else { require network; push @ks, "network:static", "ip:$intf->{IPADDR}", "netmask:$intf->{NETMASK}", "gateway:$o->{netc}{GATEWAY}"; my @dnss = network::dnsServers($o->{netc}); push @ks, "dns:$dnss[0]" if @dnss; } "automatic=".join(',', @ks); } sub guess_mount_point { my ($part, $prefix, $user) = @_; my %l = ( '/' => 'etc/fstab', '/boot' => 'vmlinuz', '/tmp' => '.X11-unix', '/usr' => 'X11R6', '/var' => 'catman', ); my $handle = any::inspect($part, $prefix) or return; my $d = $handle->{dir}; my ($mnt) = grep { -e "$d/$l{$_}" } keys %l; $mnt ||= (stat("$d/.bashrc"))[4] ? '/root' : '/home/user' . ++$$user if -e "$d/.bashrc"; $mnt ||= (grep { -d $_ && (stat($_))[4] >= 500 && -e "$_/.bashrc" } glob_("$d")) ? '/home' : ''; ($mnt, $handle); } sub suggest_mount_points { my ($fstab, $prefix, $uniq) = @_; my $user; foreach my $part (grep { isTrueFS($_) } @$fstab) { $part->{mntpoint} && !$part->{unsafeMntpoint} and next; #- if already found via an fstab my ($mnt, $handle) = guess_mount_point($part, $prefix, \$user) or next; next if $uniq && fsedit::mntpoint2part($mnt, $fstab); $part->{mntpoint} = $mnt; delete $part->{unsafeMntpoint}; #- try to find other mount points via fstab fs::get_mntpoints_from_fstab($fstab, $handle->{dir}, $uniq) if $mnt eq '/'; } $_->{mntpoint} and log::l("suggest_mount_points: $_->{device} -> $_->{mntpoint}") foreach @$fstab; } #- mainly for finding the root partitions for upgrade sub find_root_parts { my ($fstab, $prefix) = @_; log::l("find_root_parts"); my $user; grep { my ($mnt) = guess_mount_point($_, $prefix, \$user); $mnt eq '/'; } @$fstab; } sub use_root_part { my ($fstab, $part, $prefix) = @_; { my $handle = any::inspect($part, $prefix) or die; fs::get_mntpoints_from_fstab($fstab, $handle->{dir}, 'uniq'); } map { $_->{mntpoint} = 'swap' } grep { isSwap($_) } @$fstab; #- use all available swap. } sub getHds { my ($o, $f_err) = @_; my $ok = 1; my $try_scsi = !$::expert; my $flags = $o->{partitioning}; my @drives = detect_devices::hds(); # add2hash_($o->{partitioning}, { readonly => 1 }) if partition_table_raw::typeOfMBR($drives[0]{device}) eq 'system_commander'; getHds: my ($hds, $lvms, $raids) = catch_cdie { fsedit::hds(\@drives, $flags) } sub { $ok = 0; my $err = $@; $err =~ s/ at (.*?)$//; log::l("error reading partition table: $err"); !$flags->{readonly} && $f_err and $f_err->($err); }; if (is_empty_array_ref($hds) && $try_scsi) { $try_scsi = 0; $o->setupSCSI; #- ask for an unautodetected scsi card goto getHds; } $::testing or partition_table_raw::test_for_bad_drives($_) foreach @$hds; $ok = fsedit::verifyHds($hds, $flags->{readonly}, $ok) unless $flags->{clearall} || $flags->{clear}; #- try to figure out if the same number of hds is available, use them if ok. $ok && $hds && @$hds > 0 && @{$o->{hds} || []} == @$hds and return $ok; $o->{hds} = $hds; $o->{lvms} = $lvms; $o->{raid}->{raid} = $raids; $o->{fstab} = [ fsedit::get_fstab(@$hds, @$lvms) ]; fs::check_mounted($o->{fstab}); fs::merge_fstabs($o->{fstab}, $o->{manualFstab}); my @win = grep { isFat($_) && isFat({ type => fsedit::typeOfPart($_->{device}) }) } @{$o->{fstab}}; log::l("win parts: ", join ",", map { $_->{device} } @win) if @win; if (@win == 1) { $win[0]{mntpoint} = "/mnt/windows"; } else { my %w; foreach (@win) { my $v = $w{$_->{device_windobe}}++; $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/win_" . lc($_->{device_windobe}) . ($v ? $v+1 : ''); #- lc cuz of StartOffice(!) cf dadou } } my @sunos = grep { isSunOS($_) && type2name($_->{type}) =~ /root/i } @{$o->{fstab}}; #- take only into account root partitions. if (@sunos) { my $v = ''; map { $_->{mntpoint} = $_->{unsafeMntpoint} = "/mnt/sunos" . ($v && ++$v) } @sunos; } #- a good job is to mount SunOS root partition, and to use mount point described here in /etc/vfstab. $ok; } sub log_sizes { my ($o) = @_; my @df = MDK::Common::System::df($o->{prefix}); log::l(sprintf "Installed: %s(df), %s(rpm)", formatXiB($df[0] - $df[1], 1024), formatXiB(sum(`$ENV{LD_LOADER} rpm --root $o->{prefix}/ -qa --queryformat "%{size}\n"`))) if -x "$o->{prefix}/bin/rpm"; } sub copy_advertising { my ($o) = @_; return if $::rootwidth < 800; my $f; my $source_dir = "Mandrake/share/advertising"; foreach ("." . $o->{lang}, "." . substr($o->{lang},0,2), '') { $f = getFile("$source_dir$_/list") or next; $source_dir = "$source_dir$_"; } if (my @files = <$f>) { my $dir = "$o->{prefix}/tmp/drakx-images"; mkdir $dir; unlink glob_("$dir/*"); foreach (@files) { chomp; getAndSaveFile("$source_dir/$_", "$dir/$_"); } @advertising_images = map { "$dir/$_" } @files; } } sub remove_advertising { my ($o) = @_; unlink @advertising_images; rmdir "$o->{prefix}/tmp/drakx-images"; @advertising_images = (); } sub disable_user_view { my ($prefix) = @_; substInFile { s/^UserView=.*/UserView=true/ } "$prefix/usr/share/config/kdmrc"; substInFile { s/^Browser=.*/Browser=0/ } "$prefix/etc/X11/gdm/gdm.conf"; } sub write_fstab { my ($o) = @_; fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount}, lang::fs_options($o->{lang})) if !$::live; } my @bigseldom_used_groups = ( [ qw(pvcreate pvdisplay vgchange vgcreate vgdisplay vgextend vgremove vgscan lvcreate lvdisplay lvremove /lib/liblvm.so) ], ); sub check_prog { my ($f) = @_; my @l = $f !~ m|^/| ? map { "$_/$f" } split(":", $ENV{PATH}) : $f; return if grep { -x $_ } @l; my ($f_) = map { m|^/| ? $_ : "/usr/bin/$_" } $f; remove_bigseldom_used(); foreach (@bigseldom_used_groups) { my (@l) = map { m|^/| ? $_ : "/usr/bin/$_" } @$_; if (member($f_, @l)) { foreach (@l) { getAndSaveFile($_); chmod 0755, $_; } return; } } getAndSaveFile($f_); chmod 0755, $f_; } sub remove_bigseldom_used { log::l("remove_bigseldom_used"); $::testing and return; unlink glob_("/usr/share/gtk/themes/$_*") foreach qw(DarkMarble marble3d); if (ref($::o) =~ /gtk/) { unlink glob_("/lib/lib$_*") foreach qw(slang newt); unlink "/usr/bin/perl-install/auto/Newt/Newt.so"; } else { unlink glob_("/usr/X11R6/bin/XF*"); } unlink(m|^/| ? $_ : "/usr/bin/$_") foreach ((map { @$_ } @bigseldom_used_groups), qw(mkreiserfs resize_reiserfs), ); } 1; >897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 
# vim: set et ts=4 sw=4:
package ManaTools::Shared::TimeZone;

#============================================================= -*-perl-*-

=head1 NAME

ManaTools::Shared::TimeZone - module to manage TimeZone settings

=head1 SYNOPSIS

    my $tz = ManaTools::Shared::TimeZone->new();


=head1 DESCRIPTION

This module allows to manage time zone settings.

=head1 SUPPORT

You can find documentation for this module with the perldoc command:

perldoc ManaTools::Shared::TimeZone


=head1 AUTHOR

Angelo Naselli <anaselli@linux.it>

=head1 COPYRIGHT and LICENSE

Copyright (C) 2014-2015, Angelo Naselli.

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License version 2, as
published by the Free Software Foundation.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

=head1 METHODS

=cut


use diagnostics;
use strict;

use Moose;
use English;
use Sys::Syslog;

use DateTime::TimeZone;
use Net::DBus;

use ManaTools::Shared::Locales;
use ManaTools::Shared::Services;

use MDK::Common::File qw(cat_ output_p substInFile);
use MDK::Common::Func qw(find if_);


#=============================================================

=head2 new - optional parameters

=head3 timezone_prefix

    optional parameter to set the system timezone directory,
    default value is /usr/share/zoneinfo

=cut

#=============================================================

has 'timezone_prefix' => (
    is => 'rw',
    isa => 'Str',
    default => "/usr/share/zoneinfo",
);


#=============================================================

=head2 new - optional parameters

=head3 ntp_configuration_file

    optional parameter to set the ntp server configuration file,
    it meant to be for testing purpose, do not set or it will
    be considered as configuration file despite of what the ntp
    service is.

=cut

#=============================================================

has 'ntp_configuration_file' => (
    is  => 'rw',
    isa => 'Str',
);


#=============================================================

=head2 new - optional parameters

=head3 ntp_conf_dir

    optional parameter to set ntp configuration directory,
    default value is /etc/ntp

=cut

#=============================================================

has 'ntp_conf_dir' => (
    is   => 'rw',
    isa  => 'Str',
    lazy => 1,
    default => "/etc/ntp",
);

#=============================================================

=head2 new - optional parameters

=head3 ntp_program

    optional parameter to set the ntp program that runs into the
    system, available value are chronyd, ntpd and systemd-timesyncd.

    Default value is evaluate by configuration file found in the
    system, fallback choice is systemd-timesyncd.

=cut

#=============================================================
has 'ntp_program' => (
    is      => 'rw',
    isa     => 'Str',
    lazy    => 1,
    builder => '_ntp_program_init',
);

sub _ntp_program_init {
    my $self = shift;

    # looks for a running service from the configured ones,
    # if none is running chooses the first of the list
    my $list = $self->ntpServiceList();
    return "" if !$list;

    my $ntpd = "";
    my $isRunning = 0;

    foreach (@{$list}) {
        $ntpd = $_;
        $isRunning = $self->sh_services->is_service_running($ntpd);
        last if $isRunning;
    }

    if (!$isRunning) {
        # being sure systemd-timesyncd is not really running (or set to be)
        if ($self->getEmbeddedNTP()) {
            $ntpd = "systemd-timesyncd";
            Sys::Syslog::syslog(
                'info|local1',
                $self->loc->N("%s enabled but stopped - disabling it",
                    $ntpd
                )
            );
            # enabled but stopped, disabling it
            # NOTE this happens tipically on VM if not well configured
            $self->setEmbeddedNTP(0);
        }
        else {
            # coosing the first one of the list that is not running
            $ntpd = $list->[0];
        }
    }

    return $ntpd;
}

#=============================================================

=head2 attribute

=head3 ntpServiceConfig

    This RO attribute is a HashRef containing managed ntp
    service as key and related configuration file.

    Allowed actions:
        getNTPServiceConfig => retrieves config file from the
                               given ntp service
        ntpServiceConfigPairs => Key,Value pairs access

=cut

#=============================================================
has 'ntpServiceConfig' => (
    traits    => ['Hash'],
    default   => sub { {
        'chronyd'           => '/etc/chrony.conf',
        'ntpd'              => '/etc/ntp.conf',
        'systemd-timesyncd' => '/etc/systemd/timesyncd.conf'
    } },
    is        => 'ro',
    isa       => 'HashRef',
    handles   => {
        getNTPServiceConfig   => 'get',
        ntpServiceConfigPairs => 'kv',
    },
    init_arg  => undef,
);

#=============================================================

=head2 attribute

=head3 ntpServiceList

    This attribute is a ArrayRef containing the sorted list of
    configured NTP service into the system, retrieving info from
    services.

=cut

#=============================================================
has 'ntpServiceList' => (
    is      => 'rw',
    isa     => 'ArrayRef',
    lazy    => 1,
    builder => '_build_ntpServiceList',
    init_arg  => undef,
);

# retrieves the installed ntp service list
sub _build_ntpServiceList {
    my $self = shift();

    my @list = ();
    for my $pair ($self->ntpServiceConfigPairs()) {
        push @list, $pair->[0] if eval {$self->sh_services->dbus_systemd1_object->GetUnitFileState( $pair->[0] . ".service")};
    }

    return [ sort(@list) ];
}

#=============================================================

=head2 new - optional parameters

=head3 installer_or_livecd

    To inform the back-end that is working during installer or
    livecd. Useful if Time zone setting and using fix_system
    to use the real time clock (see setLocalRTC and
    writeConfiguration).

=cut

#=============================================================
has 'installer_or_livecd' => (
    is  => 'rw',
    isa => 'Bool',
    default => 0,
);

#=== globals ===

has 'sh_services' => (
        is => 'rw',
        init_arg => undef,
        lazy     => 1,
        builder => '_SharedServicesInitialize'
);

sub _SharedServicesInitialize {
    my $self = shift();

    $self->sh_services(ManaTools::Shared::Services->new(include_static_services => 1) );
}


has 'dbus_timedate1_service' => (
    is       => 'rw',
    init_arg => undef,
    lazy     => 1,
    builder  => '_dbusTimeDateInitialize'
);

sub _dbusTimeDateInitialize {
    my $self = shift();

    my $bus = Net::DBus->system;
    $self->dbus_timedate1_service($bus->get_service("org.freedesktop.timedate1"));
}


has 'dbus_timedate1_object' => (
    is       => 'rw',
    init_arg => undef,
    lazy     => 1,
    builder  => '_dbusObjectInitialize'
);

sub _dbusObjectInitialize {
    my $self = shift();

    $self->dbus_timedate1_object($self->dbus_timedate1_service->get_object("/org/freedesktop/timedate1"));
}


has 'servername_config_suffix' => (
    is  => 'ro',
    isa => 'Str',
    lazy     => 1,
    builder  => '_servername_config_suffix_init',
);

sub _servername_config_suffix_init {
    my $self = shift;

    return " iburst" if ($self->ntp_program eq "chronyd");

    return "";
}

has 'loc' => (
        is       => 'rw',
        lazy     => 1,
        init_arg => undef,
        builder  => '_localeInitialize'
);

sub _localeInitialize {
    my $self = shift;

    # TODO fix domain binding for translation
    $self->loc(ManaTools::Shared::Locales->new(domain_name => 'libDrakX') );
    # TODO if we want to give the opportunity to test locally add dir_name => 'path'
}


has 'ntp_servers' => (
    traits    => ['Hash'],
    is        => 'rw',
    isa       => 'HashRef',
    lazy      => 1,
    handles   => {
        get_ntp_server     => 'get',
        ntp_server_pairs   => 'kv',
    },
    init_arg  => undef,
    builder => '_buildNTPServers'
);

sub _buildNTPServers {
    my $self = shift;

    my %ntpServersHash;
    $ntpServersHash{"-"} = {
        $self->loc->N_("Global") => "pool.ntp.org",
    };
    $ntpServersHash{Global} = {
        $self->loc->N_("Africa") => "africa.pool.ntp.org",
        $self->loc->N_("Asia") => "asia.pool.ntp.org",
        $self->loc->N_("Europe") => "europe.pool.ntp.org",
        $self->loc->N_("North America") => "north-america.pool.ntp.org",
        $self->loc->N_("Oceania") => "oceania.pool.ntp.org",
        $self->loc->N_("South America") => "south-america.pool.ntp.org",
    };
    $ntpServersHash{Africa} = {
        $self->loc->N_("South Africa") => "za.pool.ntp.org",
        $self->loc->N_("Tanzania") => "tz.pool.ntp.org",
    };
    $ntpServersHash{Asia} = {
        $self->loc->N_("Bangladesh") => "bd.pool.ntp.org",
        $self->loc->N_("China") => "cn.pool.ntp.org",
        $self->loc->N_("Hong Kong") => "hk.pool.ntp.org",
        $self->loc->N_("India") => "in.pool.ntp.org",
        $self->loc->N_("Indonesia") => "id.pool.ntp.org",
        $self->loc->N_("Iran") => "ir.pool.ntp.org",
        $self->loc->N_("Israel") => "il.pool.ntp.org",
        $self->loc->N_("Japan") => "jp.pool.ntp.org",
        $self->loc->N_("Korea") => "kr.pool.ntp.org",
        $self->loc->N_("Malaysia") => "my.pool.ntp.org",
        $self->loc->N_("Philippines") => "ph.pool.ntp.org",
        $self->loc->N_("Singapore") => "sg.pool.ntp.org",
        $self->loc->N_("Taiwan") => "tw.pool.ntp.org",
        $self->loc->N_("Thailand") => "th.pool.ntp.org",
        $self->loc->N_("Turkey") => "tr.pool.ntp.org",
        $self->loc->N_("United Arab Emirates") => "ae.pool.ntp.org",
    };
    $ntpServersHash{Europe} = {
        $self->loc->N_("Austria") => "at.pool.ntp.org",
        $self->loc->N_("Belarus") => "by.pool.ntp.org",
        $self->loc->N_("Belgium") => "be.pool.ntp.org",
        $self->loc->N_("Bulgaria") => "bg.pool.ntp.org",
        $self->loc->N_("Czech Republic") => "cz.pool.ntp.org",
        $self->loc->N_("Denmark") => "dk.pool.ntp.org",
        $self->loc->N_("Estonia") => "ee.pool.ntp.org",
        $self->loc->N_("Finland") => "fi.pool.ntp.org",
        $self->loc->N_("France") => "fr.pool.ntp.org",
        $self->loc->N_("Germany") => "de.pool.ntp.org",
        $self->loc->N_("Greece") => "gr.pool.ntp.org",
        $self->loc->N_("Hungary") => "hu.pool.ntp.org",
        $self->loc->N_("Ireland") => "ie.pool.ntp.org",
        $self->loc->N_("Italy") => "it.pool.ntp.org",
        $self->loc->N_("Lithuania") => "lt.pool.ntp.org",
        $self->loc->N_("Luxembourg") => "lu.pool.ntp.org",
        $self->loc->N_("Netherlands") => "nl.pool.ntp.org",
        $self->loc->N_("Norway") => "no.pool.ntp.org",
        $self->loc->N_("Poland") => "pl.pool.ntp.org",
        $self->loc->N_("Portugal") => "pt.pool.ntp.org",
        $self->loc->N_("Romania") => "ro.pool.ntp.org",
        $self->loc->N_("Russian Federation") => "ru.pool.ntp.org",
        $self->loc->N_("Slovakia") => "sk.pool.ntp.org",
        $self->loc->N_("Slovenia") => "si.pool.ntp.org",
        $self->loc->N_("Spain") => "es.pool.ntp.org",
        $self->loc->N_("Sweden") => "se.pool.ntp.org",
        $self->loc->N_("Switzerland") => "ch.pool.ntp.org",
        $self->loc->N_("Ukraine") => "ua.pool.ntp.org",
        $self->loc->N_("United Kingdom") => "uk.pool.ntp.org",
        $self->loc->N_("Yugoslavia") => "yu.pool.ntp.org",
    };
    $ntpServersHash{"North America"} = {
        $self->loc->N_("Canada") => "ca.pool.ntp.org",
        $self->loc->N_("Guatemala") => "gt.pool.ntp.org",
        $self->loc->N_("Mexico") => "mx.pool.ntp.org",
        $self->loc->N_("United States") => "us.pool.ntp.org",
    };
    $ntpServersHash{Oceania} = {
        $self->loc->N_("Australia") => "au.pool.ntp.org",
        $self->loc->N_("New Zealand") => "nz.pool.ntp.org",
    };
    $ntpServersHash{"South America"} = {
        $self->loc->N_("Argentina") => "ar.pool.ntp.org",
        $self->loc->N_("Brazil") => "br.pool.ntp.org",
        $self->loc->N_("Chile") => "cl.pool.ntp.org",
    };

    return \%ntpServersHash;
}


#=============================================================

=head2 refreshNTPServiceList

=head3 DESCRIPTION

    Refresh the ntpServiceList attribute value, usefull
    if any NTP service has been istalled after having
    instantiated this object

=cut

#=============================================================
sub refreshNTPServiceList {
    my $self = shift;

    my $list = $self->_build_ntpServiceList();

    $self->ntpServiceList($list);
}

#=============================================================

=head2 get_timezone_prefix

=head3 OUTPUT

timezone_prefix: directory in which time zone files are

=head3 DESCRIPTION

Return the timezone directory (defualt: /usr/share/zoneinfo)

=cut

#=============================================================
sub get_timezone_prefix {
    my $self = shift;

    return $self->timezone_prefix;
}

#=============================================================

=head2 getTimeZones

=head3 INPUT

    $from_system: if present and its value is not 0 checks into timezone_prefix
                directory and gets the list from there

=head3 OUTPUT

    @l: ARRAY containing sorted time zones

=head3 DESCRIPTION

    This method returns the available timezones

=cut

#=============================================================
sub getTimeZones {
    my ($self, $from_system) = @_;

    if ($from_system and $from_system != 0) {
        require MDK::Common::DataStructure;
        require MDK::Common::Various;
        my $tz_prefix = $self->get_timezone_prefix();
        open(my $F, "cd $tz_prefix && find [A-Z]* -noleaf -type f |");
        my @l = MDK::Common::DataStructure::difference2([ MDK::Common::Various::chomp_(<$F>) ], [ 'ROC', 'PRC' ]);
        close $F or die "cannot list the available zoneinfos";
        return sort @l;
    }

    return DateTime::TimeZone->all_names;
}

#=============================================================

=head2 setTimeZone

=head3 INPUT

    $new_time_zone: New time zone to be set

=head3 DESCRIPTION

    This method get the new time zone to set and performs
    the setting

=cut

#=============================================================
sub setTimeZone {
    my ($self, $new_time_zone) = @_;

    die "Time zone value required" if !defined($new_time_zone);

    my $object   = $self->dbus_timedate1_object;
    $object->SetTimezone($new_time_zone, 1);
}

#=============================================================

=head2 getTimeZone

=head3 OUTPUT

    $timezone: current time zone

=head3 DESCRIPTION

    This method returns the current timezone setting

=cut

#=============================================================
sub getTimeZone {
    my ($self) = @_;

    my $object       = $self->dbus_timedate1_object;

    return $object->Get("org.freedesktop.timedate1", 'Timezone') || "";
}


#=============================================================

=head2 setLocalRTC

=head3 INPUT

    $enable: bool value enable/disable real time clock as
             localtime
    $fix_system: bool read or not the real time clock

=head3 DESCRIPTION

    This method enables/disables the real time clock as
    localtime (e.g. disable means set the rtc to UTC).
    NOTE from dbus:
    Use SetLocalRTC() to control whether the RTC is in
    local time or UTC. It is strongly recommended to maintain
    the RTC in UTC. Some OSes (Windows) however maintain the
    RTC in local time which might make it necessary to enable
    this feature. However, this creates various problems as
    daylight changes might be missed. If fix_system is passed
    "true" the time from the RTC is read again and the system
    clock adjusted according to the new setting.
    If fix_system is passed "false" the system time is written
    to the RTC taking the new setting into account.
    Use fix_system=true in installers and livecds where the
    RTC is probably more reliable than the system time.
    Use fix_system=false in configuration UIs that are run during
    normal operation and where the system clock is probably more
    reliable than the RTC.

=cut

#=============================================================
sub setLocalRTC {
    my ($self, $enable, $fix_system) = @_;

    die "Localtime enable/disable value required" if !defined($enable);

    $fix_system = 0 if !defined($fix_system);
    my $object   = $self->dbus_timedate1_object;
    $object->SetLocalRTC($enable, $fix_system, 1) ;
}

#=============================================================

=head2 getLocalRTC

=head3 OUTPUT

    $localRTC: 1 if RTC is localtime 0 for UTC

=head3 DESCRIPTION

    This method returns the RTC localtime setting

=cut

#=============================================================
sub getLocalRTC {
    my $self = shift;

    my $object   = $self->dbus_timedate1_object;

    return $object->Get("org.freedesktop.timedate1", 'LocalRTC') ? 1 : 0;
}

#=============================================================

=head2 setEmbeddedNTP

=head3 INPUT

    $enable: enable/disable systemd NTP service

=head3 DESCRIPTION

    This method enables/disables and starts/stops systemd NTP service,

=cut

#=============================================================
sub setEmbeddedNTP {
    my ($self, $enable) = @_;

    my $object   = $self->dbus_timedate1_object;
    $object->SetNTP(($enable ? 1 : 0), 1);
}

#=============================================================

=head2 getEmbeddedNTP

=head3 OUTPUT

    $NTP: if systemd NTP is enabled

=head3 DESCRIPTION

    This method returns the systemd NTP service is running

=cut

#=============================================================
sub getEmbeddedNTP {
    my ($self) = @_;

    my $object       = $self->dbus_timedate1_object;

    return $object->Get("org.freedesktop.timedate1", 'NTP') || "";
}




#=============================================================

=head2 setTime

=head3 INPUT

    $sec_since_epoch: Time in seconds since 1/1/1970

=head3 DESCRIPTION

    This method set the system time and sets the RTC also

=cut

#=============================================================
sub setTime {
    my ($self, $sec_since_epoch) = @_;

    die "second since epoch required" if !defined($sec_since_epoch);

    my $object = $self->dbus_timedate1_object;
    my $usec   = $sec_since_epoch* 1000000;

    $object->SetTime($usec, 0, 1);
}

#=============================================================

=head2 readConfiguration

=head3 OUTPUT

    hash reference containing:
        UTC  => HW clock is set as UTC
        ZONE => Time Zone set

=head3 DESCRIPTION

    This method returns the time zone system settings as hash
    reference

=cut

#=============================================================
sub readConfiguration {
    my $self = shift;

    my $prefs        = {};
    $prefs->{'ZONE'} = $self->getTimeZone();
    $prefs->{'UTC'}  = $self->getLocalRTC() ? 0 : 1;

    return $prefs;
}


#=============================================================

=head2 writeConfiguration

=head3 INPUT

    $info: hash containing:
           UTC  => HW clock is set as UTC
           ZONE => Time Zone

=head3 DESCRIPTION

    This method sets the passed Time Zone configuration.
    If installer_or_livecd attribute is set fix_system is
    passed to setLocalRTC

=cut

#=============================================================
sub writeConfiguration {
    my ($self, $info) = @_;

    die "UTC  field required" if !defined($info->{UTC});
    die "ZONE field required" if !defined($info->{ZONE});

    my $localRTC = $info->{UTC} ? 0 : 1;
    $self->setLocalRTC(
        $localRTC,
        $self->installer_or_livecd
    );

    $self->setTimeZone(
        $info->{ZONE}
    );
}


#left for back compatibility
sub _get_ntp_server_tree {
    my ($self, $zone) = @_;
    $zone = "-" if ! $zone;
    my $ns = $self->get_ntp_server($zone);
    return if !$ns;

    map {
        $ns->{$_} => (
             $self->get_ntp_server($_) ?
              $zone ?
                $self->loc->N($_) . "|" . $self->loc->N("All servers") :
                $self->loc->N("All servers") :
              $self->loc->N($zone) . "|" . $self->loc->N($_)
        ),
        $self->_get_ntp_server_tree($_)
    } keys %{$ns};
}

#=============================================================

=head2 ntpServers

=head3 OUTPUT

 HASHREF containing ntp_server => zone info

=head3 DESCRIPTION

 This method returns an hash ref containing pairs ntp-server, zone

=cut

#=============================================================
sub ntpServers {
    my ($self) = @_;
    # FIXME: missing parameter:
   +{$self->_get_ntp_server_tree()};
}


#=============================================================

=head2 ntpCurrentServer

=head3 INPUT

Input_Parameter: in_par_description

=head3 DESCRIPTION

Returns the current ntp server address read from configuration file

=cut

#=============================================================
sub ntpCurrentServer {
    my $self = shift;

    my $configFile = $self->ntp_configuration_file || $self->getNTPServiceConfig($self->ntp_program);

    MDK::Common::Func::find { $_ ne '127.127.1.0' } map { MDK::Common::Func::if_(/^\s*server\s+(\S*)/, $1) } MDK::Common::File::cat_($configFile);
}

#=============================================================

=head2 currentNTPService

=head3 DESCRIPTION

    Returns the current ntp service

=cut

#=============================================================
sub currentNTPService {
    my $self = shift;

    my $ntpd = $self->ntp_program;

    return $ntpd;
}

#=============================================================

=head2 isNTPRunning

=head3 DESCRIPTION

   This method just returns if the given ntp server is running

=cut

#=============================================================
sub isNTPRunning {
    my $self = shift;

    my $ntpd      = $self->ntp_program;
    my $isRunning = $ntpd ? $self->sh_services->is_service_running($ntpd) : 0;

    if (!$isRunning) {
        # NOTE fix systemd-timesyncd problem that prevents to set time
        if ($self->getEmbeddedNTP()) {
            $ntpd = "systemd-timesyncd";
            Sys::Syslog::syslog(
                'info|local1',
                $self->loc->N("%s enabled but stopped - disabling it",
                    $ntpd
                )
            );
            $self->setEmbeddedNTP(0);
        }
    }

    return $isRunning;
}

#=============================================================

=head2 setNTPConfiguration

=head3 INPUT

    $server: server address to be configured as NTP server

=head3 DESCRIPTION

    This method writes into NTP configuration file new server address
    settings (note that root rights are required) or it rises an
    exception

=cut

#=============================================================
sub setNTPConfiguration {
    my ($self, $server) = @_;

    $DB::single = 1;
    my $f =  $self->ntp_configuration_file || $self->getNTPServiceConfig($self->ntp_program);;
    -f $f or return;

    die  $self->loc->N("user does not have the rights to change configuration file, skipped")
        if (!(-w $f));

    my $pool_match = qr/\.pool\.ntp\.org$/;
    my @servers = $server =~ $pool_match  ? (map { "$_.$server" } 0 .. 2) : $server;

    if ($self->ntp_program eq "systemd-timesyncd") {
        my $added = 0;
        MDK::Common::File::substInFile {
            if (/^#?\s*NTP=\s+(\S*)/ && $1 ne '127.127.1.0') {
                $_ = $added ? $_ =~ $pool_match ? undef : "#NTP=$1\n" : join('NTP= ', @servers, "\n");
                $added = 1;
            }
        } $f;
        if ($self->ntp_program eq "ntpd") {
            my $ntp_prefix = $self->ntp_conf_dir;
                MDK::Common::File::output_p("$ntp_prefix/step-tickers", join('', map { "$_\n" } @servers));
        }
    }
    else {
        my $added = 0;
        my $servername_config_suffix = $self->servername_config_suffix ? $self->servername_config_suffix : " ";
        MDK::Common::File::substInFile {
            if (/^#?\s*server\s+(\S*)/ && $1 ne '127.127.1.0') {
                $_ = $added ? $_ =~ $pool_match ? undef : "#server $1\n" : join('', map { "server $_$servername_config_suffix\n" } @servers);
                $added = 1;
            }
        } $f;
        if ($self->ntp_program eq "ntpd") {
            my $ntp_prefix = $self->ntp_conf_dir;
                MDK::Common::File::output_p("$ntp_prefix/step-tickers", join('', map { "$_\n" } @servers));
        }
    }

}

#=============================================================

=head2 enableAndStartNTP

=head3 INPUT

    $server: server address to be configured

=head3 DESCRIPTION

    This method writes into NTP configuration file new server address
    settings

=cut

#=============================================================
sub enableAndStartNTP {
    my ($self, $server) = @_;

    my $ntpd = $self->ntp_program;

    ManaTools::Shared::disable_x_screensaver();
    if ($ntpd eq "systemd-timesyncd") {
        $self->setEmbeddedNTP(1);
    }
    else {
        if ($self->isNTPRunning()) {
            $self->sh_services->stopService($ntpd);
        }

        #if systemd-timesyncd is running has to be stopped and disabled
        $self->setEmbeddedNTP(0) if ($self->getEmbeddedNTP());

        # enable but do not start the service
        $self->sh_services->set_status($ntpd, 1, 1);
        if ($ntpd eq "chronyd") {
            $self->sh_services->startService($ntpd);
            $ENV{PATH} = "/usr/bin:/usr/sbin";
            # Wait up to 30s for sync
            system('/usr/bin/chronyc', 'waitsync', '30', '0.1');
        } else {
            $ENV{PATH} = "/usr/bin:/usr/sbin";
            system('/usr/sbin/ntpdate', $server) if $server;
            $self->sh_services->startService($ntpd);
        }
    }
    ManaTools::Shared::enable_x_screensaver();
}

#=============================================================

=head2 disableAndStopNTP

=head3 DESCRIPTION

    Disable and stop the ntp server

=cut

#=============================================================
sub disableAndStopNTP {
    my $self = shift;

    my $ntpd = $self->ntp_program;

    if ($ntpd eq "systemd-timesyncd") {
        $self->setEmbeddedNTP(0);
    }
    else {
        # also stop the service without dont_apply parameter
        $self->sh_services->set_status($ntpd, 0);
    }
}

no Moose;
__PACKAGE__->meta->make_immutable;


1;
generated by cgit v1.2.1 (git 2.21.0) at 2025-11-12 10:09:56 +0000