diff options
| -rwxr-xr-x | packdrake | 460 | ||||
| -rw-r--r-- | packdrake.pm | 508 | ||||
| -rw-r--r-- | parsehdlist.c | 1 | ||||
| -rw-r--r-- | rpmtools.pm | 94 | ||||
| -rw-r--r-- | rpmtools.spec | 10 | ||||
| -rw-r--r-- | rpmtools.xs | 395 |
6 files changed, 817 insertions, 651 deletions
@@ -1,449 +1,14 @@ #!/usr/bin/perl -#- Mandrake Simple Archive Extracter/Builder. -#- Copyright (C) 2000 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 gzip/bzip2 for perl. -#- This new version is merging of the extract_achive and build_archive. -#- -#- uncompressing sheme is: -#- | | -#- | | | | -#- $off1 =|*| } | | -#- |*| } $off2 =|+| } -#- |*| } $siz1 => 'gzip/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); +use strict; +require packdrake; #- general information. -my $VERSION = "0.1"; my $default_size = 400000; my $default_ratio = 6; -#- used for uncompressing archive and listing. -my %toc_trailer; -my @data; -my %data; - -#- used for compression, always set in main. -my $tmpz = ''; - -#- taken from DrakX common stuff, for conveniance and modified to match our expectation. -sub dirname { @_ == 1 or die "packdrake: usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } -sub basename { @_ == 1 or die "packdrake: usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ } -sub mkdir_ { - my $root = dirname $_[0]; - if (-e $root) { - -d $root or die "packdrake: mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n"; - } else { - mkdir_($root); - } - -d $_[0] and return; - mkdir $_[0], 0755 or die "packdrake: mkdir: error creating directory $_: $!\n"; -} -sub symlink_ { mkdir_ dirname($_[1]); unlink $_[1]; symlink $_[0], $_[1] } - -#- for building an archive. -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 "packdrake: unknown extension $_\n"); - } -} - -sub cat_compress { - my ($compress, @filenames) = @_; - local *F; - open F, "| $compress >$tmpz" or die "packdrake: cannot start \"$compress\"\n"; - foreach (@filenames) { - my ($buf, $siz, $sz); - local *FILE; - open FILE, $_ or die "packdrake: cannot open $_: $!\n"; - $siz = -s $_; - while (($sz = sysread(FILE, $buf, $siz > 16384 ? 16384 : $siz))) { - $siz -= $sz; - syswrite(F, $buf); - last unless $siz > 0; - } - close FILE; - } - close F; - -s $tmpz; -} - -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'; -} - -#- compute the closure of filename list according to symlinks or directory -#- contents inside the archive. -sub compute_closure { - my %file; - my @file; - - #- keep in mind when a filename already exist and remove doublons. - @file{@_} = (); - - #- navigate through filename list to follow symlinks. - do { - @file = grep { !$file{$_} } keys %file; - foreach (@file) { - my $file = $_; - - #- keep in mind this one has been processed and does not need - #- to be examined again. - $file{$file} = 1; - - exists $data{$file} or next; - - for ($data{$file}[0]) { - #- on symlink, try to follow it and mark %file if - #- it is still inside the archive contents. - /l/ && do { - my ($source, $target) = ($file, $data{$file}[1]); - - $source =~ s|[^/]*$||; #- remove filename to navigate directory. - if ($source) { - while ($target =~ s|^\./|| || $target =~ s|//+|/| || $target =~ s|/$|| or - $source and $target =~ s|^\.\./|| and $source =~ s|[^/]*/$||) {} - } - - #- FALL THROUGH with new selection. - $file = $target =~ m|^/| ? $target : $source.$target; - }; - - #- on directory, try all files on data starting with - #- this directory, provided they are not already taken - #- into account. - /[ld]/ && do { - @file{grep { !$file{$_} && m|^$file$| || m|^$file/| } keys %data} = (); - last; - }; - } - } - } while (@file > 0); - - keys %file; -} - -#- degraded reading of toc at end of archive, do not check filelist. -sub read_toc_trailer { - my ($file) = @_; - my $toc_trailer; - - local *ARCHIVE; - open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n"; - - #- seek to end of file minus 64, size of trailer. - #- read toc_trailer, check header/trailer for version 0. - seek ARCHIVE, -64, 2; - read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n"; - @toc_trailer{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} = - unpack "a4NNNNZ40a4", $toc_trailer; - $toc_trailer{header} eq 'cz[0' && $toc_trailer{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n"; - - close ARCHIVE; -} - -#- read toc at end of archive. -sub read_toc { - my ($file) = @_; - my ($toc, $toc_trailer, $toc_size); - my @toc_str; - my @toc_data; - - local *ARCHIVE; - open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n"; - - #- seek to end of file minus 64, size of trailer. - #- read toc_trailer, check header/trailer for version 0. - seek ARCHIVE, -64, 2; - read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n"; - @toc_trailer{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} = - unpack "a4NNNNZ40a4", $toc_trailer; - $toc_trailer{header} eq 'cz[0' && $toc_trailer{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n"; - - #- read toc, extract data hashes. - $toc_size = $toc_trailer{toc_str_size} + 16*$toc_trailer{toc_f_count}; - seek ARCHIVE, -64-$toc_size, 2; - - #- read strings separated by \n, so this char cannot be inside filename, oops. - read ARCHIVE, $toc, $toc_trailer{toc_str_size} or die "packdrake: cannot read toc of archive file $file\n"; - @toc_str = split "\n", $toc; - - #- read data for file. - read ARCHIVE, $toc, 16*$toc_trailer{toc_f_count} or die "packdrake: cannot read toc of archive file $file\n"; - @toc_data = unpack "N". 4*$toc_trailer{toc_f_count}, $toc; - - close ARCHIVE; - - foreach (0..$toc_trailer{toc_d_count}-1) { - my $file = $toc_str[$_]; - push @data, $file; - $data{$file} = [ 'd' ]; - } - foreach (0..$toc_trailer{toc_l_count}-1) { - my ($file, $symlink) = ($toc_str[$toc_trailer{toc_d_count}+2*$_], - $toc_str[$toc_trailer{toc_d_count}+2*$_+1]); - push @data, $file; - $data{$file} = [ 'l', $symlink ]; - } - foreach (0..$toc_trailer{toc_f_count}-1) { - my $file = $toc_str[$toc_trailer{toc_d_count}+2*$toc_trailer{toc_l_count}+$_]; - push @data, $file; - $data{$file} = [ 'f', @toc_data[4*$_ .. 4*$_+3] ]; - } - - scalar keys %data == $toc_trailer{toc_d_count}+$toc_trailer{toc_l_count}+$toc_trailer{toc_f_count} or - die "packdrake: mismatch count when reading toc, bad archive file $file\n"; -} - -sub catsksz { - my ($input, $seek, $siz, $output) = @_; - my ($buf, $sz); - - while (($sz = sysread($input, $buf, $seek > 65536 ? 65536 : $seek))) { - $seek -= $sz; - last unless $seek > 0; - } - while (($sz = sysread($input, $buf, $siz > 65536 ? 65536 : $siz))) { - $siz -= $sz; - syswrite($output, $buf); - last unless $siz > 0; - } -} - -sub cat_archive { - my $pid; - - foreach (@_) { - #- update %data according to TOC_TRAILER of each archive. - read_toc_trailer($_); - - #- dump all the file according to - if (my $pid = fork()) { - waitpid $pid, 0; - } else { - open STDIN, "<$_" or die "packdrake: unable to open archive $_\n"; - open STDERR, ">/dev/null" or die "packdrake: unable to open archive $_\n"; - - exec split " ", $toc_trailer{uncompress}; - - die "packdrake: unable to cat the archive\n"; - } - } -} - -sub extract_archive { - my ($archivename, $dir, @file) = @_; - my %extract_table; - - #- update %data according to TOC of archive. - read_toc($archivename); - - #- as a special features, if both $dir and $file are empty, list contents of archive. - if (!$dir && !@file) { - my $count = scalar keys %data; - print "$count files in archive, uncompression method is \"$toc_trailer{uncompress}\"\n"; - foreach my $file (@data) { - for ($data{$file}[0]) { - /l/ && do { printf "l %13c %s -> %s\n", ' ', $file, $data{$file}[1]; last; }; - /d/ && do { printf "d %13c %s\n", ' ', $file; last; }; - /f/ && do { printf "f %12d %s\n", $data{$file}[4], $file; last; }; - } - } - exit 0; - } - - #- compute closure. - @file = compute_closure(@file); - - foreach my $file (@file) { - #- check for presence of file, but do not abort, continue with others. - $data{$file} or do { print STDERR "packdrake: unable to find file $file in archive $archivename\n"; next }; - - my $newfile = "$dir/$file"; - - print "extracting $file\n"; - for ($data{$file}[0]) { - /l/ && do { symlink_ $data{$file}[1], $newfile; last; }; - /d/ && do { mkdir_ $newfile; last; }; - /f/ && do { - mkdir_ dirname $newfile; - $extract_table{$data{$file}[1]} ||= [ $data{$file}[2], [] ]; - push @{$extract_table{$data{$file}[1]}[1]}, [ $newfile, $data{$file}[3], $data{$file}[4] ]; - $extract_table{$data{$file}[1]}[0] == $data{$file}[2] or die "packdrake: mismatched relocation in toc\n"; - last; - }; - die "packdrake: unknown extension \"$_\" when uncompressing archive $archivename\n"; - } - } - - #- delayed extraction is done on each block for a single execution - #- of uncompress executable. - foreach (sort { $a <=> $b } keys %extract_table) { - local *OUTPUT; - if (open OUTPUT, "-|") { - #- $curr_off is used to handle the reading in a pipe and simulating - #- a seek on it as done by catsksz, so last file position is - #- last byte not read (ie last block read start + last block read size). - my $curr_off = 0; - foreach (sort { $a->[1] <=> $b->[1] } @{$extract_table{$_}[1]}) { - my ($newfile, $off, $siz) = @$_; - local *FILE; - open FILE, $dir ? ">$newfile" : ">&STDOUT"; - catsksz(\*OUTPUT, $off - $curr_off, $siz, \*FILE); - $curr_off = $off + $siz; - } - } else { - local *BUNZIP2; - open BUNZIP2, "| $toc_trailer{uncompress}"; - local *ARCHIVE; - open ARCHIVE, "<$archivename" or die "packdrake: cannot open archive $archivename\n"; - catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2); - exit 0; - } - } -} - -sub build_archive { - my ($archivename, $maxsiz, $compress, $uncompress) = @_; - my ($off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0); - my @filelist = (); - my @data = (); - my %data = (); - - print "choosing compression method with \"$compress\" for archive $archivename\n"; - - unlink "$archivename"; - unlink $tmpz; - - foreach (<STDIN>) { - chomp; - - my $file = $_; -e $file or die "packdrake: 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. - $siz1 = cat_compress($compress, @filelist); - - foreach (@filelist) { $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] } - - system "cat $tmpz >>$archivename"; - $off1 += $siz1; - $off2 = 0; $siz2 = 0; - @filelist = (); - } - $off2 += $siz2; - } - } - if (scalar @filelist) { - $siz1 = cat_compress($compress, @filelist); - - foreach (@filelist) { $data{$_} = [ 'f', $off1, $siz1, $data{$_}[3], $data{$_}[4] ] } - - system "cat $tmpz >>$archivename"; - $off1 += $siz1; - print "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 "packdrake: 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 "packdrake: 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; - - unlink $tmpz; -} - sub usage { - die "packdrake version $VERSION + die "packdrake version " . $packdrake::VERSION . " Copyright (C) 2000 MandrakeSoft. This is free software and may be redistributed under the terms of the GNU GPL. @@ -479,7 +44,7 @@ sub main { /^--build$/ and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next }; /^--extract$/ and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next }; /^--list$/ and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next }; - /^--cat$/ and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (); next }; + /^--cat$/ and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next }; /^--size$/ and do { push @nextargv, \$size; next }; /^--method$/ and do { push @nextargv, \$method; next }; /^--compress$/ and do { push @nextargv, \$compress; next }; @@ -489,22 +54,20 @@ sub main { /b/ and do { $mode and die $error_mode; $mode = "build"; @nextargv = (\$file); next }; /x/ and do { $mode and die $error_mode; $mode = "extract"; @nextargv = (\$file, \$dir); next }; /l/ and do { $mode and die $error_mode; $mode = "list"; @nextargv = (\$file); next }; - /c/ and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (); next }; + /c/ and do { $mode and die $error_mode; $mode = "cat"; @nextargv = (\$file); next }; /s/ and do { push @nextargv, \$size; next }; /m/ and do { push @nextargv, \$method; next }; die "packdrake: unknown option \"-$1\", check usage with --help\n"; } next }; - $mode =~ /extract|cat/ or @nextargv or die "packdrake: unknown option \"$_\", check usage with --help\n"; + $mode =~ /extract|list|cat/ or @nextargv or die "packdrake: unknown option \"$_\", check usage with --help\n"; my $ref = shift @nextargv; $ref ? $$ref = $_ : push @list, $_; $mode ||= "list"; } #- examine and lauch. - $mode =~ /cat/ or $file or die "packdrake: no archive filename given, check usage with --help\n"; + $file or die "packdrake: no archive filename given, check usage with --help\n"; $size ||= 400000; $ratio ||= 6; - $tmpdir = $ENV{TMPDIR} || "/tmp"; - $tmpz = "$tmpdir/packdrake-tmp.$$"; unless ($method) { $file =~ /\.cz$/ and $method = "gzip"; $file =~ /\.cz2$/ and $method = "bzip2"; @@ -513,11 +76,12 @@ sub main { $compress ||= "$method -$ratio"; $uncompress ||= "$method -d"; + $mode =~ /extract/ && !$dir && !@list and ($mode, @list) = ('list', $file); for ($mode) { - /build/ and do { build_archive($file, $size, $compress, $uncompress); last }; - /extract/ and do { extract_archive($file, $dir, @list); last }; - /list/ and do { extract_archive($file); last }; - /cat/ and do { cat_archive(@list); last }; + /build/ and do { packdrake::build_archive(\*STDIN, $file, $size, $compress, $uncompress); last }; + /extract/ and do { my $packer = new packdrake($file); $packer->extract_archive($dir, @list); last }; + /list/ and do { packdrake::list_archive($file, @list); last }; + /cat/ and do { packdrake::cat_archive($file, @list); last }; die "packdrake: internal error, unable to select right mode?\n"; } } diff --git a/packdrake.pm b/packdrake.pm new file mode 100644 index 0000000..bdad288 --- /dev/null +++ b/packdrake.pm @@ -0,0 +1,508 @@ +package packdrake; + +use strict; +use vars qw($VERSION); + +$VERSION = "0.02"; + +=head1 NAME + +packdrake - Mandrake Simple Archive Extractor/Builder + +=head1 SYNOPSYS + + require packdrake; + + packdrake::cat_archive("/export/Mandrake/base/hdlist.cz", + "/export/Mandrake/base/hdlist2.cz"); + packdrake::list_archive("/tmp/modules.cz2"); + + my $packer = new packdrake("/tmp/modules.cz2"); + $packer->extract_archive("/tmp", "file1.o", "file2.o"); + + my $packer = packdrake::build_archive + (\*STDIN, "/tmp/modules.cz2", + 400000, "bzip2", "bzip2 -d"); + my $packer = packdrake::build_archive + (\*STDIN, "/export/Mandrake/base/hdlist.cz", + 400000, "gzip -9", "gzip -d"); + +=head1 DESCRIPTION + +C<packdrake> is a very simple archive extractor and builder used by MandrakeSoft. + +=head1 IMPLEMENTATION + +uncompressing sheme is: + | | + | | | | + $off1 =|*| } | | + |*| } $off2 =|+| } + |*| } $siz1 => 'gzip/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. + +=head1 SEE ALSO + +packdrake command is a simple executable perl script using this module. + +=head1 COPYRIGHT + +Copyright (C) 2000 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. + +=cut + +#- taken from DrakX common stuff, for conveniance and modified to match our expectation. +sub dirname { @_ == 1 or die "packdrake: usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } +sub basename { @_ == 1 or die "packdrake: usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ } +sub mkdir_ { + my $root = dirname $_[0]; + if (-e $root) { + -d $root or die "packdrake: mkdir: error creating directory $_[0]: $root is a file and i won't delete it\n"; + } else { + mkdir_($root); + } + -d $_[0] and return; + mkdir $_[0], 0755 or die "packdrake: mkdir: error creating directory $_: $!\n"; +} +sub symlink_ { mkdir_ dirname($_[1]); unlink $_[1]; symlink $_[0], $_[1] } + +#- for building an archive, returns the string containing the file and data associated. +sub build_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..4], $file) || + die "packdrake: unknown extension $_\n"); + } +} + +sub build_toc_trailer { + my ($packer) = @_; + + #- '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. + pack "a4NNNNa40a4", ($packer->{header}, + $packer->{toc_d_count}, $packer->{toc_l_count}, $packer->{toc_f_count}, + $packer->{toc_str_size}, $packer->{uncompress}, + $packer->{trailer}); +} + +#- degraded reading of toc at end of archive, do not check filelist. +sub read_toc_trailer { + my ($packer, $file) = @_; + my $toc_trailer; + + local *ARCHIVE; + open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n"; + $packer->{archive} = $file; + + #- seek to end of file minus 64, size of trailer. + #- read toc_trailer, check header/trailer for version 0. + seek ARCHIVE, -64, 2; + read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n"; + @{$packer}{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} = + unpack "a4NNNNZ40a4", $toc_trailer; + $packer->{header} eq 'cz[0' && $packer->{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n"; + + close ARCHIVE; +} + +#- read toc at end of archive. +sub read_toc { + my ($packer, $file) = @_; + my ($toc, $toc_trailer, $toc_size); + my @toc_str; + my @toc_data; + + local *ARCHIVE; + open ARCHIVE, "<$file" or die "packdrake: cannot open archive file $file\n"; + $packer->{archive} = $file; + + #- seek to end of file minus 64, size of trailer. + #- read toc_trailer, check header/trailer for version 0. + seek ARCHIVE, -64, 2; + read ARCHIVE, $toc_trailer, 64 or die "packdrake: cannot read toc_trailer of archive file $file\n"; + @{$packer}{qw(header toc_d_count toc_l_count toc_f_count toc_str_size uncompress trailer)} = + unpack "a4NNNNZ40a4", $toc_trailer; + $packer->{header} eq 'cz[0' && $packer->{trailer} eq '0]cz' or die "packdrake: bad toc_trailer in archive file $file\n"; + + #- read toc, extract data hashes. + $toc_size = $packer->{toc_str_size} + 16*$packer->{toc_f_count}; + seek ARCHIVE, -64-$toc_size, 2; + + #- read strings separated by \n, so this char cannot be inside filename, oops. + read ARCHIVE, $toc, $packer->{toc_str_size} or die "packdrake: cannot read toc of archive file $file\n"; + @toc_str = split "\n", $toc; + + #- read data for file. + read ARCHIVE, $toc, 16*$packer->{toc_f_count} or die "packdrake: cannot read toc of archive file $file\n"; + @toc_data = unpack "N". 4*$packer->{toc_f_count}, $toc; + + close ARCHIVE; + + foreach (0..$packer->{toc_d_count}-1) { + my $file = $toc_str[$_]; + push @{$packer->{files}}, $file; + $packer->{data}{$file} = [ 'd' ]; + } + foreach (0..$packer->{toc_l_count}-1) { + my ($file, $symlink) = ($toc_str[$packer->{toc_d_count}+2*$_], + $toc_str[$packer->{toc_d_count}+2*$_+1]); + push @{$packer->{files}}, $file; + $packer->{data}{$file} = [ 'l', $symlink ]; + } + foreach (0..$packer->{toc_f_count}-1) { + my $file = $toc_str[$packer->{toc_d_count}+2*$packer->{toc_l_count}+$_]; + push @{$packer->{files}}, $file; + $packer->{data}{$file} = [ 'f', @toc_data[4*$_ .. 4*$_+3] ]; + } + + scalar keys %{$packer->{data}} == $packer->{toc_d_count}+$packer->{toc_l_count}+$packer->{toc_f_count} or + die "packdrake: mismatch count when reading toc, bad archive file $file\n"; +} + +sub catsksz { + my ($input, $seek, $siz, $output) = @_; + my ($buf, $sz); + + while (($sz = sysread($input, $buf, $seek > 65536 ? 65536 : $seek))) { + $seek -= $sz; + last unless $seek > 0; + } + while (($sz = sysread($input, $buf, $siz > 65536 ? 65536 : $siz))) { + $siz -= $sz; + syswrite($output, $buf); + last unless $siz > 0; + } +} + +sub cat_compress { + my ($packer, @filenames) = @_; + local *F; + open F, "| $packer->{compress} >$packer->{tmpz}" or die "packdrake: cannot start \"$packer->{compress}\"\n"; + foreach (@filenames) { + my ($buf, $siz, $sz); + local *FILE; + open FILE, $_ or die "packdrake: cannot open $_: $!\n"; + $siz = -s $_; + while (($sz = sysread(FILE, $buf, $siz > 65536 ? 65536 : $siz))) { + $siz -= $sz; + syswrite(F, $buf); + last unless $siz > 0; + } + close FILE; + } + close F; + -s $packer->{tmpz}; +} + +#- compute the closure of filename list according to symlinks or directory +#- contents inside the archive. +sub compute_closure { + my $packer = shift; + my %file; + my @file; + + #- keep in mind when a filename already exist and remove doublons. + @file{@_} = (); + + #- navigate through filename list to follow symlinks. + do { + @file = grep { !$file{$_} } keys %file; + foreach (@file) { + my $file = $_; + + #- keep in mind this one has been processed and does not need + #- to be examined again. + $file{$file} = 1; + + exists $packer->{data}{$file} or next; + + for ($packer->{data}{$file}[0]) { + #- on symlink, try to follow it and mark %file if + #- it is still inside the archive contents. + /l/ && do { + my ($source, $target) = ($file, $packer->{data}{$file}[1]); + + $source =~ s|[^/]*$||; #- remove filename to navigate directory. + if ($source) { + while ($target =~ s|^\./|| || $target =~ s|//+|/| || $target =~ s|/$|| or + $source and $target =~ s|^\.\./|| and $source =~ s|[^/]*/$||) {} + } + + #- FALL THROUGH with new selection. + $file = $target =~ m|^/| ? $target : $source.$target; + }; + + #- on directory, try all files on data starting with + #- this directory, provided they are not already taken + #- into account. + /[ld]/ && do { + @file{grep { !$file{$_} && m|^$file$| || m|^$file/| } keys %{$packer->{data}}} = (); + last; + }; + } + } + } while (@file > 0); + + keys %file; +} + + +#- getting an packer object. +sub new { + my ($class, $file) = @_; + my $packer = bless { + #- toc trailer data information. + header => 'cz[0', + toc_d_count => 0, + toc_l_count => 0, + toc_f_count => 0, + toc_str_size => 0, + uncompress => 'gzip -d', + trailer => '0]cz', + + #- tempories used for making an archive. + tmpz => ($ENV{TMPDIR} || "/tmp") . "/packdrake-tmp.$$", + compress => 'gzip', + + #- internal data to handle compression or uncompression. + archive => undef, + files => [], + data => {}, + }, $class; + $file and $packer->read_toc($file); + $packer; +} + +sub cat_archive { + my $pid; + + foreach (@_) { + my $packer = new packdrake; + + #- update %data according to TOC_TRAILER of each archive. + $packer->read_toc_trailer($_); + + #- dump all the file according to + if (my $pid = fork()) { + waitpid $pid, 0; + } else { + open STDIN, "<$_" or die "packdrake: unable to open archive $_\n"; + open STDERR, ">/dev/null" or die "packdrake: unable to open /dev/null\n"; + + exec split " ", $packer->{uncompress}; + + die "packdrake: unable to cat the archive with $packer->{uncompress}\n"; + } + } +} + +sub list_archive { + foreach (@_) { + my $packer = new packdrake($_); + my $count = scalar keys %{$packer->{data}}; + + print STDERR "processing archive \"$_\"\n"; + print "$count files in archive, uncompression method is \"$packer->{uncompress}\"\n"; + foreach my $file (@{$packer->{files}}) { + for ($packer->{data}{$file}[0]) { + /l/ && do { printf "l %13c %s -> %s\n", ' ', $file, $packer->{data}{$file}[1]; last; }; + /d/ && do { printf "d %13c %s\n", ' ', $file; last; }; + /f/ && do { printf "f %12d %s\n", $packer->{data}{$file}[4], $file; last; }; + } + } + } +} + +sub extract_archive { + my ($packer, $dir, @file) = @_; + my %extract_table; + + #- compute closure. + @file = $packer->compute_closure(@file); + + foreach my $file (@file) { + #- check for presence of file, but do not abort, continue with others. + $packer->{data}{$file} or do { print STDERR "packdrake: unable to find file $file in archive $packer->{archive}\n"; next }; + + my $newfile = "$dir/$file"; + + print "extracting $file\n"; + for ($packer->{data}{$file}[0]) { + /l/ && do { symlink_ $packer->{data}{$file}[1], $newfile; last; }; + /d/ && do { mkdir_ $newfile; last; }; + /f/ && do { mkdir_ dirname $newfile; + my $data = $packer->{data}{$file}; + $extract_table{$data->[1]} ||= [ $data->[2], [] ]; + push @{$extract_table{$data->[1]}[1]}, [ $newfile, $data->[3], $data->[4] ]; + $extract_table{$data->[1]}[0] == $data->[2] or die "packdrake: mismatched relocation in toc\n"; + last; + }; + die "packdrake: unknown extension \"$_\" when uncompressing archive $packer->{archive}\n"; + } + } + + #- delayed extraction is done on each block for a single execution + #- of uncompress executable. + foreach (sort { $a <=> $b } keys %extract_table) { + local *OUTPUT; + if (open OUTPUT, "-|") { + #- $curr_off is used to handle the reading in a pipe and simulating + #- a seek on it as done by catsksz, so last file position is + #- last byte not read (ie last block read start + last block read size). + my $curr_off = 0; + foreach (sort { $a->[1] <=> $b->[1] } @{$extract_table{$_}[1]}) { + my ($newfile, $off, $siz) = @$_; + local *FILE; + open FILE, $dir ? ">$newfile" : ">&STDOUT"; + catsksz(\*OUTPUT, $off - $curr_off, $siz, \*FILE); + $curr_off = $off + $siz; + } + } else { + local *BUNZIP2; + open BUNZIP2, "| $packer->{uncompress}"; + local *ARCHIVE; + open ARCHIVE, "<$packer->{archive}" or die "packdrake: cannot open archive $packer->{archive}\n"; + catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2); + exit 0; + } + } +} + +sub build_archive { + my ($f, $archivename, $maxsiz, $compress, $uncompress, $tmpz) = @_; + my ($off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0); + my @filelist = (); + my $packer = new packdrake; + + $packer->{archive} = $archivename; + $compress && $uncompress and ($packer->{compress}, $packer->{uncompress}) = ($compress, $uncompress); + $tmpz and $packer->{tmpz} = $tmpz; + + print STDERR "choosing compression method with \"$packer->{compress}\" for archive $packer->{archive}\n"; + + unlink $packer->{archive}; + unlink $packer->{tmpz}; + + my $file; + while ($file = <$f>) { + chomp $file; + -e $file or die "packdrake: unable to find file $file\n"; + + push @{$packer->{files}}, $file; + #- now symbolic link and directory are supported, extension is + #- available with the first field of $data{$file}. + if (-l $file) { + $packer->{data}{$file} = [ 'l', readlink $file ]; + } elsif (-d $file) { + $packer->{data}{$file} = [ 'd' ]; + } else { + $siz2 = -s $file; + + push @filelist, $file; + $packer->{data}{$file} = [ 'f', -1, -1, $off2, $siz2 ]; + + if ($off2 + $siz2 > $maxsiz) { #- need compression. + $siz1 = cat_compress($packer, @filelist); + + foreach (@filelist) { + $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ]; + } + + system "cat $packer->{tmpz} >>$packer->{archive}"; + $off1 += $siz1; + $off2 = 0; $siz2 = 0; + @filelist = (); + } + $off2 += $siz2; + } + } + if (scalar @filelist) { + $siz1 = cat_compress($packer, @filelist); + + foreach (@filelist) { + $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ]; + } + + system "cat $packer->{tmpz} >>$packer->{archive}"; + $off1 += $siz1; + } + print STDERR "real archive size of $packer->{archive} 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, ">>$packer->{archive}"; + + my ($toc_str, $toc_data) = ('', ''); + my @data_d = (); + my @data_l = (); + my @data_f = (); + + foreach my $file (@{$packer->{files}}) { + $packer->{data}{$file} or die "packdrake: internal error on $_\n"; + + #- specific according to type. + #- with this version, only f has specific data other than strings. + for ($packer->{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", @{$packer->{data}{$file}}[1..4]); last; }; + die "packdrake: unknown extension $_\n"; + } + } + + foreach (@data_d) { $toc_str .= $_ . "\n" } + foreach (@data_l) { $toc_str .= $_ . "\n" . $packer->{data}{$_}[1] . "\n" } + foreach (@data_f) { $toc_str .= $_ . "\n" } + + @{$packer}{qw(toc_d_count toc_l_count toc_f_count toc_str_size uncompress)} = + (scalar(@data_d), scalar(@data_l), scalar(@data_f), length($toc_str), $uncompress); + + print OUTPUT $toc_str; + print OUTPUT $toc_data; + print OUTPUT build_toc_trailer($packer); + close OUTPUT; + + unlink $packer->{tmpz}; + + $packer; +} + +1; diff --git a/parsehdlist.c b/parsehdlist.c index 8c40a14..f896d92 100644 --- a/parsehdlist.c +++ b/parsehdlist.c @@ -84,6 +84,7 @@ void print_list_flags(Header header, int_32 tag_name, int_32 tag_flags, int_32 t if (flags[i] & RPMSENSE_LESS) printf("<"); if (flags[i] & RPMSENSE_GREATER) printf(">"); if (flags[i] & RPMSENSE_EQUAL) printf("="); + if ((flags[i] & (RPMSENSE_LESS|RPMSENSE_EQUAL|RPMSENSE_GREATER)) == RPMSENSE_EQUAL) printf("="); printf(" %s", list_evr[i]); } printf("\n"); diff --git a/rpmtools.pm b/rpmtools.pm index b7b7184..50ac88e 100644 --- a/rpmtools.pm +++ b/rpmtools.pm @@ -6,29 +6,99 @@ use vars qw($VERSION @ISA); require DynaLoader; @ISA = qw(DynaLoader); -$VERSION = '0.01'; +$VERSION = '0.02'; bootstrap rpmtools $VERSION; +=head1 NAME + +rpmtools - Mandrake perl tools to handle rpm files and hdlist files + +=head1 SYNOPSYS + + require rpmtools; + + my $params = new rpmtools; + + $params->read_hdlists("/export/Mandrake/base/hdlist.cz", + "/export/Mandrake/base/hdlist2.cz"); + $params->read_rpms("/RPMS/rpmtools-2.1-5mdk.i586.rpm"); + $params->compute_depslist(); + + $params->get_packages_installed("", \@packages, \@names); + $params->get_all_packages_installed("", \@packages); + + $params->read_depslist(\*STDIN); + $params->write_depslist(\*STDOUT); + + rpmtools::version_compare("1.0.23", "1.0.4"); + +=head1 DESCRIPTION + +C<rpmtools> extend perl to manipulate hdlist file used by +Linux-Mandrake distribution to compute dependancy file. + +=head1 SEE ALSO + +parsehdlist command is a simple hdlist parser that allow interactive mode +use by DrakX upgrade algorithms. + +=head1 COPYRIGHT + +Copyright (C) 2000 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. + +=cut + #- build an empty params struct that can be used to compute dependancies. sub new { + my ($class, @tags) = @_; + my %tags; @tags{@_} = (); bless { use_base_flag => 0, - flags => [ qw(name version release size arch group requires provides) ], + flags => [ qw(name version release size arch group requires provides), + grep { exists $tags{$_} } qw(sense files obsoletes conflicts) ], info => {}, depslist => [], provides => {}, - }; + }, $class; } #- read one or more hdlist files, use packdrake for decompression. sub read_hdlists { my ($params, @hdlists) = @_; - local *F; - open F, "packdrake -c ". join (' ', @hdlists) ." |"; - rpmtools::_parse_(fileno *F, $params->{flags}, $params->{info}, $params->{provides}); - close F; + local (*I, *O); pipe I, O; + if (my $pid = fork()) { + close O; + + rpmtools::_parse_(fileno *I, $params->{flags}, $params->{info}, $params->{provides}); + + close I; + waitpid $pid, 0; + } else { + close I; + open STDOUT, ">&O" or die "unable to redirect output"; + + require packdrake; + packdrake::cat_archive(@hdlists); + + close O; + exit 0; + } 1; } @@ -65,9 +135,6 @@ sub compute_depslist { $params->{provides}{$_} = [ keys %provides ]; } - #- search for entries in provides, if such entries are found, - #- another pass has to be done. TODO. - #- take into account in which hdlist a package has been found. #- this can be done by an incremental take into account generation #- of depslist.ordered part corresponding to the hdlist. @@ -393,14 +460,17 @@ sub write_compss { 1; } -#- compare a version string. +#- compare a version string, make sure no deadlock can occur. +#- bug: "0" and "" are equal (same for "" and "0"), should be +#- trapped by release comparison (unless not correct). sub version_compare { my ($a, $b) = @_; local $_; while ($a || $b) { - my ($sb, $sa) = map { $1 if ($a || 0) =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a); + my ($sb, $sa) = map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D*)// } ($b, $a); $_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_; + $sa eq '' && $sb eq '' and return $a cmp $b; } } diff --git a/rpmtools.spec b/rpmtools.spec index ca54718..e76bfee 100644 --- a/rpmtools.spec +++ b/rpmtools.spec @@ -1,5 +1,5 @@ %define name rpmtools -%define release 4mdk +%define release 5mdk # do not modify here, see Makefile in the CVS %define version 2.1 @@ -48,10 +48,16 @@ rm -rf $RPM_BUILD_ROOT %{_bindir}/genbasefiles %dir %{perl_sitearch}/auto/rpmtools %{perl_sitearch}/auto/rpmtools/rpmtools.so +%{perl_sitearch}/packdrake.pm %{perl_sitearch}/rpmtools.pm - +%{_libdir}/perl5/man/*/* %changelog +* Wed Dec 6 2000 François Pons <fpons@mandrakesoft.com> 2.1-5mdk +- split packdrake into packdrake.pm, updated version to 0.02. +- rpmtools.pm to 0.02 too. +- added man pages. + * Thu Nov 23 2000 François Pons <fpons@mandrakesoft.com> 2.1-4mdk - fixed deadlock with version_compare(). - fixed memory leaks in parsehdlist. diff --git a/rpmtools.xs b/rpmtools.xs index 01bbdfd..07b35b4 100644 --- a/rpmtools.xs +++ b/rpmtools.xs @@ -12,6 +12,22 @@ #include <rpm/rpmlib.h> #include <rpm/header.h> +#define HDFLAGS_NAME 0x00000001 +#define HDFLAGS_VERSION 0x00000002 +#define HDFLAGS_RELEASE 0x00000004 +#define HDFLAGS_ARCH 0x00000008 +#define HDFLAGS_GROUP 0x00000010 +#define HDFLAGS_SIZE 0x00000020 +#define HDFLAGS_SENSE 0x00080000 +#define HDFLAGS_REQUIRES 0x00100000 +#define HDFLAGS_PROVIDES 0x00200000 +#define HDFLAGS_OBSOLETES 0x00400000 +#define HDFLAGS_CONFLICTS 0x00800000 +#define HDFLAGS_FILES 0x01000000 +#define HDFLAGS_DIRSIND 0x02000000 +#define HDFLAGS_FILESIND 0x04000000 + + char *get_name(Header header, int_32 tag) { int_32 type, count; char *name; @@ -28,22 +44,49 @@ int get_int(Header header, int_32 tag) { return *i; } -HV* get_info(Header header) { - HV* info = newHV(); - char *name = get_name(header, RPMTAG_NAME); - STRLEN len = strlen(name); - - if (info != 0) { - SV* sv_name = newSVpv(name, len); - SV* sv_version = newSVpv(get_name(header, RPMTAG_VERSION), 0); - SV* sv_release = newSVpv(get_name(header, RPMTAG_RELEASE), 0); +int get_bflag(AV* flag) { + int bflag = 0; + int flag_len; + SV** ret; + STRLEN len; + char* str; + int i; - hv_store(info, "name", 4, sv_name, 0); - hv_store(info, "version", 7, sv_version, 0); - hv_store(info, "release", 7, sv_release, 0); + flag_len = av_len(flag); + for (i = 0; i <= flag_len; ++i) { + ret = av_fetch(flag, i, 0); if (!ret) continue; + str = SvPV(*ret, len); + + switch (len) { + case 4: + if (!strncmp(str, "name", 4)) bflag |= HDFLAGS_NAME; + else if (!strncmp(str, "arch", 4)) bflag |= HDFLAGS_ARCH; + else if (!strncmp(str, "size", 4)) bflag |= HDFLAGS_SIZE; + break; + case 5: + if (!strncmp(str, "group", 5)) bflag |= HDFLAGS_GROUP; + else if (!strncmp(str, "sense", 5)) bflag |= HDFLAGS_SENSE; + else if (!strncmp(str, "files", 5)) bflag |= HDFLAGS_FILES; + break; + case 7: + if (!strncmp(str, "version", 7)) bflag |= HDFLAGS_VERSION; + else if (!strncmp(str, "release", 7)) bflag |= HDFLAGS_RELEASE; + else if (!strncmp(str, "dirsind", 7)) bflag |= HDFLAGS_DIRSIND; + break; + case 8: + if (!strncmp(str, "requires", 8)) bflag |= HDFLAGS_REQUIRES; + else if (!strncmp(str, "provides", 8)) bflag |= HDFLAGS_PROVIDES; + else if (!strncmp(str, "filesind", 8)) bflag |= HDFLAGS_FILESIND; + break; + case 9: + if (!strncmp(str, "obsoletes", 9)) bflag |= HDFLAGS_OBSOLETES; + else if (!strncmp(str, "conflicts", 9)) bflag |= HDFLAGS_CONFLICTS; + break; + } } + bflag |= HDFLAGS_NAME; /* this one should always be used */ - return info; + return bflag; } SV *get_table_sense(Header header, int_32 tag_name, int_32 tag_flags, int_32 tag_version, HV* iprovides) { @@ -108,33 +151,152 @@ SV *get_table_sense(Header header, int_32 tag_name, int_32 tag_flags, int_32 tag return &PL_sv_undef; } -#define HDFLAGS_NAME 0x00000001 -#define HDFLAGS_VERSION 0x00000002 -#define HDFLAGS_RELEASE 0x00000004 -#define HDFLAGS_ARCH 0x00000008 -#define HDFLAGS_GROUP 0x00000010 -#define HDFLAGS_SIZE 0x00000020 -#define HDFLAGS_SENSE 0x00080000 -#define HDFLAGS_REQUIRES 0x00100000 -#define HDFLAGS_PROVIDES 0x00200000 -#define HDFLAGS_OBSOLETES 0x00400000 -#define HDFLAGS_CONFLICTS 0x00800000 -#define HDFLAGS_FILES 0x01000000 -#define HDFLAGS_DIRSIND 0x02000000 -#define HDFLAGS_FILESIND 0x04000000 +HV* get_info(Header header, int bflag, HV* provides) { + int_32 type, count; + char **list; + int_32 *flags; + SV** ret; + STRLEN len; + char* str; + int i; + SV* sv_name = newSVpv(get_name(header, RPMTAG_NAME), 0); + HV* header_info = newHV(); + + /* correct bflag according to provides hash else not really usefull */ + if (provides) bflag |= HDFLAGS_REQUIRES; + + hv_store(header_info, "name", 4, sv_name, 0); + if (bflag & HDFLAGS_VERSION) + hv_store(header_info, "version", 7, newSVpv(get_name(header, RPMTAG_VERSION), 0), 0); + if (bflag & HDFLAGS_RELEASE) + hv_store(header_info, "release", 7, newSVpv(get_name(header, RPMTAG_RELEASE), 0), 0); + if (bflag & HDFLAGS_ARCH) + hv_store(header_info, "arch", 4, newSVpv(get_name(header, RPMTAG_ARCH), 0), 0); + if (bflag & HDFLAGS_GROUP) + hv_store(header_info, "group", 5, newSVpv(get_name(header, RPMTAG_GROUP), 0), 0); + if (bflag & HDFLAGS_SIZE) + hv_store(header_info, "size", 4, newSViv(get_int(header, RPMTAG_SIZE)), 0); + if (bflag & HDFLAGS_REQUIRES) + hv_store(header_info, "requires", 8, get_table_sense(header, RPMTAG_REQUIRENAME, + bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREFLAGS : 0, + bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREVERSION : 0, provides), 0); + if (bflag & HDFLAGS_PROVIDES) + hv_store(header_info, "provides", 8, get_table_sense(header, RPMTAG_PROVIDENAME, + bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEFLAGS : 0, + bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEVERSION : 0, 0), 0); + if (bflag & HDFLAGS_OBSOLETES) + hv_store(header_info, "obsoletes", 9, get_table_sense(header, RPMTAG_OBSOLETENAME, + bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEFLAGS : 0, + bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEVERSION : 0, 0), 0); + if (bflag & HDFLAGS_CONFLICTS) + hv_store(header_info, "conflicts", 9, get_table_sense(header, RPMTAG_CONFLICTNAME, + bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTFLAGS : 0, + bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTVERSION : 0, 0), 0); + if (provides || (bflag & HDFLAGS_FILES)) { + /* at this point, there is a need to parse all files to update provides of needed files, + or to store them. */ + AV* table_files = bflag & HDFLAGS_FILES ? newAV() : 0; + char ** baseNames, ** dirNames; + int_32 * dirIndexes; + + headerGetEntry(header, RPMTAG_OLDFILENAMES, &type, (void **) &list, &count); + + if (list) { + for (i = 0; i < count; i++) { + SV** isv; + + len = strlen(list[i]); + + if (provides && (isv = hv_fetch(provides, list[i], len, 0)) != 0) { + if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) { + SV* choice_table = (SV*)newAV(); + SvREFCNT_dec(*isv); /* drop the old as we are changing it */ + *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef; + } + if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name)); + } + /* if (provides && hv_exists(provides, list[i], len)) + hv_store(provides, list[i], len, newSVpv(name, 0), 0); */ + if (table_files) + av_push(table_files, newSVpv(list[i], len)); + } + } + + headerGetEntry(header, RPMTAG_BASENAMES, &type, (void **) &baseNames, + &count); + headerGetEntry(header, RPMTAG_DIRINDEXES, &type, (void **) &dirIndexes, + NULL); + headerGetEntry(header, RPMTAG_DIRNAMES, &type, (void **) &dirNames, NULL); + + if (baseNames && dirNames && dirIndexes) { + char buff[4096]; + char *p; + + for(i = 0; i < count; i++) { + SV** isv; + + len = strlen(dirNames[dirIndexes[i]]); + if (len >= sizeof(buff)) continue; + memcpy(p = buff, dirNames[dirIndexes[i]], len + 1); p += len; + len = strlen(baseNames[i]); + if (p - buff + len >= sizeof(buff)) continue; + memcpy(p, baseNames[i], len + 1); p += len; + + if (provides && (isv = hv_fetch(provides, buff, p - buff, 0)) != 0) { + if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) { + SV* choice_table = (SV*)newAV(); + SvREFCNT_dec(*isv); /* drop the old as we are changing it */ + *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef; + } + if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name)); + } + if (table_files) + av_push(table_files, newSVpv(buff, p - buff)); + } + } + + if (table_files) + hv_store(header_info, "files", 5, newRV_noinc((SV*)table_files), 0); + } + if (provides) { + /* we have to examine provides to update the hash here. */ + headerGetEntry(header, RPMTAG_PROVIDENAME, &type, (void **) &list, &count); + + if (list) { + for (i = 0; i < count; i++) { + SV** isv; + + len = strlen(list[i]); + + isv = hv_fetch(provides, list[i], len, 1); + if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) { + SV* choice_table = (SV*)newAV(); + SvREFCNT_dec(*isv); /* drop the old as we are changing it */ + *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef; + } + if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name)); + } + } + } + + return header_info; +} MODULE = rpmtools PACKAGE = rpmtools int -get_packages_installed(prefix, packages, lnames) +get_packages_installed(prefix, packages, lnames, ...) char* prefix SV* packages SV* lnames PREINIT: + SV* flags = &PL_sv_undef; int count = 0; CODE: + if (items > 3) + flags = ST(3); if (SvROK(packages) && SvTYPE(SvRV(packages)) == SVt_PVAV && SvROK(lnames) && SvTYPE(SvRV(lnames)) == SVt_PVAV) { AV* pkgs = (AV*)SvRV(packages); @@ -143,13 +305,15 @@ get_packages_installed(prefix, packages, lnames) SV** isv; rpmdb db; dbiIndexSet matches; - int num, i, j, rc, len; + int bflag, num, i, j, rc, len; char *name; Header header; rpmdbMatchIterator mi; if (rpmReadConfigFiles(NULL, NULL) == 0) { if (rpmdbOpen(prefix, &db, O_RDONLY, 0644) == 0) { + bflag = SvROK(flags) && SvTYPE(SvRV(flags)) ? + get_bflag((AV*)SvRV(flags)) : (HDFLAGS_NAME | HDFLAGS_VERSION | HDFLAGS_RELEASE); len = av_len(names); for (j = 0; j <= len; ++j) { isv = av_fetch(names, j, 0); @@ -158,7 +322,7 @@ get_packages_installed(prefix, packages, lnames) count=0; while (header = rpmdbNextIterator(mi)) { count++; - info = get_info(header); + info = get_info(header, bflag, NULL); if (info != 0) av_push(pkgs, newRV_noinc((SV*)info)); @@ -175,26 +339,31 @@ get_packages_installed(prefix, packages, lnames) int -get_all_packages_installed(prefix, packages) +get_all_packages_installed(prefix, packages, ...) char* prefix SV* packages PREINIT: + SV* flags = &PL_sv_undef; int count = 0; CODE: + if (items > 2) + flags = ST(2); if (SvROK(packages) && SvTYPE(SvRV(packages)) == SVt_PVAV) { AV* pkgs = (AV*)SvRV(packages); HV* info; rpmdb db; - int num; + int bflag, num; Header header; rpmdbMatchIterator mi; if (rpmReadConfigFiles(NULL, NULL) == 0) { if (rpmdbOpen(prefix, &db, O_RDONLY, 0644) == 0) { + bflag = SvROK(flags) && SvTYPE(SvRV(flags)) ? + get_bflag((AV*)SvRV(flags)) : (HDFLAGS_NAME | HDFLAGS_VERSION | HDFLAGS_RELEASE); mi = rpmdbInitIterator(db, RPMDBI_PACKAGES, NULL, 0); while (header = rpmdbNextIterator(mi)) { - info = get_info(header); + info = get_info(header, bflag, NULL); if (info != 0) av_push(pkgs, newRV_noinc((SV*)info)); @@ -224,11 +393,8 @@ _parse_(fileno_or_rpmfile, flag, info, ...) FD_t fd; int fd_is_hdlist; Header header; - int_32 type, count; - char **list; - int_32 *flags; - int bflag = 0; + int bflag; AV* iflag; HV* iinfo; HV* iprovides; @@ -257,164 +423,15 @@ _parse_(fileno_or_rpmfile, flag, info, ...) iprovides = (HV*)(provides != &PL_sv_undef ? SvRV(provides) : 0); /* examine flag and set up iflag, which is faster to fecth out */ - flag_len = av_len(iflag); - for (i = 0; i <= flag_len; ++i) { - ret = av_fetch(iflag, i, 0); if (!ret) continue; - str = SvPV(*ret, len); - - switch (len) { - case 4: - if (!strncmp(str, "name", 4)) bflag |= HDFLAGS_NAME; - else if (!strncmp(str, "arch", 4)) bflag |= HDFLAGS_ARCH; - else if (!strncmp(str, "size", 4)) bflag |= HDFLAGS_SIZE; - break; - case 5: - if (!strncmp(str, "group", 5)) bflag |= HDFLAGS_GROUP; - else if (!strncmp(str, "sense", 5)) bflag |= HDFLAGS_SENSE; - else if (!strncmp(str, "files", 5)) bflag |= HDFLAGS_FILES; - break; - case 7: - if (!strncmp(str, "version", 7)) bflag |= HDFLAGS_VERSION; - else if (!strncmp(str, "release", 7)) bflag |= HDFLAGS_RELEASE; - else if (!strncmp(str, "dirsind", 7)) bflag |= HDFLAGS_DIRSIND; - break; - case 8: - if (!strncmp(str, "requires", 8)) bflag |= HDFLAGS_REQUIRES; - else if (!strncmp(str, "provides", 8)) bflag |= HDFLAGS_PROVIDES; - else if (!strncmp(str, "filesind", 8)) bflag |= HDFLAGS_FILESIND; - break; - case 9: - if (!strncmp(str, "obsoletes", 9)) bflag |= HDFLAGS_OBSOLETES; - else if (!strncmp(str, "conflicts", 9)) bflag |= HDFLAGS_CONFLICTS; - break; - } - } - bflag |= HDFLAGS_NAME; /* this one should always be used */ - if (iprovides) bflag |= HDFLAGS_REQUIRES; /* not really usefull else */ + bflag = get_bflag(iflag); /* start the big loop, parse all header from fileno, then extract information to store into iinfo and iprovides. */ while (fd_is_hdlist >= 0 ? (fd_is_hdlist > 0 ? ((header=headerRead(fd, HEADER_MAGIC_YES)) != 0) : ((fd_is_hdlist = -1), rpmReadPackageHeader(fd, &header, &i, NULL, NULL) == 0)) : 0) { - char *name = get_name(header, RPMTAG_NAME); - SV* sv_name = newSVpv(name, 0); - HV* header_info = newHV(); - - if (bflag & HDFLAGS_NAME) - hv_store(header_info, "name", 4, SvREFCNT_inc(sv_name), 0); - if (bflag & HDFLAGS_VERSION) - hv_store(header_info, "version", 7, newSVpv(get_name(header, RPMTAG_VERSION), 0), 0); - if (bflag & HDFLAGS_RELEASE) - hv_store(header_info, "release", 7, newSVpv(get_name(header, RPMTAG_RELEASE), 0), 0); - if (bflag & HDFLAGS_ARCH) - hv_store(header_info, "arch", 4, newSVpv(get_name(header, RPMTAG_ARCH), 0), 0); - if (bflag & HDFLAGS_GROUP) - hv_store(header_info, "group", 5, newSVpv(get_name(header, RPMTAG_GROUP), 0), 0); - if (bflag & HDFLAGS_SIZE) - hv_store(header_info, "size", 4, newSViv(get_int(header, RPMTAG_SIZE)), 0); - if (bflag & HDFLAGS_REQUIRES) - hv_store(header_info, "requires", 8, get_table_sense(header, RPMTAG_REQUIRENAME, - bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREFLAGS : 0, - bflag & HDFLAGS_SENSE ? RPMTAG_REQUIREVERSION : 0, iprovides), 0); - if (bflag & HDFLAGS_PROVIDES) - hv_store(header_info, "provides", 8, get_table_sense(header, RPMTAG_PROVIDENAME, - bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEFLAGS : 0, - bflag & HDFLAGS_SENSE ? RPMTAG_PROVIDEVERSION : 0, 0), 0); - if (bflag & HDFLAGS_OBSOLETES) - hv_store(header_info, "obsoletes", 9, get_table_sense(header, RPMTAG_OBSOLETENAME, - bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEFLAGS : 0, - bflag & HDFLAGS_SENSE ? RPMTAG_OBSOLETEVERSION : 0, 0), 0); - if (bflag & HDFLAGS_CONFLICTS) - hv_store(header_info, "conflicts", 9, get_table_sense(header, RPMTAG_CONFLICTNAME, - bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTFLAGS : 0, - bflag & HDFLAGS_SENSE ? RPMTAG_CONFLICTVERSION : 0, 0), 0); - if (iprovides || (bflag & HDFLAGS_FILES)) { - /* at this point, there is a need to parse all files to update provides of needed files, - or to store them. */ - AV* table_files = bflag & HDFLAGS_FILES ? newAV() : 0; - char ** baseNames, ** dirNames; - int_32 * dirIndexes; - - headerGetEntry(header, RPMTAG_OLDFILENAMES, &type, (void **) &list, &count); - - if (list) { - for (i = 0; i < count; i++) { - SV** isv; - - len = strlen(list[i]); - - if (iprovides && (isv = hv_fetch(iprovides, list[i], len, 0)) != 0) { - if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) { - SV* choice_table = (SV*)newAV(); - SvREFCNT_dec(*isv); /* drop the old as we are changing it */ - *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef; - } - if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name)); - } - /* if (iprovides && hv_exists(iprovides, list[i], len)) - hv_store(iprovides, list[i], len, newSVpv(name, 0), 0); */ - if (table_files) - av_push(table_files, newSVpv(list[i], len)); - } - } - - headerGetEntry(header, RPMTAG_BASENAMES, &type, (void **) &baseNames, - &count); - headerGetEntry(header, RPMTAG_DIRINDEXES, &type, (void **) &dirIndexes, - NULL); - headerGetEntry(header, RPMTAG_DIRNAMES, &type, (void **) &dirNames, NULL); - - if (baseNames && dirNames && dirIndexes) { - char buff[4096]; - char *p; - - for(i = 0; i < count; i++) { - SV** isv; - - len = strlen(dirNames[dirIndexes[i]]); - if (len >= sizeof(buff)) continue; - memcpy(p = buff, dirNames[dirIndexes[i]], len + 1); p += len; - len = strlen(baseNames[i]); - if (p - buff + len >= sizeof(buff)) continue; - memcpy(p, baseNames[i], len + 1); p += len; - - if (iprovides && (isv = hv_fetch(iprovides, buff, p - buff, 0)) != 0) { - if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) { - SV* choice_table = (SV*)newAV(); - SvREFCNT_dec(*isv); /* drop the old as we are changing it */ - *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef; - } - if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name)); - } - if (table_files) - av_push(table_files, newSVpv(buff, p - buff)); - } - } - - if (table_files) - hv_store(header_info, "files", 5, newRV_noinc((SV*)table_files), 0); - } - if (iprovides) { - /* we have to examine provides to update the hash here. */ - headerGetEntry(header, RPMTAG_PROVIDENAME, &type, (void **) &list, &count); - - if (list) { - for (i = 0; i < count; i++) { - SV** isv; - - len = strlen(list[i]); - - isv = hv_fetch(iprovides, list[i], len, 1); - if (!SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVAV) { - SV* choice_table = (SV*)newAV(); - SvREFCNT_dec(*isv); /* drop the old as we are changing it */ - *isv = choice_table ? newRV_noinc(choice_table) : &PL_sv_undef; - } - if (*isv != &PL_sv_undef) av_push((AV*)SvRV(*isv), SvREFCNT_inc(sv_name)); - } - } - } + SV* sv_name = newSVpv(get_name(header, RPMTAG_NAME), 0); + HV* header_info = get_info(header, bflag, iprovides); /* once the hash header_info is built, store a reference to it in iinfo. |