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
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
|
#!/usr/bin/perl
my ($mode, $dir, $reject_dir, $lang) = @ARGV;
$mode =~ s/^--(rebuild|clean)$/$1/ or die "mode should be --rebuild or --clean\n";
-e "$dir/Mandrake/base/hdlists" && -d $reject_dir or die "usage: oem-prepare <--rebuild|--clean> <top_dir> <reject_dir> <lang>\n";
#- detect language used and default options.
open F, "$dir/VERSION" or die "no installation found on $dir";
while (<F>) {
/[\s-]fr/ and $lang = 'fr';
/\[lang[=:]([^]]*)\]/ and $lang = $1;
/\[server\]/ and $options{server} = '';
}
close F;
my ($flang, $charset);
#- default language fall to english ?
foreach ($lang || 'en') {
/fr/ and ($lang, $flang, $charset) = ('fr', 'fr_FR@euro', 'iso-8859-15');
/en/ and ($lang, $flang, $charset) = ('en', 'en_US', 'iso-8859-1');
/de/ and ($lang, $flang, $charset) = ('de', 'de_DE@euro', 'iso-8859-15');
/it/ and ($lang, $flang, $charset) = ('it', 'it_IT@euro', 'iso-8859-15');
/es/ and ($lang, $flang, $charset) = ('es', 'es_ES@euro', 'iso-8859-15');
}
print "Found lang $lang\n";
foreach (keys %options) {
print "Using option [$_" . ($options{$_} && "=$options{$_}") . "]\n";
}
my $packages = select_packages($dir, $lang);
my @media;
open F, "$dir/Mandrake/base/hdlists";
foreach (<F>) {
chomp;
s/\s*#.*$//;
/^\s*$/ and next;
m/^\s*(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file";
push @media, { hdlist => $1, rpmsdir => $2, descr => $3 };
}
close F;
#- keep in mind all the rpm files available (according to hdlists).
my (%rpms, %files);
require packdrake;
foreach my $medium (@media) {
my $packer = new packdrake("$dir/Mandrake/base/$medium->{hdlist}");
foreach (@{$packer->{files}}) {
$packer->{data}{$_}[0] eq 'f' or next;
my ($fullname, $file) = /([^:]*):(.*)/ ? ($1, "$2.rpm") : ($_, "$_.rpm");
$files{$fullname} = $file;
$rpms{$file} = $medium->{rpmsdir};
-e "$dir/$medium->{rpmsdir}/$file" and next; #- already exist in the right directory.
if (-e "$reject_dir/$file") {
$mode eq 'rebuild' and system "mv", "-f", "$reject_dir/$file", "$dir/$medium->{rpmsdir}/";
next;
}
print STDERR "unable to find package $file listed in medium \"$medium->{descr}\"\n";
}
}
if ($mode eq 'clean') {
#- copy and install from each cd image.
foreach my $medium (@media) {
print "Examining packages from medium labeled \"$medium->{descr}\"\n";
foreach my $pkg (@{$packages->{depslist}}) {
$pkg->{closure} && !$pkg->{selected} or next;
my $file = "$dir/$medium->{rpmsdir}/" . $files{rpm_fullname($pkg)};
if (-e $file) {
delete $rpms{$files{rpm_fullname($pkg)}} or next;
print " copying $file\n";
delete $pkg->{closure};
}
}
if (my $pkg = pkgs::packageByName($packages, 'glibc')) { #- HACK FOR GLIBC
if ($pkg->{selected}) {
my $file = "$dir/$medium->{rpmsdir}/" . $files{rpm_fullname($pkg)};
if (-e $file) {
delete $rpms{$files{rpm_fullname($pkg)}} or next;
print " installing $file\n";
delete $pkg->{selected};
}
}
} else {
die "no glibc package found";
}
foreach my $pkg (@{$packages->{depslist}}) {
$pkg->{selected} or next;
my $file = "$dir/$medium->{rpmsdir}/" . $files{rpm_fullname($pkg)};
if (-e $file) {
delete $rpms{$files{rpm_fullname($pkg)}} or next;
print " installing $file\n";
delete $pkg->{selected};
}
}
scalar(grep { $_->{selected} || $_->{closure} } @{$packages->{depslist}}) == 0 and last;
}
#- copy files.
#- at this point, everything left in %rpms has to be moved to $reject_dir.
foreach (keys %rpms) {
-e "$reject_dir/$_" and next; #- already cleaned.
-e "$dir/$rpms{$_}/$_" or print STDERR "file \"$_\" should be in [$dir/$rpms{$_}]\n", next;
system "mv", "-f", "$dir/$rpms{$_}/$_", $reject_dir;
}
}
#- provide package fullname that have to be installed and copied.
sub select_packages {
my ($dir, $lang) = @_;
my $o = { packages => read_depslist("$dir/Mandrake/base/depslist.ordered") };
#- act as DrakX will do to select packages.
pkgs::read_rpmsrate($o->{packages}, install_any::getFile("Mandrake/base/rpmsrate") || die "unable to read rpmsrate");
($o->{compssUsers}, $o->{compssUsersSorted}, $o->{compssUsersIcons}, $o->{compssUsersDescr}) =
pkgs::readCompssUsers($o->{packages}, $o->{meta_class});
eval { install_any::getFile("XXX") }; #- close out any still opened filehandle..
pkgs::selectPackage($o->{packages}, pkgs::packageByName($o->{packages}, 'basesystem') || die "no basesystem package found");
#- by default, choose:
$o->{compssUsersChoice}{$_} = 1 foreach 'GNOME', 'KDE', 'CONFIG', 'X';
$o->{compssUsersChoice}{$_} = 1
foreach map { @{$o->{compssUsers}{$_}{flags}} } 'Workstation|Office Workstation', 'Workstation|Internet station';
if (exists $options{server}) {
foreach (qw(KDE ACCESSIBILITY PUBLISHING CUPS EDITORS TEXT_TOOLS COMMUNICATIONS TERMINALS
NETWORKING_FILE_TRANSFER NETWORKING_OTHER
NETWORKING_FILE_TRANSFER_SERVER NETWORKING_FIREWALLING_SERVER NETWORKING_LDAP_SERVER
NETWORKING_MAIL_SERVER NETWORKING_OTHER_SERVER
NETWORKING_REMOTE_ACCESS NETWORKING_REMOTE_ACCESS_SERVER NETWORKING_DNS NETWORKING_DNS_SERVER
NETWORKING_FILE NETWORKING_FILE_SERVER NETWORKING_WWW NETWORKING_WWW_SERVER
ARCHIVING DEVELOPMENT MONITORING FILE_TOOLS CONFIG BOOKS SYSTEM X DOCS)) {
$o->{compssUsersChoice}{$_} = 1;
}
#- additional packages to be selected for server, databases with MySQL (avoid rpmsrate modifications).
foreach (qw(MySQL-client MySQL-shared MySQL perl-Mysql)) {
my $pkg = pkgs::packageByName($o->{packages}, $_);
$pkg and pkgs::selectPackage($o->{packages}, $pkg);
}
} else {
$o->{compssUsersChoice}{$_} = 1 foreach map { @{$o->{compssUsers}{$_}} } @{$o->{compssUsersSorted}};
$o->{compssUsersChoice}{$_} = 1 foreach qw(SYSTEM X DOCS);
@{$o->{compssUsersChoice}}{grep { /SERVER|DATABASES/ } keys %{$o->{compssUsersChoice}}} = ();
}
my $lang_pkg = $lang && pkgs::packageByName($o->{packages}, "locales-$lang");
if ($lang_pkg) {
pkgs::selectPackage($o->{packages}, $lang_pkg);
$o->{compssUsersChoice}{qq(LOCALES"$lang")} = 1;
$o->{compssUsersChoice}{qq(LOCALES"$flang")} = 1;
$o->{compssUsersChoice}{qq(CHARSET"$charset")} = 1;
}
pkgs::setSelectedFromCompssList($o->{packages}, $o->{compssUsersChoice}, 4, 0);
#- save selected, but keep selected property.
foreach my $pkg (@{$o->{packages}{depslist}}) {
$pkg->{selected} and $pkg->{save_selected} = $pkg->{selected};
}
#- extend selection to closure now, make all selected as closure and restore selected after.
$o->{compssUsersChoice}{$_} = 1 foreach qw(BURNER DVD PCMCIA BIGMEM SMP 3D TV SCANNER PHOTO SOUND);
pkgs::setSelectedFromCompssList($o->{packages}, $o->{compssUsersChoice}, 4, 0);
$o->{compssUsersChoice}{$_} = 0 foreach qw(BURNER DVD PCMCIA BIGMEM SMP 3D TV SCANNER PHOTO SOUND);
#- INSTALL class need to be copied as closure (unless installed after).
#- but we have to remove kernel22 and kernel22-smp now obsolete for oem.
foreach (@{$o->{packages}{needToCopy}}) {
/^(kernel22.*|raidtools|lvm|reiserfsprogs|xfsprogs|jfsprogs|XFree86-(Mach8|Mach32|Mono|W32|3DLabs|P9000|8514|VGA16|I128|AGX))$/ and next;
my $pkg = pkgs::packageByName($o->{packages}, $_);
pkgs::selectPackage($o->{packages}, $pkg);
}
#- first select package that have to go to closure according to their names.
foreach my $pkg (@{$o->{packages}{depslist}}) {
$pkg->{name} =~ /kernel-(\d|smp|enterprise)/ and pkgs::selectPackage($o->{packages}, $pkg);
$pkg->{name} =~ /NVIDIA/ and pkgs::selectPackage($o->{packages}, $pkg);
}
foreach my $pkg (@{$o->{packages}{depslist}}) {
delete $pkg->{selected} && !$pkg->{save_selected} and $pkg->{closure} = 1;
$pkg->{save_selected} and $pkg->{selected} = $pkg->{save_selected};
}
#- package that have to selected here as a bonus for oem install.
foreach (qw(cups cups-drivers a2ps drakprofile draksync numlock icewm-light
Mesa Mesa-demos alsa alsa-utils curl
glibc vim-minimal kernel gcc-cpp
), exists $options{server} ? qw(openldap-migration openldap-clients pam_ldap) : ()) {
my $pkg = pkgs::packageByName($o->{packages}, $_);
$pkg and pkgs::selectPackage($o->{packages}, $pkg);
}
#- special packages that are to be move to closure always ...
foreach (qw(nfs-utils-client numlock usbd hotplug alsa alsa-utils
Aurora Aurora-Monitor-NewStyle-Categorizing-WsLib bootsplash)) {
my $pkg = pkgs::packageByName($o->{packages}, $_);
if ($pkg) {
pkgs::selectPackage($o->{packages}, $pkg);
$pkg->{closure} = 1;
delete $pkg->{selected};
}
}
#- special packages that are to be removed always... BEWARE THIS IS A HACK !!!
# foreach (qw(gmc gcc3.0 gcc3.0-c++ gcc3.0-cpp libstdc++3.0 libstdc++3.0-devel)) {
# my $pkg = pkgs::packageByName($o->{packages}, $_);
# if ($pkg) {
# delete $pkg->{closure};
# delete $pkg->{selected};
# }
# }
$o->{packages};
}
sub chop_version {
($_[0] =~ /^([^:\s]*)-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*(?::\S*)?/)[0] || die "unable to parse $_[0]";
}
sub rpm_fullname {
($_[0]{name} =~ /^([^:\s]*-[^:\-\s]+-[^:\-\s]+\.[^:\.\-\s]*)(?::\S*)?/)[0] || die "unable to parse $_[0]";
}
sub read_depslist {
my ($file) = @_;
my $packages = { depslist => [], names => {} };
#- read depslist.oredered file.
my $id = 0;
open F, "$file" or die "unable to open ordered dependencies list file";
while (<F>) {
my ($name, $size, @deps) = split;
push @{$packages->{depslist}}, { id => $id++, name => $name, size => $size, deps => \@deps };
}
close F;
foreach (@{$packages->{depslist}}) {
$packages->{names}{chop_version($_->{name})} = $_;
}
print "read " . scalar(@{$packages->{depslist}}) . " package dependancies\n";
$packages;
}
#- compability method for the below ones, wrap DrakX code extracted.
package log;
sub l {}
package detect_devices;
sub matching_desc { 0 }
package install_any;
sub getFile { open FILE, "$dir/$_[0]" or return; \*FILE }
package pkgs;
sub if_ { my $b = shift; $b or return (); wantarray ? @_ : $_[0] }
sub formatXiB { $_[0] } #- NOP
sub packageName { ::chop_version($_[0]{name}) }
sub packageFlagSelected { $_[0]{selected} }
sub packageSize { $_[0]{size} }
sub packageDepsId { @{$_[0]{deps}} }
sub packageRate { $_[0]{values}[0] }
sub packageRateRFlags { @{$_[0]{values}} }
sub packageSetRateRFlags {
my ($pkg, @rate_rflags) = @_;
$pkg->{values} = [ @rate_rflags ];
}
sub packageByName {
my ($packages, $name) = @_;
$packages->{names}{$name};
}
sub packageById {
my ($packages, $id) = @_;
$packages->{depslist}[$id];
}
sub selectedSize {
my ($packages) = @_;
my $size = 0;
foreach (@{$packages->{depslist}}) {
$_->{selected} and $size += $_->{size};
}
$size;
}
my @preferred = qw(perl-GTK postfix gcc gcc-cpp gcc-c++ proftpd ghostscript-X vim-minimal kernel db1 db2 ispell-en Bastille-Curses-module nautilus libxpm4);
sub selectPackage {
my ($packages, $pkg, $base, $otherOnly, $check_recursion) = @_;
#- avoid infinite recursion (mainly against badly generated depslist.ordered).
$check_recursion ||= {}; exists $check_recursion->{$pkg->{name}} and return; $check_recursion->{$pkg->{name}} = undef;
#- make sure base package are set even if already selected.
$base and $pkg->{base} = 1;
#- select package and dependancies, otherOnly may be a reference
#- to a hash to indicate package that will strictly be selected
#- when value is true, may be selected when value is false (this
#- is only used for unselection, not selection)
unless ($pkg->{selected}) {
foreach (@{$pkg->{deps}}) {
my $preferred;
if (/\|/) {
#- choice deps should be reselected recursively as no
#- closure on them is computed, this code is exactly the
#- same as pixel's one.
my %preferred; @preferred{@preferred} = ();
foreach (split '\|') {
my $dep = $packages->{depslist}[$_] or next;
$preferred ||= $dep;
$dep->{selected} and $preferred = $dep, last;
exists $preferred{::chop_version($dep->{name})} and $preferred = $dep;
}
selectPackage($packages, $preferred, $base, $otherOnly, $check_recursion) if $preferred;
} else {
#- deps have been closed except for choices, so no need to
#- recursively apply selection, expand base on it.
my $dep = $packages->{depslist}[$_];
$base and $dep->{base} = 1;
$otherOnly and !$dep->{selected} and $otherOnly->{::chop_version($dep->{name})} = 1;
$otherOnly or $dep->{selected} += 1;
}
}
}
$otherOnly and !$pkg->{selected} and $otherOnly->{::chop_version($pkg->{name})} = 1;
$otherOnly or $pkg->{selected} += 1;
1;
}
#- this code is extracted from DrakX and SHOULD NOT BE MODIFIED, wrapper method exists above to provide a good choice.
sub read_rpmsrate {
my ($packages, $f) = @_;
my $line_nb = 0;
my $fatal_error;
my (@l);
while (<$f>) {
$line_nb++;
/\t/ and die "tabulations not allowed at line $line_nb\n";
s/#.*//; # comments
my ($indent, $data) = /(\s*)(.*)/;
next if !$data; # skip empty lines
@l = grep { $_->[0] < length $indent } @l;
my @m = @l ? @{$l[$#l][1]} : ();
my ($t, $flag, @l2);
while ($data =~
/^((
[1-5]
|
(?: (?: !\s*)? [0-9A-Z_]+(?:".*?")?)
(?: \s*\|\|\s* (?: !\s*)? [0-9A-Z_]+(?:".*?")?)*
)
(?:\s+|$)
)(.*)/x) { #@")) {
($t, $flag, $data) = ($1,$2,$3);
while ($flag =~ s,^\s*(("[^"]*"|[^"\s]*)*)\s+,$1,) {}
my $ok = 0;
$flag = join('||', grep {
if (my ($inv, $p) = /^(!)?HW"(.*)"/) {
($inv xor detect_devices::matching_desc($p)) and $ok = 1;
0;
} else {
1;
}
} split '\|\|', $flag);
push @m, $ok ? 'TRUE' : $flag || 'FALSE';
push @l2, [ length $indent, [ @m ] ];
$indent .= $t;
}
if ($data) {
# has packages on same line
my ($rate) = grep { /^\d$/ } @m or die sprintf qq(missing rate for "%s" at line %d (flags are %s)\n), $data, $line_nb, join('&&', @m);
foreach (split ' ', $data) {
if ($packages) {
my $p = packageByName($packages, $_) or next;
my @m2 =
map { if_($_ && packageName($_) =~ /locales-(.*)/, qq(LOCALES"$1")) }
map { packageById($packages, $_) } packageDepsId($p);
my @m3 = ((grep { !/^\d$/ } @m), @m2);
if (@m3 >= 1 && $m3[0] eq 'INSTALL' || @m3 >=2 && $m3[1] eq 'INSTALL') {
push @{$packages->{needToCopy} ||= []}, $_;
next; #- don't need to put INSTALL flag for a package.
}
if (packageRate($p)) {
my ($rate2, @m4) = packageRateRFlags($p);
if (@m3 > 1 || @m4 > 1) {
log::l("can't handle complicate flags for packages appearing twice ($_)");
$fatal_error++;
}
log::l("package $_ appearing twice with different rates ($rate != $rate2)") if $rate != $rate2;
packageSetRateRFlags($p, $rate, "$m3[0]||$m4[0]");
} else {
packageSetRateRFlags($p, $rate, @m3);
}
} else {
print "$_ = ", join(" && ", @m), "\n";
}
}
push @l, @l2;
} else {
push @l, [ $l2[0][0], $l2[$#l2][1] ];
}
}
$fatal_error and die "$fatal_error fatal errors in rpmsrate";
}
sub readCompssUsers {
my ($packages, $meta_class) = @_;
my (%compssUsers, %compssUsersIcons, , %compssUsersDescr, @sorted, $l);
my (%compss);
my $file = 'Mandrake/base/compssUsers';
my $f = $meta_class && install_any::getFile("$file.$meta_class") || install_any::getFile($file) or die "can't find $file";
local $_;
while (<$f>) {
/^\s*$/ || /^#/ and next;
s/#.*//;
if (/^(\S.*)/) {
my ($icon, $descr);
/^(.*?)\s*\[icon=(.*?)\](.*)/ and $_ = "$1$3", $icon = $2;
/^(.*?)\s*\[descr=(.*?)\](.*)/ and $_ = "$1$3", $descr = $2;
$compssUsersIcons{$_} = $icon;
$compssUsersDescr{$_} = $descr;
push @sorted, $_;
$compssUsers{$_} = $l = [];
} elsif (/^\s+(.*?)\s*$/) {
push @$l, $1;
}
}
\%compssUsers, \@sorted, \%compssUsersIcons, \%compssUsersDescr;
}
sub setSelectedFromCompssList {
my ($packages, $compssUsersChoice, $min_level, $max_size, $otherOnly) = @_;
$compssUsersChoice->{TRUE} = 1; #- ensure TRUE is set
my $nb = selectedSize($packages);
foreach my $p (sort { packageRate($b) <=> packageRate($a) } values %{$packages->{names}}) {
my ($rate, @flags) = packageRateRFlags($p);
next if
!$rate || $rate < $min_level ||
grep { !grep { /^!(.*)/ ? !$compssUsersChoice->{$1} : $compssUsersChoice->{$_} } split('\|\|') } @flags;
#- determine the packages that will be selected when
#- selecting $p. the packages are not selected.
my %newSelection;
selectPackage($packages, $p, 0, \%newSelection);
#- this enable an incremental total size.
my $old_nb = $nb;
foreach (grep { $newSelection{$_} } keys %newSelection) {
$nb += packageSize($packages->{names}{$_});
}
if ($max_size && $nb > $max_size) {
$nb = $old_nb;
$min_level = packageRate($p);
last;
}
#- at this point the package can safely be selected.
if ($otherOnly) {
selectPackage($packages, $p, 0, $otherOnly);
} else {
selectPackage($packages, $p);
}
}
unless ($otherOnly) {
log::l("setSelectedFromCompssList: reached size ", formatXiB($nb), ", up to indice $min_level (less than ", formatXiB($max_size), ")");
log::l("setSelectedFromCompssList: ", join(" ", sort map { packageName($_) } grep { packageFlagSelected($_) } @{$packages->{depslist}}));
}
$min_level;
}
|