source: soft/build_system/build_system/mkcd/tags/V3_8_6_1mdk/pm/Mkcd/Disc.pm @ 1

Last change on this file since 1 was 1, checked in by fasma, 12 years ago

Initial Import from Mandriva's soft revision 224062 and package revision 45733
File size: 15.2 KB
Line 
1package Mkcd::Disc;
2
3my $VERSION = '0.1.1';
4
5use strict;
6use File::Path;
7use Mkcd::Functions;
8use Mkcd::Tools qw(du compute_md5 log_ include_md5);
9use Mkcd::Package qw(list_hdlist);
10
11=head1 NAME
12
13Disc - mkcd disc functions
14
15=head1 SYNOPSYS
16
17    require Mkcd::Disc;
18
19=head1 DESCRIPTION
20
21C<Mkcd::Disc> include the mkcd disc handling subroutines.
22
23=head1 SEE ALSO
24
25mkcd
26
27=head1 COPYRIGHT
28
29Copyright (C) 2000,2001 MandrakeSoft <warly@mandrakesoft.com>
30
31This program is free software; you can redistribute it and/or modify
32it under the terms of the GNU General Public License as published by
33the Free Software Foundation; either version 2, or (at your option)
34any later version.
35
36This program is distributed in the hope that it will be useful,
37but WITHOUT ANY WARRANTY; without even the implied warranty of
38MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
39GNU General Public License for more details.
40
41You should have received a copy of the GNU General Public License
42along with this program; if not, write to the Free Software
43Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
44
45=cut
46
47my $config;
48
49sub new {
50    my ($class, $conf) = @_;
51    $config = $conf;
52    bless {
53           config       => $conf,
54           functions    => new Mkcd::Functions($config)
55          }, $class;
56}
57
58# FIXME must add space for synthesis, however they are negligeable compared to hdlist. Only
59# a pb with very small CD.
60
61sub guessHdlistSize {
62    my ($class, $group, $size, $cdsize, $lists, $discsFiles) = @_;
63    my $FACTOR = 130;
64    my $SynFACTOR = 90;
65    my $msg;
66    my $depsRep = "$config->{tmp}/$class->{config}{name}/$group->{depsrep}";
67    $msg = "guessHdlistSize: depsRep $depsRep\n";
68    # FIXME heuristic for hdlist size on installation disc, (RPMS size / $FACTOR) per discs
69    # need genDeps to write hdlist/synthesis, overkill
70    my $depsSize = du($depsRep);
71    my $instdisc = $group->{installDisc};
72    my $sz;
73    my (@notdone, @rem_size);
74    push @rem_size, @$cdsize;
75    foreach my $list (keys %{$group->{list}}) {
76        if ($config->{list}[$list]{auto}) {
77            if ($config->{list}[$list]{cd}) {
78                my $tsize = ($config->{discsize}/$FACTOR) * $config->{list}[$list]{cd}; 
79                $sz += $tsize < $depsSize ? $tsize : $depsSize;
80            } else {
81                $sz += $depsSize
82            }
83        } else {
84            my $ok;
85            my $listsize = $group->{listsize}{$list}{rpm};
86            foreach my $rd (@{$group->{list}{$list}{rpm}}) {
87                my ($cdrep, undef, undef, $opt) = @$rd;
88                if ($opt->{nodeps}) { $ok = 1; next }
89                if ($lists->{$cdrep}) {
90                    if ($listsize > $cdsize->[$cdrep]) {
91                        $sz += $rem_size[$cdrep] / $FACTOR;
92                        $listsize -= $rem_size[$cdrep];
93                        $rem_size[$cdrep] = 0
94                    } else {
95                        $sz += $listsize / $FACTOR;
96                        $rem_size[$cdrep] -= $listsize;
97                        last
98                    }
99                }
100            }
101            $ok and push @notdone, $list       
102        }
103    }
104    $msg .= "guessHdlistSize: reserving ";
105    if ($depsSize < $sz && $depsSize > 10000) { 
106        $msg .= $depsSize;
107        $size->{disc}[$instdisc] += int $depsSize;
108        if ($config->{disc}[$instdisc]{function}{data}{installation}[1]{synthesis}) { $size->{disc}[$instdisc] += int($depsSize / $SynFACTOR) }
109    } elsif ($sz > 10000) { 
110        $msg .= $sz; 
111        $size->{disc}[$instdisc] += int $sz;
112        if ($config->{disc}[$instdisc]{function}{data}{installation}[1]{synthesis}) { $size->{disc}[$instdisc] += int($sz / $SynFACTOR) }
113    } else {
114        log_("ERROR guessHdlistSize: possibly wrong estimated dependencies file size\n", $config->{verbose}, $config->{LOG},2) 
115    }
116    $msg .= " (new size $size->{disc}[$instdisc]) on disc $instdisc ($depsSize/$sz) for dependencies files\n";
117    log_($msg, $config->{verbose}, $config->{LOG},2);
118    @notdone or return 1;
119    $sz = 0;
120    foreach my $list (@notdone) {
121        foreach my $rd (@{$group->{list}{$list}{rpm}}) {
122            my ($cd, $rep, $repopt, $opt) = @$rd;
123            if ($lists->{$cd} == 1) {
124                $sz += du("$class-{config}{topdir}/build/$class->{config}{name}/$cd/$class->{config}{disc}[$cd]{function}{data}{dir}{$rep}[1]{reploc}")
125            } elsif ($lists->{$cd} == 2) {
126                foreach my $rpm (keys %{$discsFiles->[$cd]{$rep}{$list}}) {
127                    $sz += du("$discsFiles->[$cd]{$rep}{$list}{$rpm}/$rpm.rpm")
128                }
129            }
130        }
131    }
132    $sz /= $FACTOR;
133    $msg = "guessHdlistSize: reserving $sz";
134    $size->{disc}[$instdisc] += $sz;
135    if ($config->{disc}[$instdisc]{function}{data}{installation}[1]{synthesis}) { $size->{disc}[$instdisc] += $sz / $SynFACTOR }
136    $msg .= " (new size $size->{disc}[$instdisc]) on disc $instdisc ($sz) for extra dependencies files\n";
137    log_($msg, $config->{verbose}, $config->{LOG},1)
138}               
139
140sub getBuiltDiscs {
141    my ($class, $lists, $group, $discsFiles) = @_;
142    foreach my $l (keys %{$group->{list}}) {
143        log_("getBuiltDiscs: get rep from list $l\n", $config->{verbose}, $config->{LOG},2);
144        my @rpmlist;
145        ref $group->{list}{$l}{rpm} and push @rpmlist, @{$group->{list}{$l}{rpm}};
146        ref $group->{list}{$l}{srpm} and push @rpmlist, @{$group->{list}{$l}{srpm}};
147        for (my $i; $i < @rpmlist; $i++) {
148            my ($cd, $rep, $repopt, $opt) = @{$rpmlist[$i]};
149            $lists->{$cd} == 1 or next;
150            $class->{config}{list}[$l]{disc}{$cd}{$rep}{done} = 1;
151            if ($opt->{hdlist}) {
152                log_("getBuiltDiscs: getting rpm from hdlist $opt->{hdlist}\n", $config->{verbose}, $config->{LOG},2);
153                my $tmphdlist = "$class->{config}{tmp}/.mkcd_build_hdlist";
154                foreach (@{list_hdlist([$opt->{hdlist}], $config->{verbose}, 1, $tmphdlist)}) {
155                    log_("getBuiltDiscs: adding $_\n", $config->{verbose}, $config->{LOG},6);
156                    $discsFiles->[$cd]{$rep}{$l}{$_} = ''
157                }
158            } else { 
159                my $dir = "$class->{config}{topdir}/build/$class->{config}{name}/$cd/$class->{config}{disc}[$cd]{function}{data}{dir}{$rep}[1]{reploc}";
160                #
161                # FIXME maybe need to unshift instead of push
162                #
163                $repopt->{source} ? push(@{$class->{config}{list}[$l]{packages}[0]{srpm}}, $dir) : push(@{$class->{config}{list}[$l]{packages}[0]{rpm}}, $dir);
164                log_("getBuiltDiscs: get files from $dir\n", $config->{verbose}, $config->{LOG},2);
165                opendir my $A, $dir;
166                foreach (readdir $A) {
167                    /(.*)\.rpm/ or next;
168                    # FIXME need to check if it is well placed in getList function
169                    # $group->{done}{$rpm} = $group->{orderedrep}{"$cd/$rep"};
170                    $discsFiles->[$cd]{$rep}{$l}{$1} = $dir
171                }
172            }
173        }
174    }
175    1
176}
177
178sub write_graft {
179    my ($graft, $file, $exclude) = @_;
180    log_("write_graft: $file ($graft)\n", $config->{verbose}, $config->{LOG},2); 
181    open my $A, ">$file";
182    open my $B, ">$exclude";
183    foreach my $d (sort keys %$graft) {
184        if (ref $graft->{$d}) {
185            map { print $A "$d=$_\n" } keys %{$graft->{$d}}
186        } elsif ($graft->{$d} == 3) {
187            print $B "$d\n"
188        }
189    }
190}
191
192sub graft_to_md5 {
193    my ($graft, $dir, $serial) = @_;
194    my $mdfile = ".$serial.md5";
195    log_("graft_to_md5: $serial -> $dir/$mdfile ($graft)\n", $config->{verbose}, $config->{LOG},2); 
196    local *A; open A, ">$dir/$mdfile";
197    my %ignore;
198    my @to_check;
199    $graft->{$mdfile}{"$dir/$mdfile"} = 0;
200    foreach my $f (keys %$graft) { 
201        if (ref $graft->{$f}) { 
202            foreach (keys %{$graft->{$f}}) {
203                my ($file) = m,/([^/]+)$,;
204                my $dest = $f =~ m,/$, ? "/$f/$file" : "/$f";
205                if ($graft->{$f}{$_}) {
206                    push @to_check, [ $dest, $_ ];
207                } else {
208                    $ignore{$dest} = 1;
209                    print A "$f\n"
210                }
211            }
212        } else {
213            $ignore{$f} = 1;
214            print A "$f\n"
215        }
216    }
217    my $digest = compute_md5(\@to_check, \%ignore);
218    print A "$digest - $serial\n"
219}   
220
221sub makeDiscs {
222    my ($class, $fixed, $lists, $cds, $size, $mkisos, $discsFile, $graft, $sort, $inode, $cdfile) = @_;
223    my $dir;
224    my $name = $class->{config}{name};
225    my $topdir = $class->{config}{topdir};
226    my $tmp = "$config->{tmp}/build/$name";
227    my $first;
228    my $isodir = $class->{config}{isodir} ? $class->{config}{isodir} : "$topdir/iso/$name";
229   
230    if (!$class->{config}{nolive}) {
231        $dir = "$topdir/build/$name";
232        -d $dir or mkpath $dir;
233        -d $tmp or mkpath $tmp;
234    } else {
235        $dir = "$config->{tmp}/build/$name";
236        -d $dir or mkpath $dir;
237    }
238    if ($fixed == -1) {
239        buildISO($class->{config}, $isodir, $name, $lists, $fixed, $mkisos, $size, $cds, $cdfile, $sort, $first, 0);
240        return 1
241    }
242    log_("makeDiscs: Discs @$cds topdir $dir\n", $config->{verbose}, $config->{LOG},1);
243    foreach my $i (@$cds) {
244        $lists->{$i} > 1 or next;
245        my $cd = $class->{config}{disc}[$i];
246        $graft->{$i} ||= {};
247        $sort ||= {};
248        if ($fixed > 1 && $cdfile->[$i] == 0) {
249            log_("makeDiscs: nothing to do for disc $i\n", $config->{verbose}, $config->{LOG},2);
250            next
251        }
252        if (!$fixed) {
253            log_("makeDisc: Fixed part of disc $i\n", $config->{verbose}, $config->{LOG},3);
254            if ($class->{config}{nolive}) {
255                log_("makeDisc: removing $dir/$i.list\n", $config->{verbose}, $config->{LOG},3);
256                -f "$dir/$i.list" and unlink "$dir/$i.list";
257                log_("makeDisc: removing $dir/$i\n", $config->{verbose}, $config->{LOG},3);
258                rmtree "$dir/$i";
259                mkdir "$dir/$i"
260            } else {
261                -d "$tmp/$i" or mkpath "$tmp/$i";
262                foreach ("$topdir/build/$name/$i", "$topdir/build/$name/first/$i") { rmtree $_; mkdir $_ }
263                $first = "$topdir/build/$name/first/$i"
264            }
265        } else { log_("Finalizing disc $i\n", $config->{verbose}, $config->{LOG},2) }
266        my $sz;
267        if (ref $cd->{steps}) {
268            for (my $j; $j < @{$cd->{steps}}; $j++) {
269                my $name = $cd->{steps}[$j][0];
270                log_("makeDiscs: $name ($fixed)\n", $config->{verbose}, $config->{LOG},2);
271                if (defined $Mkcd::Functions::{$name}) {
272                    $sz += &{$Mkcd::Functions::{$name}}($class->{disc}{functions}, $cd->{steps}[$j], $dir, $fixed, $class->{config}{nolive}, $i, $cd, $cdfile, $lists, $mkisos, $graft, $inode->{$i}, $discsFile, $sort)
273                }
274                else { log_("ERROR: unrecognized function name $name\n",0, $config->{LOG}) }
275                log_("SIZE ($name) $sz\n", $config->{verbose}, $config->{LOG},4);
276            }
277        } else {
278            die "FATAL make_discs: impossible to find definition of disc $i, problem in config file ?"
279        }
280        if ($class->{config}{nolive}) {
281            log_("SIZE $size->{disc}[$i] + $sz\n", $config->{verbose}, $config->{LOG},4);
282            $size->{disc}[$i] += $sz
283        } else {
284            $size->{disc}[$i] = du("$dir/$i") + $sz
285        }
286        log_("disc $i ($dir/$i) size: $size->{disc}[$i] ($sz)\n", $config->{verbose}, $config->{LOG},3);
287        my $mkisoopt = $class->{config}{mkisoopt};
288        if ($fixed) {
289            $graft->{$i}{".rr_moved"} = 0;
290            my $publisher = $config->{Publisher} || $config->{disc}[$i]{Publisher};
291            my $commkiso = qq(-A "$cd->{appname}" -P "$publisher" -volset "$cd->{serial}" -V "$cd->{label}" -o $isodir/$i-$name.iso);
292            if ($config->{nolive}) {
293                # include_md5 replaces md5 per files
294                #graft_to_md5($graft->{$i},"$dir/$i",$cd->{serial});
295                write_graft($graft->{$i}, "$dir/$i.list", "$dir/$i-exclude.list");
296                #$mkisos->[$i] = "$mkisoopt -graft-points -path-list $dir/$i.list -sort $dir/$i.sort " . (-f "$dir/$i-exclude.list" ? "-exclude-list $dir/$i-exclude.list" : "") . " $commkiso $mkisos->[$i]" if $fixed == 1
297                $mkisos->[$i] = "$mkisoopt -graft-points -path-list $dir/$i.list " . (-f "$dir/$i-exclude.list" ? "-exclude-list $dir/$i-exclude.list" : "") . " $commkiso $mkisos->[$i]" if $fixed == 1
298            } else {
299                $graft->{$i}{"/"}{"$dir/$i/"} = 1;
300                # include_md5 replaces md5 per files
301                #graft_to_md5($graft->{$i},"$dir/$i",$cd->{serial});
302                if ($mkisos->[$i]) {
303                    $mkisos->[$i] = "$mkisoopt $commkiso $mkisos->[$i] $dir/$i" if $fixed == 1
304                } else {
305                    $mkisos->[$i] = qq($mkisoopt $commkiso "$dir/$i") if $fixed == 1
306                }
307            }
308        }
309    }
310    !$fixed and return 1;
311    buildISO($class->{config}, $isodir, $name, $lists, $fixed, $mkisos, $size, $cds, $cdfile, $sort, $first, 1);
312    1
313}
314
315sub buildISO {
316    my ($config, $isodir, $name, $lists, $fixed, $mkisos, $size, $cds, $cdfile, $sort, $first, $checksize) = @_;
317    my $log = $config->{LOG};
318    $isodir or return;
319    -d $isodir or mkpath $isodir;
320    log_("buildISO: isodir $isodir\n", $config->{verbose}, $config->{LOG}, 5);
321    my $dir = "$config->{tmp}/build/$name";
322    compute_sort_file($sort, $cds, $dir, $first) if !$checksize;
323    foreach my $i (@$cds) {
324        $lists->{$i} > 1 or next;
325        if ($fixed > 1 && $cdfile->[$i] == 0) {
326            log_("buildISO: nothing to do for disc $i\n",0, $config->{LOG});
327            next
328        }
329        my $sort_cmd = "-sort $dir/$i.sort " if ref $sort->{$i};
330        my $cmd = $checksize ? "mkisofs -print-size -quiet $mkisos->[$i]" : "mkisofs $sort_cmd$mkisos->[$i]";
331        if ($checksize) {
332            $size->{disc}[$i] = 1024 * 2 * `$cmd`;
333            log_("MKISOFS disc $i size $size->{disc}[$i]\n", $config->{verbose}, $config->{LOG},1);
334        } elsif (!$config->{noiso}) {
335            $cmd .= " > /dev/null" if !$config->{verbose};
336            my $err = system $cmd;
337            log_("disc $i: $cmd\n", 1, $config->{LOG});
338            if ($err) {
339                log_("ERROR: disc $i $cmd failed ($!)\n", 1, $config->{LOG});
340                print $log "WARNING: a problem may have appear, if ISOs files are not OK and you want to retry to build the ISOs, type the following command:
341                $cmd\n "
342            }
343            my $boot_cat_location = `isoinfo -l -R -i $isodir/$i-$name.iso`;
344            $boot_cat_location =~ /.*\[\s*(\d+) \d\d]  boot.cat.*/m;
345            log_("buildISO: checking boot.cat location ($1)\n", 5, $config->{LOG});
346            die "FATAL buildISO: boot.cat at $1" if $1 == 929;
347            my $ok = include_md5("$isodir/$i-$name.iso",1);
348            log_("ERROR: disc $i include_md5 failed ($err)\n", 1, $config->{LOG}) if !$ok;
349            $size->{disc}[$i] = du("$isodir/$i-$name.iso")
350        }
351    }
352}
353
354sub checkSize {
355    my ($class, $n, $size, $cdsize, $cds, $rejected) = @_;
356    my $ok = 1;
357    foreach my $i (@$cds) {
358        if ($size->{save}{disc}[$i] != $size->{disc}[$i]) {
359            $size->{save}{disc}[$i] = $size->{disc}[$i];
360            $ok = 0
361        }
362    }
363    if ($ok) {
364        log_("checkSize: disc sizes has not changed, exiting\n",1, $config->{LOG});
365        return 1
366    }
367    my $ok = 1;
368    foreach my $i (@$cds) {
369        $size->{disc}[$i] or next;
370        my $origcdsize = $class->{config}{disc}[$i]{size};
371        log_("checkSize: disc $i size $size->{disc}[$i] ($origcdsize)\n",1, $config->{LOG});
372        my $d = $size->{disc}[$i] - $origcdsize;
373        if ($size->{disc}[$i] > $origcdsize) {
374            if ($d > $origcdsize/10) {
375                log_("ERROR: an error must have happen, disc $i is far too big ($size->{disc}[$i] > $origcdsize), ignoring\n",1, $config->{LOG});
376                next
377            }
378            if ($d > 0 && $d > ($origcdsize*$n)/1000) {
379                $ok = 0;
380                $cdsize->[$i] -= $d;
381                log_("ERROR: disc $i is too big ($size->{disc}[$i] > $origcdsize ($d)\n",1, $config->{LOG})
382            } else {
383                $cdsize->[$i] = $size->{disc}[$i]+1;       
384            }
385        } else {
386            if ($d < 0 && $rejected) {
387                $d = -$d;
388                # FIXME heuristic: do not change CD size if diff is greater than 10% of the original CD size
389                if ($d > $origcdsize/10) {
390                    log_("ERROR: an error must have happen, disc $i is far too small ($size->{disc}[$i] << $origcdsize), ignoring\n",1, $config->{LOG});
391                    next
392                }
393                if ($d > ($origcdsize*$n)/300) {
394                    $ok = 0;
395                    #$cdsize->[$i] += $d/2;
396                    log_("ERROR: disc $i is too small ($size->{disc}[$i] < $origcdsize, ($d)\n",1, $config->{LOG})
397                }
398            }
399        }
400        log_("checkSize: new disc $i size $cdsize->[$i]\n",1, $config->{LOG});
401    }
402    return $ok
403}
404
405sub compute_sort_file {
406    my ($sort, $cds, $dir, $first) = @_;
407    foreach my $cd (@$cds) {
408        ref $sort->{$cd} or next;
409        open my $F, ">$dir/$cd.sort" or return 0;
410        my $i=1;
411        my %done;
412        foreach my $chunks (@{$sort->{$cd}}) {
413            foreach my $f (@$chunks) {
414                $done{$f} and next;
415                $done{$f} = 1;
416                print $F "$f $i\n";
417                $i++
418            }
419        }
420        print $F "$first $i\n" if $first
421    }
422}
423
4241
425
426# Changelog
427#
428# 2002 05 22
429# fix a pb in graft_to_md5 that made dest incomplete when dest is a directory
430#
431# 2002 08 25
432# improve checkSize to better work with optimize_space
Note: See TracBrowser for help on using the repository browser.