diff options
Diffstat (limited to 'build_archive')
| -rwxr-xr-x | build_archive | 175 |
1 files changed, 175 insertions, 0 deletions
diff --git a/build_archive b/build_archive new file mode 100755 index 0000000..e2b21f2 --- /dev/null +++ b/build_archive @@ -0,0 +1,175 @@ +#!/usr/bin/perl + +#- Mandrake Simple Archive Builder. +#- Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com) +#- +#- This program is free software; you can redistribute it and/or modify +#- it under the terms of the GNU General Public License as published by +#- the Free Software Foundation; either version 2, or (at your option) +#- any later version. +#- +#- 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. + +#- Simple cat archive with bzip2 for perl. +#- read file list and produce an $ARGV[0].cz2 archive file. +#- uncompressing sheme is: +#- | | +#- | | | | +#- $off1 =|*| } | | +#- |*| } $off2 =|+| } +#- |*| } $siz1 => 'bzip2 -d' => |+| } $siz2 => $filename +#- |*| } |+| } +#- |*| } | | +#- | | | | +#- | | | | +#- | | +#- where %data has the following format: +#- { 'filename' => [ 'f', $off1, $siz1, $off2, $siz2 ] } +#- except for symbolink link where it is: +#- { 'filename_symlink' => [ 'l', $symlink_value ] } +#- and directory where it is only +#- { 'filename_directory' => [ 'd' ] } +#- as you can see, there is no owner, group, filemode... an extension could be +#- made with 'F' (instead of 'f'), 'L' instead of 'l' for exemple. +#- we do not need them as it is used for DrakX for fast archive extraction and +#- owner/filemode is for user running only (ie root). +#- +#- archive file contains concatenation of all bzip2'ed group of files whose +#- filenames are on input, +#- then a TOC (describing %data, concatenation of toc_line) follow and a +#- TOC_TRAILER for summary. + +use strict qw(subs vars refs); + +sub toc_line { + my ($file, $data) = @_; + + for ($data->[0]) { + return(/l/ && pack("anna*", 'l', length($file), length($data->[1]), "$file$data->[1]") || + /d/ && pack("ana*", 'd', length($file), $file) || + /f/ && pack("anNNNNa*", 'f', length($file), $data->[1], $data->[2], $data->[3], $data->[4], $file) || + die "unknown extension $_\n"); + } +} + +sub main { + my ($archivename, $maxsiz) = @_; + my ($compress, $uncompress, $off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0); + my @filelist = (); + my @data = (); + my %data = (); + + die "usage: $0 <archivename> <maxsiz>\n" unless $maxsiz >= 100000; + + #- guess compress method to use. + if ($archivename =~ /\.cz$/) { + ($compress, $uncompress) = ("gzip -9", "gzip -d"); + } elsif ($archivename =~ /\.cz2$/) { + ($compress, $uncompress) = ("bzip2 -9", "bzip2 -d"); + } else { + die "how to choose a compression which such a filename $archivename\n"; + } + print STDERR "choosing compression method with \"$compress\" for archive $archivename\n"; + + unlink "$archivename"; + unlink "tmp.z"; + + foreach (<STDIN>) { + chomp; + + my $file = $_; -e $file or die "unable to find file $file\n"; + + push @data, $file; + #- now symbolic link and directory are supported, extension is + #- available with the first field of $data{$file}. + if (-l $file) { + $data{$file} = [ 'l', readlink $file ]; + } elsif (-d $file) { + $data{$file} = [ 'd' ]; + } else { + $siz2 = -s $file; + + push @filelist, $file; + $data{$file} = [ 'f', -1, -1, $off2, $siz2 ]; + + if ($off2 + $siz2 > $maxsiz) { #- need compression. + system "cat @filelist | $compress >tmp.z"; + $siz1 = -s "tmp.z"; + + $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] foreach @filelist; + + system "cat tmp.z >>$archivename"; + $off1 += $siz1; + $off2 = 0; $siz2 = 0; + @filelist = (); + } + $off2 += $siz2; + } + } + if (scalar @filelist) { + system "cat @filelist | $compress >tmp.z"; + $siz1 = -s "tmp.z"; + + $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] foreach @filelist; + + system "cat tmp.z >>$archivename"; + $off1 += $siz1; + print STDERR "real archive size of $archivename is $off1\n"; + } + + #- produce a TOC directly at the end of the file, follow with + #- a trailer with TOC summary and archive summary. + local *OUTPUT; + open OUTPUT, ">>$archivename"; + + my ($toc_str, $toc_data) = ('', ''); + my @data_d = (); + my @data_l = (); + my @data_f = (); + + foreach (@data) { + my $file = $_; + $data{$file} or die "build_archive: internal error on $_\n"; + + #- specific according to type. + #- with this version, only f has specific data other than strings. + for ($data{$file}[0]) { + /d/ && do { push @data_d, $file; last; }; + /l/ && do { push @data_l, $file; last; }; + /f/ && do { push @data_f, $file; $toc_data .= pack("NNNN", + $data{$file}[1], + $data{$file}[2], + $data{$file}[3], + $data{$file}[4]); last; }; + die "unknown extension $_\n"; + } + } + + foreach (@data_d) { $toc_str .= $_ . "\n" } + foreach (@data_l) { $toc_str .= $_ . "\n" . $data{$_}[1] . "\n" } + foreach (@data_f) { $toc_str .= $_ . "\n" } + + print OUTPUT $toc_str; + print OUTPUT $toc_data; + print OUTPUT toc_trailer(scalar(@data_d), scalar(@data_l), scalar(@data_f), + length($toc_str), $uncompress); + close OUTPUT; +} + +sub toc_trailer { + my ($toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress) = @_; + + #- 'cz[0' is toc_trailer header where 0 is version information, only 0 now. + #- '0]cz' is toc_trailer trailer that match the corresponding header for information. + return pack "a4NNNNa40a4", 'cz[0', $toc_d_count, $toc_l_count, $toc_f_count, $toc_str_size, $uncompress, '0]cz'; +} + +main(@ARGV); +unlink "tmp.z"; |