summaryrefslogtreecommitdiffstats
path: root/perl-install/timezone.pm
blob: 6515c041aff06d0be71716c8a8c010f3864b9844 (plain) 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254

package timezone; # $Id$

use diagnostics;
use strict;

use common;
use log;


sub getTimeZones() {
    my $prefix = $::testing ? '' : $::prefix;
    open(my $F, "cd $prefix/usr/share/zoneinfo && find [A-Z]* -type f |");
    my @l = difference2([ chomp_(<$F>) ], [ 'ROC', 'PRC' ]);
    close $F or die "cannot list the available zoneinfos";
    sort @l;
}

sub read() {
    my %t = getVarsFromSh("$::prefix/etc/sysconfig/clock") or return {};
    { timezone => $t{ZONE}, UTC => text2bool($t{UTC}) };
}

sub ntp_server {
    my $setting = @_ >= 1;
    my ($server) = @_;

    my $f = "$::prefix/etc/ntp.conf";
    -e $f or return;

    if ($setting) {
	my $added = 0;
	substInFile {
	    if (/^#?\s*server\s+(\S*)/ && $1 ne '127.127.1.0') {
		$_ = $added ? "#server $1\n" : "server $server\n";
		$added = 1;
	    }
	} $f;
	output_p("$::prefix/etc/ntp/step-tickers", "$server\n");
    } else {
	$server = find { $_ ne '127.127.1.0' } map { if_(/^\s*server\s+(\S*)/, $1) } cat_($f);
    }
    $server;
}

sub write {
    my ($t) = @_;

    ntp_server($t->{ntp});

    eval { cp_af("$::prefix/usr/share/zoneinfo/$t->{timezone}", "$::prefix/etc/localtime") };
    $@ and log::l("installing /etc/localtime failed");
    setVarsInSh("$::prefix/etc/sysconfig/clock", {
	ZONE => $t->{timezone},
	UTC  => bool2text($t->{UTC}),
	ARC  => "false",
    });
}

#- best guesses for a given country
my %c2t = (
'AM' => 'Asia/Yerevan',
'AR' => 'America/Buenos_Aires',
'AT' => 'Europe/Vienna',
'AU' => 'Australia/Sydney',
'BA' => 'Europe/Sarajevo',
'BE' => 'Europe/Brussels',
'BG' => 'Europe/Sofia',
'BR' => 'Brazil/East', #- most people live on the east coast
'BY' => 'Europe/Minsk',
'CA' => 'Canada/Eastern',
'CH' => 'Europe/Zurich',
'CN' => 'Asia/Beijing',
'CZ' => 'Europe/Prague',
'DE' => 'Europe/Berlin',
'DK' => 'Europe/Copenhagen',
'EE' => 'Europe/Tallinn',
'ES' => 'Europe/Madrid',
'FI' => 'Europe/Helsinki',
'FR' => 'Europe/Paris',
'GB' => 'Europe/London',
'GE' => 'Asia/Yerevan',
'GL' => 'Arctic/Longyearbyen',
'GR' => 'Europe/Athens',
'HR' => 'Europe/Zagreb',
'HU' => 'Europe/Budapest',
'ID' => 'Asia/Jakarta',
'IE' => 'Europe/Dublin',
'IL' => 'Asia/Tel_Aviv',
'IN' => 'Asia/Calcutta',
'IR' => 'Asia/Tehran',
'IS' => 'Atlantic/Reykjavik',
'IT' => 'Europe/Rome',
'JP' => 'Asia/Tokyo',
'KR' => 'Asia/Seoul',
'LT' => 'Europe/Vilnius',
'LV' => 'Europe/Riga',
'MK' => 'Europe/Skopje',
'MT' => 'Europe/Malta',
'MX' => 'America/Mexico_City',
'MY' => 'Asia/Kuala_Lumpur',
'NL' => 'Europe/Amsterdam',
'NO' => 'Europe/Oslo',
'NZ' => 'Pacific/Auckland',
'PL' => 'Europe/Warsaw',
'PT' => 'Europe/Lisbon',
'RO' => 'Europe/Bucharest',
'RU' => 'Europe/Moscow',
'SE' => 'Europe/Stockholm',
'SI' => 'Europe/Ljubljana',
'SK' => 'Europe/Bratislava',
'TH' => 'Asia/Bangkok',
'TJ' => 'Asia/Dushanbe',
'TR' => 'Europe/Istanbul',
'TW' => 'Asia/Taipei',
'UA' => 'Europe/Kiev',
'US' => 'America/New_York',
'UZ' => 'Asia/Tashkent',
'VN' => 'Asia/Saigon',
'YU' => 'Europe/Belgrade',
'ZA' => 'Africa/Johannesburg',
);

sub fuzzyChoice { 
    my ($b, $count) = bestMatchSentence($_[0], keys %c2t);
    $count ? $b : '';
}
sub bestTimezone { $c2t{fuzzyChoice($_[0])} || 'GMT' }

sub ntp_servers() { 
    +{
	'time.sinectis.com.ar' => 'Argentina',
	'tick.nap.com.ar' => 'Argentina',
	'tock.nap.com.ar' => 'Argentina',
	'ntp.adelaide.edu.au' => 'Australia',
	'ntp.saard.net' => 'Australia',
	'ntp1.belbone.be' => 'Belgium',
	'ntp2.belbone.be' => 'Belgium',
	'ntp.cpsc.ucalgary.ca' => 'Canada',
	'ntp1.cmc.ec.gc.ca' => 'Canada',
	'ntp2.cmc.ec.gc.ca' => 'Canada',
	'time.chu.nrc.ca' => 'Canada',
	'time.nrc.ca' => 'Canada',
	'timelord.uregina.ca' => 'Canada',
	'ntp.globe.cz' => 'Czech republic',
	'ntp.karpo.cz' => 'Czech republic',
	'ntp1.contactel.cz' => 'Czech republic',
	'ntp2.contactel.cz' => 'Czech republic',
	'clock.netcetera.dk' => 'Denmark',
	'clock2.netcetera.dk' => 'Denmark',
	'slug.ctv.es' => 'Spain',
	'tick.keso.fi' => 'Finland',
	'tock.keso.fi' => 'Finland',
	'ntp.ndsoftwarenet.com' => 'France',
	'ntp.obspm.fr' => 'France',
	'ntp.tuxfamily.net' => 'France',
	'ntp1.tuxfamily.net' => 'France',
	'ntp2.tuxfamily.net' => 'France',
	'ntp.univ-lyon1.fr' => 'France',
	'zg1.ntp.carnet.hr' => 'Croatia',
	'zg2.ntp.carnet.hr' => 'Croatia',
	'st.ntp.carnet.hr' => 'Croatia',
	'ri.ntp.carnet.hr' => 'Croatia',
	'os.ntp.carnet.hr' => 'Croatia',
	'ntp.incaf.net' => 'Indonesia',
	'ntp.maths.tcd.ie' => 'Ireland',
	'time.ien.it' => 'Italy',
	'ntps.net4u.it' => 'Italy',
	'ntp.cyber-fleet.net' => 'Japan',
	'time.nuri.net' => 'Korea, republic of',
	'ntp2a.audiotel.com.mx' => 'Mexico',
	'ntp2b.audiotel.com.mx' => 'Mexico',
	'ntp2c.audiotel.com.mx' => 'Mexico',
	'ntp.doubleukay.com' => 'Malaysia',
	'ntp1.theinternetone.net' => 'Netherlands',
	'ntp2.theinternetone.net' => 'Netherlands',
	'ntp3.theinternetone.net' => 'Netherlands',
	'fartein.ifi.uio.no' => 'Norway',
	'info.cyf-kr.edu.pl' => 'Poland',
	'ntp.ip.ro' => 'Romania',
	'ntp.psn.ru' => 'Russia',
	'time.flygplats.net' => 'Sweden',
	'ntp.shim.org' => 'Singapore',
	'biofiz.mf.uni-lj.si' => 'Slovenia',
	'time.ijs.si' => 'Slovenia',
	'time.ijs.si' => 'Slovenia',
	'clock.cimat.ues.edu.sv' => 'El salvador',
	'a.ntp.alphazed.net' => 'United kingdom',
	'bear.zoo.bt.co.uk' => 'United kingdom',
	'ntp.cis.strath.ac.uk' => 'United kingdom',
	'ntp2a.mcc.ac.uk' => 'United kingdom',
	'ntp2b.mcc.ac.uk' => 'United kingdom',
	'ntp2c.mcc.ac.uk' => 'United kingdom',
	'ntp2d.mcc.ac.uk' => 'United kingdom',
	'tick.tanac.net' => 'United kingdom',
	'time-server.ndo.com' => 'United kingdom',
	'sushi.compsci.lyon.edu' => 'United states AR',
	'ntp.drydog.com' => 'United states AZ',
	'clock.fmt.he.net' => 'United states CA',
	'clock.sjc.he.net' => 'United states CA',
	'ntp.ucsd.edu' => 'United states CA',
	'ntp1.sf-bay.org' => 'United states CA',
	'ntp2.sf-bay.org' => 'United states CA',
	'time.berkeley.netdot.net' => 'United states CA',
	'ntp1.linuxmedialabs.com' => 'United states CO',
	'ntp1.tummy.com' => 'United states CO',
	'louie.udel.edu' => 'United states DE',
	'rolex.usg.edu' => 'United states GA',
	'timex.usg.edu' => 'United states GA',
	'ntp-0.cso.uiuc.edu' => 'United states IL',
	'ntp-1.cso.uiuc.edu' => 'United states IL',
	'ntp-1.mcs.anl.gov' => 'United states IL',
	'ntp-2.cso.uiuc.edu' => 'United states IL',
	'ntp-2.mcs.anl.gov' => 'United states IL',
	'gilbreth.ecn.purdue.edu' => 'United states IN',
	'harbor.ecn.purdue.edu' => 'United states IN',
	'molecule.ecn.purdue.edu' => 'United states IN',
	'ntp.ourconcord.net' => 'United states MA',
	'ns.nts.umn.edu' => 'United states MN',
	'nss.nts.umn.edu' => 'United states MN',
	'time-ext.missouri.edu' => 'United states MO',
	'chronos1.umt.edu' => 'United states MT',
	'chronos2.umt.edu' => 'United states MT',
	'chronos3.umt.edu' => 'United states MT',
	'tick.jrc.us' => 'United states NJ',
	'tock.jrc.us' => 'United states NJ',
	'cuckoo.nevada.edu' => 'United states NV',
	'tick.cs.unlv.edu' => 'United states NV',
	'tock.cs.unlv.edu' => 'United states NV',
	'clock.linuxshell.net' => 'United states NY',
	'clock.nyc.he.net' => 'United states NY',
	'ntp0.cornell.edu' => 'United states NY',
	'reva.sixgirls.org' => 'United states NY',
	'clock.psu.edu' => 'United states PA',
	'fuzz.psc.edu' => 'United states PA',
	'ntp-1.cede.psu.edu' => 'United states PA',
	'ntp-2.cede.psu.edu' => 'United states PA',
	'ntp-1.ece.cmu.edu' => 'United states PA',
	'ntp-2.ece.cmu.edu' => 'United states PA',
	'ntp.cox.smu.edu' => 'United states TX',
	'ntp.fnbhs.com' => 'United states TX',
	'ntppub.tamu.edu' => 'United states TX',
	'ntp-1.vt.edu' => 'United states VA',
	'ntp-2.vt.edu' => 'United states VA',
	'ntp.cmr.gov' => 'United states VA',
	'ntp1.cs.wisc.edu' => 'United states WI',
	'ntp3.cs.wisc.edu' => 'United states WI',
	'ntp3.sf-bay.org' => 'United states WI',
	'ntp.cs.unp.ac.za' => 'South africa',
	'tock.nml.csir.co.za' => 'South africa',
        'pool.ntp.org' => 'World Wide',
    };
}

1;
generated by cgit v1.2.1 (git 2.21.0) at 2025-03-07 00:40:36 +0000
="hl ipl">$new_bootstrap); @ISA = qw(install_steps); #-###################################################################################### #- misc imports #-###################################################################################### use common; use partition_table; use fs::type; use install_steps; use install_interactive; use install_any; use install_messages; use detect_devices; use run_program; use devices; use fsedit; use loopback; use mouse; use modules; use modules::interactive; use lang; use keyboard; use any; use log; #-###################################################################################### #- In/Out Steps Functions #-###################################################################################### sub errorInStep { my ($o, $err) = @_; $o->ask_warn(N("Error"), [ N("An error occurred"), formatError($err) ]); } sub kill_action { my ($o) = @_; $o->kill; } #-###################################################################################### #- Steps Functions #-###################################################################################### #------------------------------------------------------------------------------ sub selectLanguage { my ($o) = @_; $o->{locale}{lang} = any::selectLanguage($o, $o->{locale}{lang}, $o->{locale}{langs} ||= {}); install_steps::selectLanguage($o); if ($o->isa('interactive::gtk')) { $o->ask_warn('', formatAlaTeX( "If you see this message it is because you chose a language for which DrakX does not include a translation yet; however the fact that it is listed means there is some support for it anyway. That is, once GNU/Linux will be installed, you will be able to at least read and write in that language; and possibly more (various fonts, spell checkers, various programs translated etc. that varies from language to language).")) if $o->{locale}{lang} !~ /^en/ && !lang::load_mo(); } else { #- no need to have this in po since it is never translated $o->ask_warn('', "The characters of your language can't be displayed in console, so the messages will be displayed in english during installation") if $ENV{LANGUAGE} eq 'C'; } } sub acceptLicense { my ($o) = @_; $o->{release_notes} = do { my $f = install_any::getFile('release-notes.txt'); join('', <$f>); }; return if $o->{useless_thing_accepted}; my $r = $::testing ? 'Accept' : 'Refuse'; ($::recovery ? $o->ask_yesorno('', N("Do you want to recover your system?"), 0) : $o->ask_from_({ title => N("License agreement"), cancel => N("Quit"), messages => formatAlaTeX(install_messages::main_license() . "\n\n\n" . install_messages::warning_about_patents()), interactive_help_id => 'acceptLicense', more_buttons => [ [ N("Release Notes"), sub { $o->ask_warn(N("Release Notes"), $o->{release_notes}) }, 1 ] ], callbacks => { ok_disabled => sub { $r eq 'Refuse' } }, }, [ { list => [ N_("Accept"), N_("Refuse") ], val => \$r, type => 'list', format => sub { translate($_[0]) } } ])) or do { if ($::globetrotter) { system("killall XFree86"); exec("/sbin/reboot"); }; install_any::ejectCdrom(); $o->exit; }; } #------------------------------------------------------------------------------ sub selectKeyboard { my ($o, $clicked) = @_; my $from_usb = keyboard::from_usb(); my $l = keyboard::lang2keyboards(lang::langs($o->{locale}{langs})); if ($::expert || $clicked || !($from_usb || @$l && $l->[0][1] >= 90) || listlength(lang::langs($o->{locale}{langs})) > 1) { add2hash($o->{keyboard}, $from_usb); my @best = uniq($from_usb ? $from_usb->{KEYBOARD} : (), (map { $_->[0] } @$l), 'us_intl'); my $format = sub { translate(keyboard::KEYBOARD2text($_[0])) }; my $other; my $ext_keyboard = my $KEYBOARD = $o->{keyboard}{KEYBOARD}; $o->ask_from_( { title => N("Keyboard"), messages => N("Please choose your keyboard layout."), interactive_help_id => 'selectKeyboard', advanced_messages => N("Here is the full list of available keyboards"), advanced_label => N("More"), callbacks => { changed => sub { $other = $_[0] == 1 } }, }, [ if_(@best > 1, { val => \$KEYBOARD, type => 'list', format => $format, sort => 1, list => [ @best ] }), { val => \$ext_keyboard, type => 'list', format => $format, list => [ difference2([ keyboard::KEYBOARDs() ], \@best) ], advanced => @best > 1 } ]); $o->{keyboard}{KEYBOARD} = $other ? $ext_keyboard : $KEYBOARD; delete $o->{keyboard}{unsafe}; } keyboard::group_toggle_choose($o, $o->{keyboard}) or goto &selectKeyboard; install_steps::selectKeyboard($o); } #------------------------------------------------------------------------------ sub selectInstallClass { my ($o) = @_; if (my @l = install_any::find_root_parts($o->{fstab}, $o->{prefix})) { log::l("proposing to upgrade partitions " . join(" ", map { $_->{part}{device} } @l)); my @releases = uniq(map { $_->{release} } @l); if (@releases != @l) { #- same release name so adding the device to differentiate them: $_->{release} .= " ($_->{part}{device})" foreach @l; } my $p; $o->ask_from_({ title => N("Install/Upgrade"), messages => N("Is this an install or an upgrade?"), interactive_help_id => 'selectInstallClass', }, [ { val => \$p, list => [ @l, N_("Install") ], type => 'list', format => sub { ref($_[0]) ? N("Upgrade %s", $_[0]{release}) : translate($_[0]) } } ]); if (ref $p) { my $part = $p->{part}; log::l("choosing to upgrade partition $part->{device}"); install_any::use_root_part($o->{all_hds}, $part, $o); foreach (grep { $_->{mntpoint} } @{$o->{fstab}}) { my ($options, $_unknown) = fs::mount_options::unpack($_); $options->{encrypted} or next; $o->ask_from_({ focus_first => 1 }, [ { label => N("Encryption key for %s", $_->{mntpoint}), hidden => 1, val => \$_->{encrypt_key} } ]); } $o->{isUpgrade} = $p->{release_file} =~ /redhat/ ? 'redhat' : 'mandrake'; } } } #------------------------------------------------------------------------------ sub selectMouse { my ($o, $force) = @_; $force ||= $o->{mouse}{unsafe}; if ($force) { my $prev = $o->{mouse}{type} . '|' . $o->{mouse}{name}; $o->ask_from_({ messages => N("Please choose your type of mouse."), interactive_help_id => 'selectMouse', }, [ { list => [ mouse::fullnames() ], separator => '|', val => \$prev, format => sub { join('|', map { translate($_) } split('\|', $_[0])) } } ]); $o->{mouse} = mouse::fullname2mouse($prev); } if ($force && $o->{mouse}{type} eq 'serial') { $o->{mouse}{device} = $o->ask_from_listf_raw({ title => N("Mouse Port"), messages => N("Please choose which serial port your mouse is connected to."), interactive_help_id => 'selectSerialPort', }, \&mouse::serial_port2text, [ mouse::serial_ports() ]) or return &selectMouse; } if (arch() =~ /ppc/ && $o->{mouse}{nbuttons} == 1) { #- set a sane default F11/F12 $o->{mouse}{button2_key} = 87; $o->{mouse}{button3_key} = 88; $o->ask_from('', N("Buttons emulation"), [ { label => N("Button 2 Emulation"), val => \$o->{mouse}{button2_key}, list => [ mouse::ppc_one_button_keys() ], format => \&mouse::ppc_one_button_key2text }, { label => N("Button 3 Emulation"), val => \$o->{mouse}{button3_key}, list => [ mouse::ppc_one_button_keys() ], format => \&mouse::ppc_one_button_key2text }, ]) or return; } if ($o->{mouse}{device} eq "usbmouse") { modules::interactive::load_category($o, $o->{modules_conf}, 'bus/usb', 1, 1); eval { devices::make("usbmouse"); modules::load(qw(hid mousedev usbmouse)); }; } $o->SUPER::selectMouse; 1; } #------------------------------------------------------------------------------ sub setupSCSI { my ($o) = @_; if (!$::noauto && arch() =~ /i.86/) { if ($o->{pcmcia} ||= !$::testing && c::pcmcia_probe()) { my $w = $o->wait_message(N("PCMCIA"), N("Configuring PCMCIA cards...")); my $results = install_any::configure_pcmcia($o->{modules_conf}, $o->{pcmcia}); undef $w; $results and $o->ask_warn('', $results); } } { my $_w = $o->wait_message(N("IDE"), N("Configuring IDE")); modules::load(modules::category2modules('disk/cdrom')); } modules::interactive::load_category($o, $o->{modules_conf}, 'bus/firewire', 1); my $have_non_scsi = detect_devices::hds(); #- at_least_one scsi device if we have no disks modules::interactive::load_category($o, $o->{modules_conf}, 'disk/ide|scsi|hardware_raid|firewire', 1, !$have_non_scsi); modules::interactive::load_category($o, $o->{modules_conf}, 'disk/ide|scsi|hardware_raid|firewire') if !detect_devices::hds(); #- we really want a disk! install_interactive::tellAboutProprietaryModules($o); install_any::getHds($o, $o); } sub ask_mntpoint_s { #- }{} my ($o, $fstab) = @_; my @fstab = grep { isTrueFS($_) } @$fstab; @fstab = grep { isSwap($_) } @$fstab if @fstab == 0; @fstab = @$fstab if @fstab == 0; die N("No partition available") if @fstab == 0; { my $_w = $o->wait_message('', N("Scanning partitions to find mount points")); install_any::suggest_mount_points($fstab, $o->{prefix}, 'uniq'); log::l("default mntpoint $_->{mntpoint} $_->{device}") foreach @fstab; } if (@fstab == 1) { $fstab[0]{mntpoint} = '/'; } else { $o->ask_from_({ messages => N("Choose the mount points"), interactive_help_id => 'ask_mntpoint_s', }, [ map { { label => partition_table::description($_), val => \$_->{mntpoint}, not_edit => 0, list => [ '', fsedit::suggestions_mntpoint(fs::get::empty_all_hds()) ] } } grep { !$_->{real_mntpoint} || common::usingRamdisk() } @fstab ]) or return; } $o->SUPER::ask_mntpoint_s($fstab); } #------------------------------------------------------------------------------ sub doPartitionDisks { my ($o) = @_; if (arch() =~ /ppc/ && detect_devices::get_mac_generation() =~ /NewWorld/) { #- need to make bootstrap part if NewWorld machine - thx Pixel ;^) if (defined $partition_table::mac::bootstrap_part) { #- don't do anything if we've got the bootstrap setup #- otherwise, go ahead and create one somewhere in the drive free space } else { undef = $partition_table::mac::freepart; #- please "perl -w" my $freepart = $partition_table::mac::freepart; if ($freepart && $freepart->{size} >= 1) { log::l("creating bootstrap partition on drive /dev/$freepart->{hd}{device}, block $freepart->{start}"); $partition_table::mac::bootstrap_part = $freepart->{part}; log::l("bootstrap now at $partition_table::mac::bootstrap_part"); my $p = { start => $freepart->{start}, size => 1 << 11, mntpoint => '' }; fs::type::set_pt_type($p, 0x401); fsedit::add($freepart->{hd}, $p, $o->{all_hds}, { force => 1, primaryOrExtended => 'Primary' }); $new_bootstrap = 1; } else { $o->ask_warn('', N("No free space for 1MB bootstrap! Install will continue, but to boot your system, you'll need to create the bootstrap partition in DiskDrake")); } } } if (!$o->{isUpgrade}) { install_interactive::partitionWizard($o); } } #------------------------------------------------------------------------------ sub rebootNeeded { my ($o) = @_; $o->ask_warn('', N("You need to reboot for the partition table modifications to take place")); install_steps::rebootNeeded($o); } #------------------------------------------------------------------------------ sub choosePartitionsToFormat { my ($o, $fstab) = @_; $o->SUPER::choosePartitionsToFormat($fstab); my @l = grep { !$_->{isMounted} && $_->{mntpoint} && (!isSwap($_) || $::expert) && (!isFat_or_NTFS($_) || $_->{notFormatted} || $::expert) && (!isOtherAvailableFS($_) || $::expert || $_->{toFormat}) } @$fstab; $_->{toFormat} = 1 foreach grep { isSwap($_) && !$::expert } @$fstab; return if @l == 0 || !$::expert && every { $_->{toFormat} } @l; #- keep it temporary until the guy has accepted $_->{toFormatTmp} = $_->{toFormat} || $_->{toFormatUnsure} foreach @l; $o->ask_from_( { messages => N("Choose the partitions you want to format"), interactive_help_id => 'formatPartitions', advanced_messages => N("Check bad blocks?"), }, [ map { my $e = $_; ({ text => partition_table::description($e), type => 'bool', val => \$e->{toFormatTmp} }, if_(!isLoopback($_) && !member($_->{fs_type}, 'reiserfs', 'xfs', 'jfs'), { text => partition_table::description($e), type => 'bool', advanced => 1, disabled => sub { !$e->{toFormatTmp} }, val => \$e->{toFormatCheck} })) } @l ] ) or die 'already displayed'; #- ok now we can really set toFormat foreach (@l) { $_->{toFormat} = delete $_->{toFormatTmp}; set_isFormatted($_, 0); } } sub formatMountPartitions { my ($o, $_fstab) = @_; my $w; catch_cdie { fs::formatMount_all($o->{all_hds}{raids}, $o->{fstab}, $o->{prefix}, sub { my ($msg) = @_; $w ||= $o->wait_message('', $msg); $w->set($msg); }); } sub { $@ =~ /fsck failed on (\S+)/ or return; $o->ask_yesorno('', N("Failed to check filesystem %s. Do you want to repair the errors? (beware, you can lose data)", $1), 1); }; undef $w; #- help perl (otherwise wait_message stays forever in newt) die N("Not enough swap space to fulfill installation, please add some") if availableMemory() < 40 * 1024; } #------------------------------------------------------------------------------ sub setPackages { my ($o, $rebuild_needed) = @_; my $w = $o->wait_message('', $rebuild_needed ? N("Looking for available packages and rebuilding rpm database...") : N("Looking for available packages...")); install_any::setPackages($o, $rebuild_needed); $w->set(N("Looking at packages already installed...")); pkgs::selectPackagesAlreadyInstalled($o->{packages}, $o->{prefix}); if ($rebuild_needed) { $w->set(N("Finding packages to upgrade...")); pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}); } } sub deselectFoundMedia { my ($o, $p) = @_; install_any::deselectFoundMedia($o, $p); } sub mirror2text { $crypto::mirrors{$_[0]} ? $crypto::mirrors{$_[0]}[0] . '|' . $_[0] : "-|URL" } sub askSupplMirror { my ($o, $message) = @_; my $u = $o->{updates} ||= {}; require crypto; my @mirrors = do { my $_w = $o->wait_message('', N("Contacting Mandrakelinux web site to get the list of available mirrors...")); crypto::mirrors($o->{distro_type}); }; push @mirrors, '-'; $o->ask_from_( { messages => N("Choose a mirror from which to get the packages"), cancel => N("Cancel"), }, [ { separator => '|', format => \&mirror2text, list => \@mirrors, val => \$u->{mirror}, }, ], ) or $u->{mirror} = ''; delete $o->{updates}; if ($u->{mirror} eq '-') { return $o->ask_from_entry('', $message) || ''; } my $url = "ftp://$u->{mirror}$crypto::mirrors{$u->{mirror}}[1]"; $url =~ s/\bmedia\/?$//; log::l("mirror chosen [$url]"); return $url; } sub selectSupplMedia { my ($o, $suppl_method) = @_; install_any::selectSupplMedia($o, $suppl_method); } #------------------------------------------------------------------------------ sub choosePackages { my ($o, $packages, $compssUsers, $_first_time) = @_; #- this is done at the very beginning to take into account #- selection of CD by user if using a cdrom. $o->chooseCD($packages) if install_any::method_allows_medium_change($o->{method}) && !$::oem; my $w = $o->wait_message('', N("Looking for available packages...")); my $availableC = &install_steps::choosePackages; my $individual; require pkgs; my $min_size = pkgs::selectedSize($packages); unless ($min_size < $availableC) { undef $w; $o->ask_warn('', N("Your system does not have enough space left for installation or upgrade (%d > %d)", $min_size, $availableC)); install_steps::rebootNeeded($o); } my $min_mark = 4; my $b = pkgs::saveSelected($packages); my %all_compssUsers_flags = map { $_ => 1 } map { @{$_->{flags}} } @$compssUsers; my $_level = pkgs::setSelectedFromCompssList($packages, \%all_compssUsers_flags, $min_mark, 0); my $max_size = pkgs::selectedSize($packages) + 1; #- avoid division by zero. log::l("max size (level $min_mark) is : " . formatXiB($max_size)); pkgs::restoreSelected($b); undef $w; chooseGroups: $o->chooseGroups($packages, $compssUsers, $min_mark, \$individual, $max_size) if !$o->{isUpgrade} && $o->{meta_class} ne 'desktop'; ($o->{packages_}{ind}) = pkgs::setSelectedFromCompssList($packages, $o->{rpmsrate_flags_chosen}, $min_mark, $availableC); $o->choosePackagesTree($packages) or goto chooseGroups if $individual; install_any::warnAboutRemovedPackages($o, $o->{packages}); install_any::warnAboutNaughtyServers($o) or goto chooseGroups if !$o->{isUpgrade} && $o->{meta_class} ne 'firewall'; } sub choosePackagesTree { my ($o, $packages, $o_limit_to_medium) = @_; $o->ask_many_from_list('', N("Choose the packages you want to install"), { list => [ grep { !$o_limit_to_medium || pkgs::packageMedium($packages, $_) == $o_limit_to_medium } @{$packages->{depslist}} ], value => \&URPM::Package::flag_selected, label => \&URPM::Package::name, sort => 1, }); } sub loadSavePackagesOnFloppy { my ($o, $packages) = @_; $o->ask_from('', N("Please choose load or save package selection on floppy. The format is the same as auto_install generated floppies."), [ { val => \ (my $choice), list => [ N_("Load from floppy"), N_("Save on floppy") ], format => \&translate, type => 'list' } ]) or return; if ($choice eq 'Load from floppy') { while (1) { my $w = $o->wait_message(N("Package selection"), N("Loading from floppy")); log::l("load package selection from floppy"); my $O = eval { install_any::loadO(undef, 'floppy') }; if ($@) { undef $w; #- close wait message. $o->ask_okcancel('', N("Insert a floppy containing package selection")) or return; } else { install_any::unselectMostPackages($o); foreach (@{$O->{default_packages} || []}) { my $pkg = pkgs::packageByName($packages, $_); pkgs::selectPackage($packages, $pkg) if $pkg; } return 1; } } } else { log::l("save package selection to floppy"); install_any::g_default_packages($o, 'quiet'); } } sub chooseGroups { my ($o, $packages, $compssUsers, $min_level, $individual, $max_size) = @_; #- for all groups available, determine package which belongs to each one. #- this will enable getting the size of each groups more quickly due to #- limitation of current implementation. #- use an empty state for each one (no flag update should be propagated). my $b = pkgs::saveSelected($packages); install_any::unselectMostPackages($o); pkgs::setSelectedFromCompssList($packages, {}, $min_level, $max_size); my $system_size = pkgs::selectedSize($packages); my ($sizes, $pkgs) = pkgs::computeGroupSize($packages, $min_level); pkgs::restoreSelected($b); log::l("system_size: $system_size"); my %stable_flags = grep_each { $::b } %{$o->{rpmsrate_flags_chosen}}; delete $stable_flags{$_} foreach map { @{$_->{flags}} } @{$o->{compssUsers}}; my $compute_size = sub { my %pkgs; my %flags = %stable_flags; @flags{@_} = (); my $total_size; A: while (my ($k, $size) = each %$sizes) { Or: foreach (split "\t", $k) { foreach (split "&&") { exists $flags{$_} or next Or; } $total_size += $size; $pkgs{$_} = 1 foreach @{$pkgs->{$k}}; next A; } } log::l("computed size $total_size (flags " . join(' ', keys %flags) . ")"); log::l("chooseGroups: ", join(" ", sort keys %pkgs)); int $total_size; }; my ($size, $unselect_all); my $available_size = install_any::getAvailableSpace($o) / sqr(1024); my $size_to_display = sub { my $lsize = $system_size + $compute_size->(map { @{$_->{flags}} } grep { $_->{selected} } @$compssUsers); #- if a profile is deselected, deselect everything (easier than deselecting the profile packages) $unselect_all ||= $size > $lsize; $size = $lsize; N("Total size: %d / %d MB", pkgs::correctSize($size / sqr(1024)), $available_size); }; while (1) { if ($available_size < 200) { # too small to choose anything. Defaulting to no group chosen $_->{selected} = 0 foreach @$compssUsers; last; } $o->reallyChooseGroups($size_to_display, $individual, $compssUsers) or return; last if $::testing || pkgs::correctSize($size / sqr(1024)) < $available_size || every { !$_->{selected} } @$compssUsers; $o->ask_warn('', N("Selected size is larger than available space")); } $o->{rpmsrate_flags_chosen}{$_} = 0 foreach map { @{$_->{flags}} } grep { !$_->{selected} } @$compssUsers; $o->{rpmsrate_flags_chosen}{$_} = 1 foreach map { @{$_->{flags}} } grep { $_->{selected} } @$compssUsers; log::l("compssUsersChoice selected: ", join(', ', map { qq("$_->{path}|$_->{label}") } grep { $_->{selected} } @$compssUsers)); #- do not try to deselect package (by default no groups are selected). $o->{isUpgrade} or $unselect_all and install_any::unselectMostPackages($o); #- if no group have been chosen, ask for using base system only, or no X, or normal. if (!$o->{isUpgrade} && !any { $_->{selected} } @$compssUsers) { my $docs = !$o->{excludedocs}; my $minimal = !any { $_ } values %{$o->{rpmsrate_flags_chosen}}; $o->ask_from(N("Type of install"), N("You haven't selected any group of packages. Please choose the minimal installation you want:"), [ { val => \$o->{rpmsrate_flags_chosen}{X}, type => 'bool', text => N("With X"), disabled => sub { $minimal } }, { val => \$docs, type => 'bool', text => N("With basic documentation (recommended!)"), disabled => sub { $minimal } }, { val => \$minimal, type => 'bool', text => N("Truly minimal install (especially no urpmi)") }, ], changed => sub { $o->{rpmsrate_flags_chosen}{X} = $docs = 0 if $minimal }, ) or return &chooseGroups; $o->{excludedocs} = !$docs || $minimal; #- reselect according to user selection. if ($minimal) { $o->{rpmsrate_flags_chosen}{$_} = 0 foreach keys %{$o->{rpmsrate_flags_chosen}}; } else { my $X = $o->{rpmsrate_flags_chosen}{X}; #- don't let setDefaultPackages modify this one install_any::setDefaultPackages($o, 'clean'); $o->{rpmsrate_flags_chosen}{X} = $X; } install_any::unselectMostPackages($o); } 1; } sub reallyChooseGroups { my ($o, $size_to_display, $individual, $compssUsers) = @_; my $size_text = &$size_to_display; my ($path, $all); $o->ask_from_({ messages => N("Package Group Selection"), interactive_help_id => 'choosePackages', callbacks => { changed => sub { $size_text = &$size_to_display } }, }, [ { val => \$size_text, type => 'label' }, {}, (map { my $old = $path; $path = $_->{path}; if_($old ne $path, { val => translate($path) }), { val => \$_->{selected}, type => 'bool', disabled => sub { $all }, text => translate($_->{label}), help => translate($_->{descr}), } } @$compssUsers), if_($o->{meta_class} eq 'desktop', { text => N("All"), val => \$all, type => 'bool' }), if_($individual, { text => N("Individual package selection"), val => $individual, advanced => 1, type => 'bool' }), ]); if ($all) { $_->{selected} = 1 foreach @$compssUsers; } 1; } sub chooseCD { my ($o, $packages) = @_; my @mediums = grep { $_ != $install_any::boot_medium } pkgs::allMediums($packages); my @mediumsDescr; my %mediumsDescr; if (!common::usingRamdisk()) { #- mono-cd in case of no ramdisk foreach (@mediums) { pkgs::mediumDescr($packages, $install_any::boot_medium) eq pkgs::mediumDescr($packages, $_) and next; undef $packages->{mediums}{$_}{selected}; } log::l("low memory install, using single CD installation (as it is not ejectable)"); return; } #- the boot medium is already selected. $mediumsDescr{pkgs::mediumDescr($packages, $install_any::boot_medium)} = 1; #- build mediumDescr according to mediums, this avoid asking multiple times #- all the medium grouped together on only one CD. foreach (@mediums) { my $descr = pkgs::mediumDescr($packages, $_); $packages->{mediums}{$_}{ignored} and next; exists $mediumsDescr{$descr} or push @mediumsDescr, $descr; $mediumsDescr{$descr} ||= $packages->{mediums}{$_}{selected}; } if (install_any::method_is_from_ISO_images($o->{method})) { $mediumsDescr{$_} = install_any::method_is_from_ISO_images($packages->{mediums}{$_}{method}) ? to_bool(install_any::find_ISO_image_labelled($_)) : 1 foreach @mediumsDescr; } elsif ($o->{method} eq "cdrom") { #- if no other medium available or a poor beginner, we are choosing for him! #- note first CD is always selected and should not be unselected! return if @mediumsDescr == () || !$::expert; # $o->set_help('chooseCD'); $o->ask_many_from_list('', N("If you have all the CDs in the list below, click Ok. If you have none of those CDs, click Cancel. If only some CDs are missing, unselect them, then click Ok."), { list => \@mediumsDescr, label => sub { N("Cd-Rom labeled \"%s\"", $_[0]) }, val => sub { \$mediumsDescr{$_[0]} }, }) or do { $mediumsDescr{$_} = 0 foreach @mediumsDescr; #- force unselection of other CDs. }; } #- restore true selection of medium (which may have been grouped together) foreach (@mediums) { my $descr = pkgs::mediumDescr($packages, $_); $packages->{mediums}{$_}{ignored} and next; $packages->{mediums}{$_}{selected} = $mediumsDescr{$descr}; log::l("select status of medium $_ is $packages->{mediums}{$_}{selected}"); } } #------------------------------------------------------------------------------ sub installPackages { my ($o, $packages) = @_; my ($current, $total) = (0, 0); my $w = $o->wait_message(N("Installing"), N("Preparing installation")); my $old = \&pkgs::installCallback; local *pkgs::installCallback = sub { my ($data, $type, $id, $subtype, $_amount, $total_) = @_; if ($type eq 'user' && $subtype eq 'install') { $total = $total_; } elsif ($type eq 'inst' && $subtype eq 'start') { my $p = $data->{depslist}[$id]; $w->set(N("Installing package %s\n%d%%", $p->name, $total && 100 * $current / $total)); $current += $p->size; } else { goto $old } };