From 9be8d3b3407562628b07f0b2c27b673ef208f225 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Mon, 5 Aug 2002 19:04:10 +0000 Subject: - remove obsolete stuff - move packdrake.pm in its own directory to make MakeMaker happy --- Makefile | 2 + Makefile.PL | 29 -- build_archive | 197 -------------- extract_archive | 248 ----------------- genbasefiles | 90 ------- gendepslist2.cc | 413 ----------------------------- genfilelist | 112 -------- genhdlist_cz2 | 65 ----- genhdlists | 32 --- hdlist2files.cc | 65 ----- hdlist2groups.cc | 44 ---- hdlist2names.cc | 46 ---- hdlist2prereq.cc | 53 ---- packdrake-pm/Makefile.PL | 9 + packdrake-pm/packdrake.pm | 517 ++++++++++++++++++++++++++++++++++++ packdrake.pm | 517 ------------------------------------ rpm-find-leaves.c | 50 ---- rpmtools.pm | 660 ---------------------------------------------- rpmtools.spec | 21 +- rpmtools.xs | 573 ---------------------------------------- 20 files changed, 540 insertions(+), 3203 deletions(-) delete mode 100644 Makefile.PL delete mode 100755 build_archive delete mode 100755 extract_archive delete mode 100755 genbasefiles delete mode 100644 gendepslist2.cc delete mode 100755 genfilelist delete mode 100644 genhdlist_cz2 delete mode 100644 genhdlists delete mode 100644 hdlist2files.cc delete mode 100644 hdlist2groups.cc delete mode 100644 hdlist2names.cc delete mode 100644 hdlist2prereq.cc create mode 100644 packdrake-pm/Makefile.PL create mode 100644 packdrake-pm/packdrake.pm delete mode 100644 packdrake.pm delete mode 100644 rpm-find-leaves.c delete mode 100644 rpmtools.pm delete mode 100644 rpmtools.xs diff --git a/Makefile b/Makefile index b8aaee2..70d4d4d 100644 --- a/Makefile +++ b/Makefile @@ -1,4 +1,5 @@ VERSION = 4.5 +PREFIX = /usr/local NAME = rpmtools FROMC = parsehdlist rpm2header #rpm-find-leaves FROMCC = #gendepslist2 hdlist2names hdlist2files hdlist2prereq hdlist2groups @@ -11,6 +12,7 @@ LIBRPM = -lrpm -lrpmio `perl -e 'local $$_ = qx(rpm -q --qf %{VERSION} rpm); /^4 LIBRPM_STATIC = all: $(ALL) + echo $(INSTALLVENDORLIB) install: $(ALL) install -d $(PREFIX)/usr/bin diff --git a/Makefile.PL b/Makefile.PL deleted file mode 100644 index 308216a..0000000 --- a/Makefile.PL +++ /dev/null @@ -1,29 +0,0 @@ -use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. - -# old version that works actually somewhat well... -sub version_compare { - my ($a, $b) = @_; - local $_; - - while ($a || $b) { - my ($sb, $sa) = map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D*)// } ($b, $a); - $_ = ($sa =~ /^\d/ || $sb =~ /^\d/) && length($sa) <=> length($sb) || $sa cmp $sb and return $_ || 0; - $sa eq '' && $sb eq '' and return $a cmp $b || 0; - } - 0; -} - -my $libs = ' -lrpm -lrpmio ' . (version_compare(qx(rpm -q --qf %{VERSION} rpm), "4.0.3") >= 0 && "-lrpmdb ") . '-lpopt -lz -lbz2'; - -WriteMakefile( - 'NAME' => 'rpmtools', - 'OPTIMIZE' => '-O3 -fomit-frame-pointer -fno-exceptions -fno-rtti -pipe -s -ffast-math -fexpensive-optimizations', - 'MAKEFILE' => 'Makefile_core', - 'OBJECT' => 'rpmtools.o', - 'VERSION_FROM' => 'rpmtools.pm', - 'LIBS' => [$libs], # e.g., '-lm' - 'INC' => '-I/usr/include/rpm', # e.g., '-I/usr/include/other' -); - diff --git a/build_archive b/build_archive deleted file mode 100755 index 6da6fae..0000000 --- a/build_archive +++ /dev/null @@ -1,197 +0,0 @@ -#!/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); - -#- tempory file used for building. -my $tmpdir = $ENV{TMPDIR} || "/tmp"; -my $tmpz = "$tmpdir/tmp.z.$$"; - -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 cat_compress { - my ($compress, @filenames) = @_; - local *F; - open F, "| $compress >$tmpz" or die "cannot start \"$compress\"\n"; - foreach (@filenames) { - my ($buf, $siz, $sz); - local *FILE; - open FILE, $_ or die "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 main { - my ($archivename, $maxsiz) = @_; - my ($compress, $uncompress, $off1, $siz1, $off2, $siz2) = ('', '', 0, 0, 0, 0); - my @filelist = (); - my @data = (); - my %data = (); - - die "usage: $0 \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 $tmpz; - - foreach () { - 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. - $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 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 $tmpz; diff --git a/extract_archive b/extract_archive deleted file mode 100755 index 62dac46..0000000 --- a/extract_archive +++ /dev/null @@ -1,248 +0,0 @@ -#!/usr/bin/perl - -#- Mandrake Simple Archive Extracter. -#- 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 gzip/bzip2 for perl. -#- see build_archive for more information. -#- -#- uncompressing sheme is: -#- | | -#- | | | | -#- $off1 =|*| } | | -#- |*| } $off2 =|+| } -#- |*| } $siz1 => 'gzip/bzip2 -d' => |+| } $siz2 => $filename -#- |*| } |+| } -#- |*| } | | -#- | | | | -#- | | | | -#- | | - -#+use strict qw(subs vars refs); - -#- used for uncompressing archive and other. -my %toc_trailer; -my @data; -my %data; - -#- taken from DrakX common stuff, for conveniance and modified to match our expectation. -sub dirname { @_ == 1 or die "usage: dirname \n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } -sub basename { @_ == 1 or die "usage: basename \n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ } -sub mkdir_ { - my $root = dirname $_[0]; - if (-e $root) { - -d $root or die "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 "mkdir: error creating directory $_: $!\n"; -} -sub symlink_ { mkdir_ dirname($_[1]); unlink $_[1]; symlink $_[0], $_[1] } - -#- 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; -} - -#- 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 "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 "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 "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 "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 "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 "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 > 4096 ? 4096 : $seek))) { - $seek -= $sz; - last unless $seek > 0; - } - while (($sz = sysread($input, $buf, $siz > 4096 ? 4096 : $siz))) { - $siz -= $sz; - syswrite($output, $buf); - last unless $siz > 0; - } -} - -sub main { - 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 "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 "mismatched relocation in toc\n"; - last; - }; - die "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 "cannot open archive $archivename\n"; - catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2); - exit 0; - } - } -} - -main(@ARGV); diff --git a/genbasefiles b/genbasefiles deleted file mode 100755 index 03411a9..0000000 --- a/genbasefiles +++ /dev/null @@ -1,90 +0,0 @@ -#!/usr/bin/perl - -#- 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. - -use strict qw(subs vars refs); -use rpmtools; - -sub main { - my ($output_dir, @files) = @_; - my $params = new rpmtools; - - -d $output_dir or die "usage: gendepslist \n"; - - #- this version try to use an existing profiles file to reduce - #- number of pass of parsing hdlist. - if (-r "$output_dir/provides") { - print STDERR "using existing $output_dir/provides file\n"; - open F, "$output_dir/provides"; - $params->read_provides_files(\*F); - close F; - } - - #- now, try to build dependancy, but incrementally only. - foreach (@files) { - print STDERR "reading $_\n"; - /\.rpm$/ ? $params->read_rpms($_) : $params->read_hdlists($_); - $params->compute_depslist(); - } - - my @unresolved = $params->get_unresolved_provides_files(); - if (@unresolved > 0) { - foreach (@unresolved) { - print STDERR "found requires on file not yet found [$_], forcing two other linked pass\n"; - } - - #- cleaning. - $params->keep_only_cleaned_provides_files(); - - #- much more severe cleaning here, so we are sure with 2 pass. - #- else it may happen that a package need an inexistant file, - #- which will be in the provides forever, event after fixing the - #- package. - $params->{provides} = {}; - - #- compute (avoiding depslist computation on first one. - foreach (@files) { - print STDERR "reading (second pass) $_\n"; - /\.rpm$/ ? $params->read_rpms($_) : $params->read_hdlists($_); - } - $params->keep_only_cleaned_provides_files(); - foreach (@files) { - print STDERR "reading (third pass) $_\n"; - /\.rpm$/ ? $params->read_rpms($_) : $params->read_hdlists($_); - $params->compute_depslist(); - } - } - - #- work finished, so write results: - #- $output_dir/depslist.ordered - #- $output_dir/provides - #- $output_dir/compss - print STDERR "writing $output_dir/depslist.ordered\n"; - open F, ">$output_dir/depslist.ordered" or die "unable to write depslist file $output_dir/depslist.ordered\n"; - $params->write_depslist(\*F); - close F; - print STDERR "writing $output_dir/provides\n"; - open F, ">$output_dir/provides" or die "unable to write provides file $output_dir/provides\n"; - $params->write_provides(\*F); - close F; - print STDERR "writing $output_dir/compss\n"; - open F, ">$output_dir/compss" or die "unable to write compss file $output_dir/compss"; - $params->write_compss(\*F); - close F; -} - -main(@ARGV); diff --git a/gendepslist2.cc b/gendepslist2.cc deleted file mode 100644 index 3b71259..0000000 --- a/gendepslist2.cc +++ /dev/null @@ -1,413 +0,0 @@ -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include -#include - -#define COMPATIBILITY - - -/********************************************************************************/ -/* C++ template functions *******************************************************/ -/********************************************************************************/ -template C sum(const V &v, const C &join = C()) { - typename V::const_iterator p, q; - C s = C(); - if (v.begin() != v.end()) { - for (p = q = v.begin(), q++; q != v.end(); p = q, q++) s += *p + join; - s += *p; - } - return s; -} - -vector split(char sep, const string &l) { - vector r; - for (int pos = 0, pos2 = 0; pos2 >= 0;) { - pos2 = l.find(sep, pos); - r.push_back(l.substr(pos, pos2 - pos)); - pos = pos2 + 1; - } - return r; -} - -template void map_insert(map > &m, const A &a, const B &b) { - if (m.find(a) == m.end()) m[a] = *(new set); - m[a].insert(b); -} - -template bool in(const A &a, const vector &v) { - vector::const_iterator p; - for (p = v.begin(); p != v.end(); p++) if (*p == a) return 1; - return 0; -} -template bool in(const A &a, const set &m) { - return m.find(a) != m.end(); -} -template bool in(const A &a, const map &m) { - return m.find(a) != m.end(); -} - -template map &set2map(const set &s) { - map map; - set::const_iterator p; - for (p = s.begin(); p != s.end(); p++) map[*p] = *(new B); - return map; -} - -template void add(set &v1, const B &v2) { - typename B::const_iterator p; - for (p = v2.begin(); p != v2.end(); p++) v1.insert(*p); -} -template void add(vector &v1, const B &v2) { - typename B::const_iterator p; - for (p = v2.begin(); p != v2.end(); p++) v1.push_back(*p); -} - -typedef vector::iterator ITv; -typedef set::iterator ITs; -typedef map >::iterator ITms; - -bool start_with(const string &s, const char *prefix) { - return strncmp(s.c_str(), prefix, strlen(prefix)) == 0; -} - - - -/********************************************************************************/ -/* header extracting functions **************************************************/ -/********************************************************************************/ -string get_name(Header header, int_32 tag) { - int_32 type, count; - char *name; - - headerGetEntry(header, tag, &type, (void **) &name, &count); - return string(name); -} - -int get_int(Header header, int_32 tag) { - int_32 type, count; - int *i; - - headerGetEntry(header, tag, &type, (void **) &i, &count); - return *i; -} - -vector get_info(Header header, int_32 tag) { - int_32 type, count, i; - vector r; - char **list; - - headerGetEntry(header, tag, &type, (void **) &list, &count); - if (list) { - r.reserve(count); - for (i = 0; i < count; i++) r.push_back(list[i]); - free(list); - } - return r; -} - -vector get_files(Header header) { - int_32 type, count, i; - char ** baseNames, ** dirNames; - int_32 * dirIndexes; - -#ifdef COMPATIBILITY - // deprecated one - vector r = get_info(header, RPMTAG_OLDFILENAMES); -#else - vector r; -#endif - - 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) { - r.reserve(count); - for(i = 0; i < count; i++) { - string s(dirNames[dirIndexes[i]]); - s += baseNames[i]; - r.push_back(s); - } - free(baseNames); - free(dirNames); - } - return r; -} - -/********************************************************************************/ -/* gendepslist ******************************************************************/ -/********************************************************************************/ -int nb_hdlists; -vector packages; -map sizes; -map > hdlist2names; -map name2fullname; -map > requires, frequires; -map > provided_by, fprovided_by; - -void getRequires(FD_t fd, int current_hdlist) { - set all_requires, all_frequires; - Header header; - - while ((header=headerRead(fd, HEADER_MAGIC_YES))) - { - string s_name = get_name(header, RPMTAG_NAME); - string name = s_name + "-" + get_name(header, RPMTAG_VERSION) + "-" + get_name(header, RPMTAG_RELEASE); - vector l = get_info(header, RPMTAG_REQUIRENAME); - if (in(s_name, name2fullname)) continue; - packages.push_back(name); - name2fullname[s_name] = name; - hdlist2names[current_hdlist].insert(name); - sizes[name] = get_int(header, RPMTAG_SIZE); - - for (ITv p = l.begin(); p != l.end(); p++) { - if (!start_with(*p, "rpmlib(")) { - ((*p)[0] == '/' ? frequires : requires)[name].push_back(*p); - ((*p)[0] == '/' ? all_frequires : all_requires).insert(*p); - } - } - headerFree(header); - } - for (ITs p = all_requires.begin(); p != all_requires.end(); p++) provided_by[*p] = *(new vector); - for (ITs p = all_frequires.begin(); p != all_frequires.end(); p++) fprovided_by[*p] = *(new vector); -} - -void getProvides(FD_t fd, int current_hdlist) { - map used; - Header header; - while ((header=headerRead(fd, HEADER_MAGIC_YES))) - { - string s_name = get_name(header, RPMTAG_NAME); - string name = s_name + "-" + get_name(header, RPMTAG_VERSION) + "-" + get_name(header, RPMTAG_RELEASE); - if (in(s_name, used)) continue; - used[s_name] = true; - - if (in(s_name, provided_by)) provided_by[s_name].push_back(name); - - vector provides = get_info(header, RPMTAG_PROVIDES); - for (ITv p = provides.begin(); p != provides.end(); p++) - if (in(*p, provided_by)) provided_by[*p].push_back(name); - - vector fprovides = get_files(header); - for (ITv p = fprovides.begin(); p != fprovides.end(); p++) - if (in(*p, fprovided_by)) fprovided_by[*p].push_back(name); - - headerFree(header); - } -} - -set getDep_(const string &dep, vector &l) { - set r; - switch (l.size()) - { - case 0: - r.insert((string) "NOTFOUND_" + dep); - break; - case 1: - r.insert(l[0]); - break; - default: - r.insert(sum(l, (string)"|")); - } - return r; -} - -set getDep(const string &name) { - set r; - r.insert(name); - for (ITv p = requires[name].begin(); p != requires[name].end(); p++) add(r, getDep_(*p, provided_by[*p])); - for (ITv p = frequires[name].begin(); p != frequires[name].end(); p++) add(r, getDep_(*p, fprovided_by[*p])); - return r; -} - -map > closure(const map > &names) { - map > r = names; - - map > reverse; - for (ITv i = packages.begin(); i != packages.end(); i++) reverse[*i] = *(new set); - - for (ITms i = r.begin(); i != r.end(); i++) - for (ITs j = i->second.begin(); j != i->second.end(); j++) - reverse[*j].insert(i->first); - - for (ITms i = r.begin(); i != r.end(); i++) { - set rev = reverse[i->first]; - for (ITs j = rev.begin(); j != rev.end(); j++) { - - for (ITs k = i->second.begin(); k != i->second.end(); k++) { - r[*j].insert(*k); - reverse[*k].insert(*j); - } - - } - } - return r; -} - - -//struct cmp : public binary_function { -// bool operator()(const string &a, const string &b) { -// int na = closed[a].size(); -// int nb = closed[b].size(); -// return na < nb; -// } -//}; - -inline int verif(int npack, int ndep, const string &package, const string &dep) { - if (ndep > npack && !(ndep == 0 && npack == -1)) cerr << package << " requires " << dep << " which is not in the same hdlist " << ndep << " > " << npack << "\n"; - return ndep; -} - -void printDepslist(ofstream *out1, ofstream *out2) { - - map > names; - for (ITv p = packages.begin(); p != packages.end(); p++) { - set s = getDep(*p); - s.erase(*p); - names[*p] = s; - if (out1) *out1 << *p << " " << sizes[*p] << " " << sum(s, (string) " ") << "\n"; - } - if (out2 == 0) return; - - map > closed = closure(names); - for (ITms p = closed.begin(); p != closed.end(); p++) p->second.erase(p->first); - names = closed; - - vector packages; - set list = hdlist2names[0]; - int nb2hdlist[2 * names.size()]; // the 2x is a hacky hack. nb_names is not enough, need a little more - int i = 0; - string n; - - map nb_deps_done; - for (ITms p = names.begin(); p != names.end(); p++) nb_deps_done[p->first] = 0; - - - - for (int i = -1, nb = 0; i < nb_hdlists; i++, nb++) { - set list; - - if (i == -1) { - list.insert(name2fullname["filesystem"]); nb_deps_done[name2fullname["filesystem"]] = 10; - list.insert(name2fullname["setup"]); nb_deps_done[name2fullname["setup"]] = 10; - add(list, names[name2fullname["basesystem"]]); - list.insert(name2fullname["basesystem"]); - - for (ITs p = list.begin(); p != list.end(); p++) { - if (p->find('|') != string::npos) { - list.erase(*p); - } - } - for (ITs p = list.begin(); p != list.end(); p++) { - hdlist2names[0].erase(*p); - } - } else { - list = hdlist2names[i]; - } - while (list.begin() != list.end()) { - int l_best = 9999; - - for (ITs p = list.begin(); p != list.end(); p++) { - if (start_with(*p, "NOTFOUND_")) { - list.erase(*p); - continue; - } - int lo = names[*p].size() - nb_deps_done[*p]; - if (lo < l_best) { - l_best = lo; - n = *p; - if (l_best == -1) break; - } - } - names.erase(n); - list.erase(n); - nb2hdlist[nb++] = i; - packages.push_back(n); - for (ITms p = names.begin(); p != names.end(); p++) p->second.erase(n); - } - } - cerr << "ordering done\n"; - - i = 0; - map where; - for (ITv p = packages.begin(); p != packages.end(); p++, i++) where[*p] = i; - - i = 0; - for (ITv p = packages.begin(); p != packages.end(); p++, i++) { - set dep = closed[*p]; - *out2 << *p << " " << sizes[*p]; - for (ITs q = dep.begin(); q != dep.end(); q++) { - if (q->find('|') != string::npos) { - vector l = split('|', *q); - - int skip = 0; - for (ITv k = l.begin(); k != l.end(); k++) if (*p == *k) { skip = 1; break; } - if (skip) continue; - - *out2 << " "; - int previous = 0; - for (ITv k = l.begin(); k != l.end(); k++) { - if (previous) *out2 << "|"; - previous = 1; - - verif(nb2hdlist[i], nb2hdlist[where[*k]], *p, *k); - *out2 << where[*k]; - } - } else if (start_with(*q, "NOTFOUND_")) { - *out2 << " " << *q; - } else { - verif(nb2hdlist[i], nb2hdlist[where[*q]], *p, *q); - *out2 << " " << where[*q]; - } - } - *out2 << "\n"; - } -} - -void hdlists(void (*f)(FD_t, int), const char *file, int current_hdlist) { - bool isfile = strlen(file) > 4 && strncmp(file + strlen(file) - 4, ".rpm", 4) == 0; - string cmd = isfile ? "rpm2header " : "packdrake -c "; - FILE *pipe = popen((cmd + file + " 2>/dev/null").c_str(), "r"); - - f(fdDup(fileno(pipe)), current_hdlist); - - if (pclose(pipe) != 0) { - cerr << "bad hdlist " << file << "\n"; - exit(1); - } -} - -int main(int argc, char **argv) -{ - ofstream *out1 = 0, *out2 = 0; - if (argc > 2 && (string)argv[1] == "-o") { - out1 = new ofstream(argv[2]); - out2 = new ofstream(((string)argv[2] + ".ordered").c_str()); - argc -= 2; argv += 2; - } else { - out1 = new ofstream(STDOUT_FILENO); - } - if (argc < 2) { - cerr << "usage: gendepslist2 [-o ] hdlists_cz2...\n"; - return 1; - } - - nb_hdlists = argc - 1; - - for (int i = 1; i < argc; i++) if ((string)argv[i] == "--") break; else hdlists(getRequires, argv[i], i - 1); - cerr << "getRequires done\n"; - - for (int i = 1; i < argc; i++) if ((string)argv[i] == "--") continue; else hdlists(getProvides, argv[i], i - 1); - cerr << "getProvides done\n"; - - printDepslist(out1, out2); - delete out1; - delete out2; -} diff --git a/genfilelist b/genfilelist deleted file mode 100755 index 53bd543..0000000 --- a/genfilelist +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl - -#- Generate filelist with obseletes packages. -#- 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. - -#- usage is: -#- genfilelist - - -#+use strict qw(subs vars refs); - -sub packfilelist { - my %countdir = (); - my @commonparts; - - #- search for common parts of name. - foreach (@_) { - my $filename = $_; - foreach (4..length($filename)) { - ++$countdir{substr($filename, 0, $_)}; - } - } - - my @costlysort = (sort { $countdir{$b} <=> $countdir{$a} || ($countdir{$b} == $countdir{$a} && length($b) <=> length($a)) } - grep { $countdir{$_} > 2 } - keys %countdir); - - #- pass 1: recompute counter. - foreach (grep { length($_) > 4 } @costlysort) { - my $filepart = $_; - foreach (4..length($filepart)-1) { - my $subpart = substr($filepart, 0, $_); - if (length($subpart) * $countdir{$subpart} < length($filepart) * $countdir{$filepart}) { - $countdir{$subpart} -= $countdir{$filepart} if $countdir{$filepart} > 0; - } else { - $countdir{$filepart} -= $countdir{$subpart} if $countdir{$subpart} > 0; - } - } - } - - #- pass 2: filter out overstring. - foreach (grep { length($_) > 4 && $countdir{$_} > 2 } reverse @costlysort) { - my $filepart = $_; - foreach (4..length($filepart)-1) { - delete $countdir{substr($filepart, 0, $_)}; - } - } - - #- pass 3: get result. - foreach (grep { $countdir{$_} > 2 } @costlysort) { - push @commonparts, $_ if @commonparts < 10; - } - - @commonparts; -} - -#- main program. -sub main { - my ($rpms_dir) = @_; - my (@filelist, @obsoletes) = (); - - local *RPM_QA; - open RPM_QA, "rpm -qp --queryformat \"#\%{NAME}\\n\" --obsoletes -l $rpms_dir/*.rpm |"; - foreach () { - if (/^\#/) { - #- work on previous obsoletes and filelist. - genfilelist(\@filelist, \@obsoletes); - - (@filelist, @obsoletes) = (); - - print $_; - } else { - chomp; - m|^/| ? push(@filelist, $_) : push(@obsoletes, $_); - } - } - genfilelist(\@filelist, \@obsoletes); -} - -sub genfilelist { - my ($filelist, $obsoletes) = @_; - my @commonparts = packfilelist(@$filelist); - - foreach (@$obsoletes) { print "*$_\n" } - foreach (@commonparts) { print "=$_\n" } #- commonparts are printed in from 0 to n-1. - foreach my $filename (@$filelist) { - map { - if (substr($filename, 0, length($commonparts[$_])) eq $commonparts[$_]) { - print $_ . substr($filename, length($commonparts[$_])) . "\n"; next; - } - } (0..$#commonparts); - print " $filename\n"; - } -} - -foreach (@ARGV) { - main($_); -} diff --git a/genhdlist_cz2 b/genhdlist_cz2 deleted file mode 100644 index 513358c..0000000 --- a/genhdlist_cz2 +++ /dev/null @@ -1,65 +0,0 @@ -#!/usr/bin/perl - -($noclean, @ARGV) = @ARGV if $ARGV[0] eq "--noclean"; -(undef, $depslist, @ARGV) = @ARGV if $ARGV[0] eq "--ordered-depslist"; -(undef, $hdlist, @ARGV) = @ARGV if $ARGV[0] eq "-o"; -(undef, $root, @ARGV) = @ARGV if $ARGV[0] eq "--distrib"; - -$hdlist && @ARGV == 1 || $root && @ARGV == 0 or die -"usage: genhdlist_cz2 [--noclean] [--ordered-depslist ] -o - or genhdlist_cz2 [--noclean] --distrib -"; - -chop($pwd = `pwd`); - -if ($root) { - $root = "$pwd/$root" if $root !~ m|^/|; - $depslist = "$root/Mandrake/base/depslist.ordered"; - $hdlist = "$root/Mandrake/base/hdlist.cz2"; - $dir = "$root/Mandrake/RPMS"; - $ENV{PATH} = "$ENV{PATH}:$root/misc"; -} else { - ($dir) = @ARGV; -} - -$depslist = "$pwd/$depslist" if $depslist !~ m|^/|; -$hdlist = "$pwd/$hdlist" if $hdlist !~ m|^/|; -$dir = "$pwd/$dir" if $dir !~ m|^/|; - -$tmpdir = $ENV{TMPDIR} || "/tmp"; -$work_dir = "$tmpdir/.build_hdlist"; - - --e $work_dir && !-d $work_dir and unlink($work_dir) || die "cannot use $work_dir as a working directory"; -chmod 0755, $work_dir or system("rm -rf $work_dir"); --d $work_dir or mkdir $work_dir, 0755 or die "cannot create working directory $work_dir\n"; -chdir $work_dir; - -my (%keys, @keys); - -opendir DIR, $dir or die "unable to opendir $dir: $!\n"; -while ($_ = readdir DIR) { - my ($key, $arch) = /(.*)\.(.*)\.rpm$/ or next; - system("rpm2header $dir/$_ > $_") unless -e $_; - $? == 0 or unlink($_), die "bad rpm $dir/$_\n"; - -s $_ or unlink($_), die "bad rpm $dir/$_\n"; - if ($keys{$key}) { - my ($name, $tail) = $key =~ /(.*)(-[^-]*-[^-]*)/; - $keys{"$name($keys{$key})$tail"} = $keys{$key}; unlink "$name($keys{$key})$tail"; link "$key.$keys{$key}.rpm", "$name($keys{$key})$tail"; - $keys{"$name($arch)$tail"} = $arch; unlink "$name($arch)$tail"; link $_, "$name($arch)$tail"; - delete $keys{$key}; - } else { - $keys{$key} = $arch; unlink $key; link $_, $key; - } -} -if (-e $depslist) { - open F, $depslist; - @keys = map { (split)[0] } ; -} -@keys = grep { delete $keys{$_} } @keys; - -open B, "| packdrake -b9s $hdlist 400000"; -foreach (@keys, keys %keys) { print B "$_\n" } -close B or die "packdrake failed\n"; - -system("rm -rf $work_dir") unless $noclean; diff --git a/genhdlists b/genhdlists deleted file mode 100644 index a34af88..0000000 --- a/genhdlists +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl - -use rpmtools; - -$params = new rpmtools; - -($params->{options}{noclean}, @ARGV) = @ARGV if $ARGV[0] eq "--noclean"; -(undef, $root, @ARGV) = @ARGV if $ARGV[0] eq "--distrib"; - -$root && @ARGV == 0 or die -"usage: genhdlists [--noclean] --distrib -"; - -$depslist = "$root/Mandrake/base/depslist.ordered"; -$hdlists = "$root/Mandrake/base/hdlists"; - -open F, $depslist; -$params->read_depslist(\*F); -close F; - -open F, $hdlists or die "unable to open $hdlists"; -foreach () { - chomp; - s/\s*#.*$//; - /^\s*$/ and next; - m/^\s*(hdlist\S*\.cz2?)\s+(\S+)\s*(.*)$/ or die "invalid hdlist description \"$_\" in hdlists file"; - - my ($hdlist, $dir, $descr) = ($1, $2, $3); - - $params->build_hdlist("$root/Mandrake/base/$hdlist", glob("$root/$dir/*.rpm")); -} -close F; diff --git a/hdlist2files.cc b/hdlist2files.cc deleted file mode 100644 index c439f2f..0000000 --- a/hdlist2files.cc +++ /dev/null @@ -1,65 +0,0 @@ -#include -#include -#include -#include -#include -#include - - -char *get_name(Header header, int_32 tag) { - int_32 type, count; - char *name; - - headerGetEntry(header, tag, &type, (void **) &name, &count); - return name; -} - -int get_int(Header header, int_32 tag) { - int_32 type, count; - int *i; - - headerGetEntry(header, tag, &type, (void **) &i, &count); - return *i; -} - -int main(int argc, char **argv) -{ - if (argc <= 1) { - cerr << "usage: hdlist2files []\n"; - exit(1); - } - for (int i = 1; i < argc; i++) { - FD_t fd = strcmp(argv[i], "-") == 0 ? fdDup(STDIN_FILENO) : fdOpen(argv[i], O_RDONLY, 0); - if (fdFileno(fd) < 0) cerr << "rpmpackdeps: cannot open file " << argv[i] << "\n"; - else { - Header header; - int_32 type, count; - char **list; - char ** baseNames, ** dirNames; - int_32 * dirIndexes; - - while ((header=headerRead(fd, HEADER_MAGIC_YES))) { - char *name = get_name(header, RPMTAG_NAME); - - headerGetEntry(header, RPMTAG_OLDFILENAMES, &type, (void **) &list, &count); - - if (list) { - for (i = 0; i < count; i++) printf("%s:%s\n", name, list[i]); - } - - 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) { - for(i = 0; i < count; i++) { - printf("%s:%s%s\n", name, dirNames[dirIndexes[i]], baseNames[i]); - } - } - } - } - fdClose(fd); - } -} diff --git a/hdlist2groups.cc b/hdlist2groups.cc deleted file mode 100644 index 55e53ac..0000000 --- a/hdlist2groups.cc +++ /dev/null @@ -1,44 +0,0 @@ -#include -#include -#include -#include -#include -#include - - -char *get_name(Header header, int_32 tag) { - int_32 type, count; - char *name; - - headerGetEntry(header, tag, &type, (void **) &name, &count); - return name; -} - -int get_int(Header header, int_32 tag) { - int_32 type, count; - int *i; - - headerGetEntry(header, tag, &type, (void **) &i, &count); - return *i; -} - -int main(int argc, char **argv) -{ - if (argc <= 1) { - cerr << "usage: hdlist2groups []\n"; - exit(1); - } - for (int i = 1; i < argc; i++) { - FD_t fd = strcmp(argv[i], "-") == 0 ? fdDup(STDIN_FILENO) : fdOpen(argv[i], O_RDONLY, 0); - if (fdFileno(fd) < 0) cerr << "hdlist2groups: cannot open file " << argv[i] << "\n"; - else { - Header header; - while ((header=headerRead(fd, HEADER_MAGIC_YES))) { - printf("%s:%s\n", - get_name(header, RPMTAG_NAME), - get_name(header, RPMTAG_GROUP)); - } - } - fdClose(fd); - } -} diff --git a/hdlist2names.cc b/hdlist2names.cc deleted file mode 100644 index 9cdb335..0000000 --- a/hdlist2names.cc +++ /dev/null @@ -1,46 +0,0 @@ -#include -#include -#include -#include -#include -#include - - -char *get_name(Header header, int_32 tag) { - int_32 type, count; - char *name; - - headerGetEntry(header, tag, &type, (void **) &name, &count); - return name; -} - -int get_int(Header header, int_32 tag) { - int_32 type, count; - int *i; - - headerGetEntry(header, tag, &type, (void **) &i, &count); - return *i; -} - -int main(int argc, char **argv) -{ - if (argc <= 1) { - cerr << "usage: hdlist2names []\n"; - exit(1); - } - for (int i = 1; i < argc; i++) { - FD_t fd = strcmp(argv[i], "-") == 0 ? fdDup(STDIN_FILENO) : fdOpen(argv[i], O_RDONLY, 0); - if (fdFileno(fd) < 0) cerr << "hdlist2names: cannot open file " << argv[i] << "\n"; - else { - Header header; - while ((header=headerRead(fd, HEADER_MAGIC_YES))) { - printf("%s-%s-%s.%s.rpm\n", - get_name(header, RPMTAG_NAME), - get_name(header, RPMTAG_VERSION), - get_name(header, RPMTAG_RELEASE), - get_name(header, RPMTAG_ARCH)); - } - } - fdClose(fd); - } -} diff --git a/hdlist2prereq.cc b/hdlist2prereq.cc deleted file mode 100644 index 68434f0..0000000 --- a/hdlist2prereq.cc +++ /dev/null @@ -1,53 +0,0 @@ -#include -#include -#include -#include -#include -#include - - -char *get_name(Header header, int_32 tag) { - int_32 type, count; - char *name; - - headerGetEntry(header, tag, &type, (void **) &name, &count); - return name; -} - -int get_int(Header header, int_32 tag) { - int_32 type, count; - int *i; - - headerGetEntry(header, tag, &type, (void **) &i, &count); - return *i; -} - -int main(int argc, char **argv) -{ - if (argc <= 1) { - cerr << "usage: hdlist2prereq []\n"; - exit(1); - } - for (int i = 1; i < argc; i++) { - FD_t fd = strcmp(argv[i], "-") == 0 ? fdDup(STDIN_FILENO) : fdOpen(argv[i], O_RDONLY, 0); - if (fdFileno(fd) < 0) cerr << "rpmpackdeps: cannot open file " << argv[i] << "\n"; - else { - Header header; - int_32 type, count; - char **list; - int *flags; - - while ((header=headerRead(fd, HEADER_MAGIC_YES))) { - char *name = get_name(header, RPMTAG_NAME); - - headerGetEntry(header, RPMTAG_REQUIRENAME, &type, (void **) &list, &count); - headerGetEntry(header, RPMTAG_REQUIREFLAGS, &type, (void **) &flags, &count); - - if (flags && list) - for(i = 0; i < count; i++) - if (flags[i] & RPMSENSE_PREREQ) printf("%s:%s\n", name, list[i]); - } - } - fdClose(fd); - } -} diff --git a/packdrake-pm/Makefile.PL b/packdrake-pm/Makefile.PL new file mode 100644 index 0000000..71f56ac --- /dev/null +++ b/packdrake-pm/Makefile.PL @@ -0,0 +1,9 @@ +use ExtUtils::MakeMaker; +# See lib/ExtUtils/MakeMaker.pm for details of how to influence +# the contents of the Makefile that is written. + +WriteMakefile( + 'NAME' => 'packdrake', + 'VERSION_FROM' => 'packdrake.pm', +); + diff --git a/packdrake-pm/packdrake.pm b/packdrake-pm/packdrake.pm new file mode 100644 index 0000000..d4c26e0 --- /dev/null +++ b/packdrake-pm/packdrake.pm @@ -0,0 +1,517 @@ +package packdrake; + +use strict; +use vars qw($VERSION); + +$VERSION = "0.03"; + +=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, "/lib/modules", "/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 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 + +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 \n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } +sub basename { @_ == 1 or die "packdrake: usage: basename \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, $srcdir, @filenames) = @_; + local *F; + open F, "| $ENV{LD_LOADER} $packer->{compress} >$packer->{tmpz}" + or die "packdrake: cannot start \"$packer->{compress}\"\n"; + foreach (@filenames) { + my $srcfile = $srcdir ? "$srcdir/$_" : $_; + my ($buf, $siz, $sz); + local *FILE; + open FILE, $srcfile or die "packdrake: cannot open $srcfile: $!\n"; + $siz = -s $srcfile; + 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, %options) = @_; + 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 => {}, + + log => $options{quiet} ? sub {} : sub { printf STDERR "%s\n", $_[0] }, + }, $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 (($ENV{LD_LOADER} ? ($ENV{LD_LOADER}) : ()), 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}}; + + $packer->{log}->("processing archive \"$_\""); + 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. + unless ($packer->{data}{$file}) { + $packer->{log}->("packdrake: unable to find file $file in archive $packer->{archive}"); + next; + } + + my $newfile = "$dir/$file"; + + $packer->{log}->("extracting $file"); + for ($packer->{data}{$file}[0]) { + /l/ && do { symlink_ $packer->{data}{$file}[1], $newfile; last; }; + /d/ && do { $dir and mkdir_ $newfile; last; }; + /f/ && do { $dir and 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; + } + close FILE; + } else { + local *BUNZIP2; + open BUNZIP2, "| $ENV{LD_LOADER} $packer->{uncompress}"; + local *ARCHIVE; + open ARCHIVE, "<$packer->{archive}" or die "packdrake: cannot open archive $packer->{archive}\n"; + catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2); + exec 'true'; #- exit ala _exit + } + } +} + +sub build_archive { + my ($f, $srcdir, $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; + + $packer->{log}->("choosing compression method with \"$packer->{compress}\" for archive $packer->{archive}"); + + unlink $packer->{archive}; + unlink $packer->{tmpz}; + + my $file; + while ($file = <$f>) { + chomp $file; + my $srcfile = $srcdir ? "$srcdir/$file" : $file; + -e $srcfile or die "packdrake: unable to find file $srcfile\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 $srcfile ]; + } elsif (-d $file) { + $packer->{data}{$file} = [ 'd' ]; + } else { + $siz2 = -s $srcfile; + + push @filelist, $file; + $packer->{data}{$file} = [ 'f', -1, -1, $off2, $siz2 ]; + + if ($off2 + $siz2 > $maxsiz) { #- need compression. + $siz1 = cat_compress($packer, $srcdir, @filelist); + + foreach (@filelist) { + $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ]; + } + + system "$ENV{LD_LOADER} cat '$packer->{tmpz}' >>'$packer->{archive}'"; + $off1 += $siz1; + $off2 = 0; $siz2 = 0; + @filelist = (); + } + $off2 += $siz2; + } + } + if (scalar @filelist) { + $siz1 = cat_compress($packer, $srcdir, @filelist); + + foreach (@filelist) { + $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ]; + } + + system "$ENV{LD_LOADER} cat '$packer->{tmpz}' >>'$packer->{archive}'"; + $off1 += $siz1; + } + $packer->{log}->("real archive size of $packer->{archive} is $off1"); + + #- 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/packdrake.pm b/packdrake.pm deleted file mode 100644 index d4c26e0..0000000 --- a/packdrake.pm +++ /dev/null @@ -1,517 +0,0 @@ -package packdrake; - -use strict; -use vars qw($VERSION); - -$VERSION = "0.03"; - -=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, "/lib/modules", "/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 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 - -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 \n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } -sub basename { @_ == 1 or die "packdrake: usage: basename \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, $srcdir, @filenames) = @_; - local *F; - open F, "| $ENV{LD_LOADER} $packer->{compress} >$packer->{tmpz}" - or die "packdrake: cannot start \"$packer->{compress}\"\n"; - foreach (@filenames) { - my $srcfile = $srcdir ? "$srcdir/$_" : $_; - my ($buf, $siz, $sz); - local *FILE; - open FILE, $srcfile or die "packdrake: cannot open $srcfile: $!\n"; - $siz = -s $srcfile; - 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, %options) = @_; - 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 => {}, - - log => $options{quiet} ? sub {} : sub { printf STDERR "%s\n", $_[0] }, - }, $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 (($ENV{LD_LOADER} ? ($ENV{LD_LOADER}) : ()), 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}}; - - $packer->{log}->("processing archive \"$_\""); - 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. - unless ($packer->{data}{$file}) { - $packer->{log}->("packdrake: unable to find file $file in archive $packer->{archive}"); - next; - } - - my $newfile = "$dir/$file"; - - $packer->{log}->("extracting $file"); - for ($packer->{data}{$file}[0]) { - /l/ && do { symlink_ $packer->{data}{$file}[1], $newfile; last; }; - /d/ && do { $dir and mkdir_ $newfile; last; }; - /f/ && do { $dir and 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; - } - close FILE; - } else { - local *BUNZIP2; - open BUNZIP2, "| $ENV{LD_LOADER} $packer->{uncompress}"; - local *ARCHIVE; - open ARCHIVE, "<$packer->{archive}" or die "packdrake: cannot open archive $packer->{archive}\n"; - catsksz(\*ARCHIVE, $_, $extract_table{$_}[0], \*BUNZIP2); - exec 'true'; #- exit ala _exit - } - } -} - -sub build_archive { - my ($f, $srcdir, $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; - - $packer->{log}->("choosing compression method with \"$packer->{compress}\" for archive $packer->{archive}"); - - unlink $packer->{archive}; - unlink $packer->{tmpz}; - - my $file; - while ($file = <$f>) { - chomp $file; - my $srcfile = $srcdir ? "$srcdir/$file" : $file; - -e $srcfile or die "packdrake: unable to find file $srcfile\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 $srcfile ]; - } elsif (-d $file) { - $packer->{data}{$file} = [ 'd' ]; - } else { - $siz2 = -s $srcfile; - - push @filelist, $file; - $packer->{data}{$file} = [ 'f', -1, -1, $off2, $siz2 ]; - - if ($off2 + $siz2 > $maxsiz) { #- need compression. - $siz1 = cat_compress($packer, $srcdir, @filelist); - - foreach (@filelist) { - $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ]; - } - - system "$ENV{LD_LOADER} cat '$packer->{tmpz}' >>'$packer->{archive}'"; - $off1 += $siz1; - $off2 = 0; $siz2 = 0; - @filelist = (); - } - $off2 += $siz2; - } - } - if (scalar @filelist) { - $siz1 = cat_compress($packer, $srcdir, @filelist); - - foreach (@filelist) { - $packer->{data}{$_} = [ 'f', $off1, $siz1, $packer->{data}{$_}[3], $packer->{data}{$_}[4] ]; - } - - system "$ENV{LD_LOADER} cat '$packer->{tmpz}' >>'$packer->{archive}'"; - $off1 += $siz1; - } - $packer->{log}->("real archive size of $packer->{archive} is $off1"); - - #- 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/rpm-find-leaves.c b/rpm-find-leaves.c deleted file mode 100644 index 45e2e29..0000000 --- a/rpm-find-leaves.c +++ /dev/null @@ -1,50 +0,0 @@ -#include -#include -#include -#include -#include - -static Header header; - -#define die(f) { perror(f); exit(1); } - -rpmdb open_rpmdb(void) { - rpmdb db; - if (rpmdbOpen("", &db, O_RDONLY, 0644)) die("rpmdbOpen"); - return db; -} - -char *get(int_32 tag) { - int_32 type, count; - char *s; - if (headerGetEntry(header, tag, &type, (void **) &s, &count) != 1) die("bad header ??"); - return s; -} - - -int main() { - rpmTransactionSet trans; - struct rpmDependencyConflict *conflicts; - int numConflicts; - rpmdb db; - int i; - rpmdbMatchIterator mi; - - rpmReadConfigFiles(NULL, NULL); - - db = open_rpmdb(); - - while(header = rpmdbNextIterator(mi)) { - trans = rpmtransCreateSet(db, NULL); - i=rpmdbGetIteratorOffset(mi); - rpmtransRemovePackage(trans, i); - if (rpmdepCheck(trans, &conflicts, &numConflicts)) die("rpmdepCheck"); - if (numConflicts == 0) { - printf("%s-%s-%s\n", get(RPMTAG_NAME), get(RPMTAG_VERSION), get(RPMTAG_RELEASE)); - headerFree(header); - } - rpmdepFreeConflicts(conflicts, numConflicts); - rpmtransFree(trans); - } - exit(0); -} diff --git a/rpmtools.pm b/rpmtools.pm deleted file mode 100644 index 77f1988..0000000 --- a/rpmtools.pm +++ /dev/null @@ -1,660 +0,0 @@ -package rpmtools; - -use strict; -use vars qw($VERSION @ISA %compat_arch); - -require DynaLoader; - -@ISA = qw(DynaLoader); -$VERSION = '4.4'; - -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(); - - my $db = $params->db_open(""); - $params->db_traverse_tag($db, - "name", \@names, - [ qw(name version release) ], - sub { - my ($p) = @_; - print "$p->{name}-$p->{version}-$p->{release}\n"; - }); - $params->db_traverse($db, - [ qw(name version release) ], - sub { - my ($p) = @_; - print "$p->{name}-$p->{version}-$p->{release}\n"; - }); - $params->db_close($db); - - $params->read_depslist(\*STDIN); - $params->write_depslist(\*STDOUT); - - rpmtools::version_compare("1.0.23", "1.0.4"); - -=head1 DESCRIPTION - -C extend perl to manipulate hdlist file used by -Linux-Mandrake distribution to compute dependency 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 - -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 - -%compat_arch = ( #- compatibilty arch mapping. - 'noarch' => undef, - 'i386' => 'noarch', - 'i486' => 'i386', - 'i586' => 'i486', - 'i686' => 'i586', - 'i786' => 'i686', - 'k6' => 'i586', - 'k7' => 'k6', - 'k8' => 'k7', - 'ia32' => 'i386', - 'ia64' => 'noarch', - 'ppc' => 'noarch', - 'alpha' => 'noarch', - 'sparc' => 'noarch', - 'sparc32' => 'sparc', - 'sparc64' => 'sparc32', - ); - -#- build an empty params struct that can be used to compute dependencies. -sub new { - my ($class, @tags) = @_; - my %tags; @tags{@_} = (); - bless { - flags => [ qw(name version release size arch serial group requires provides), - grep { exists $tags{$_} } qw(sense files obsoletes conflicts conffiles sourcerpm) ], - info => {}, - depslist => [], - provides => {}, - }, $class; -} - -#- read one or more hdlist files, use packdrake for decompression. -sub read_hdlists { - my ($params, @hdlists) = @_; - my @names; - - foreach my $hdlist (@hdlists) { - local (*I, *O); pipe I, O; - if (my $pid = fork()) { - close O; - - push @names, rpmtools::_parse_(fileno *I, $params->{flags}, $params->{info}, $params->{provides}); - - close I; - waitpid $pid, 0; - } else { - close I; - open STDIN, "<$hdlist" or die "unable to open archive $hdlist"; - open STDOUT, ">&O" or die "unable to redirect output"; - open STDERR, ">/dev/null" or die "unable to open /dev/null"; - - require packdrake; - my $packer = new packdrake; - - $packer->read_toc_trailer($hdlist); - - exec (($ENV{LD_LOADER} ? ($ENV{LD_LOADER}) : ()), split " ", $packer->{uncompress}); - - die "unable to cat the archive with $packer->{uncompress}"; - } - } - @names; -} - -#- build the synthesis file (normally used by urpmi only) -#- for all package not currently with computed dependencies. -sub write_synthesis_hdlist { - my ($params, $FILE) = @_; - - #- avoid writing already present infos with id. - foreach my $pkg (grep { ! exists $_->{id} } values %{$params->{info}}) { - foreach (qw(provides requires conflicts obsoletes)) { - @{$pkg->{$_} || []} and print $FILE join('@', $pkg->{name}, $_, @{$pkg->{$_} || []}) . "\n"; - } - print $FILE join('@', - $pkg->{name}, 'info', "$pkg->{name}-$pkg->{version}-$pkg->{release}.$pkg->{arch}", - $pkg->{serial} || 0, $pkg->{size} || 0, $pkg->{group}, $pkg->{file} ? ($pkg->{file}) : ()). "\n"; - } -} - -#- build an hdlist from a list of files. -sub build_hdlist { - my ($params, $noclean, $ratio, $dir, $hdlist, @rpms) = @_; - my %names; - - #- build a working directory which will hold rpm headers. - $dir ||= '.'; - -d $dir or mkdir $dir, 0755 or die "cannot create directory $dir\n"; - - foreach (@rpms) { - my ($key) = /([^\/]*)\.rpm$/ or next; #- get rpm filename. - - unless (-s "$dir/$key") { - system("$ENV{LD_LOADER} rpm2header '$_' > '$dir/$key'"); - $? == 0 or unlink("$dir/$key"), die "bad rpm $_\n"; - } - -s "$dir/$key" or unlink("$dir/$key"), die "bad rpm $_\n"; - - my ($name, $version, $release, $arch) = $key =~ /(.*)-([^-]*)-([^-]*)\.([^\.]*)$/; - my ($realname, $realversion, $realrelease, $realarch) = `$ENV{LD_LOADER} parsehdlist --raw --name '$dir/$key'` =~ - /:name:([^\:]*)-([^\:\-]*)-([^\:\-]*)\.([^\-\.\:\s]*)(?::.*\.rpm)?$/; - unless (length($name) && length($version) && length($release) && length($arch) && - $name eq $realname && $version eq $realversion && $release eq $realrelease && $arch eq $realarch) { - my $newkey = "$realname-$realversion-$realrelease.$realarch:$key"; - symlink "$dir/$key", "$dir/$newkey" unless -e "$newkey"; - $key = $newkey; - } - push @{$names{$realname} ||= []}, $key; - } - - #- compression ratio are not very high, sample for cooker - #- gives the following (main only and cache fed up): - #- ratio compression_time size - #- 9 21.5 sec 8.10Mb -> good for installation CD - #- 6 10.7 sec 8.15Mb - #- 5 9.5 sec 8.20Mb - #- 4 8.6 sec 8.30Mb -> good for urpmi - #- 3 7.6 sec 8.60Mb - open B, "| $ENV{LD_LOADER} packdrake -b${ratio}ds '$hdlist' '$dir' 400000"; - foreach (@{$params->{depslist}}) { - if (my $keys = delete $names{$_->{name}}) { - foreach (@$keys) { - print B "$_\n"; - } - } - } - foreach (values %names) { - foreach (@$_) { - print B "$_\n"; - } - } - close B or die "packdrake failed\n"; - - system(($ENV{LD_LOADER} ? ($ENV{LD_LOADER}) : ()), "rm", "-rf", $dir) unless $dir eq '.' || $noclean; -} - -#- read one or more rpm files. -sub read_rpms { - my ($params, @rpms) = @_; - - map { rpmtools::_parse_($_, $params->{flags}, $params->{info}, $params->{provides}) } @rpms; -} - -#- allocate id for newly entered value. -#- this is no more necessary to compute_depslist on them (and impossible) -sub compute_id { - my ($params) = @_; - - #- avoid recomputing already present infos, take care not to modify - #- existing entries, as the array here is used instead of values of infos. - my @info = grep { ! exists $_->{id} } values %{$params->{info}}; - - #- speed up the search by giving a provide from all packages. - #- and remove all dobles for each one ! - foreach (@info) { - $params->{provides}{$_->{name}}{"$_->{name}-$_->{version}-$_->{release}.$_->{arch}"} = undef; - } - - #- give an id to each packages, start from number of package already - #- registered in depslist. - my $global_id = scalar @{$params->{depslist}}; - foreach (sort { package_name_compare($a->{name}, $b->{name}) } @info) { - $_->{id} = $global_id++; - push @{$params->{depslist}}, $_; - } - 1; -} - -#- compute dependencies, result in stored in info values of params. -#- operations are incremental, it is possible to read just one hdlist, compute -#- dependencies and read another hdlist, and again. -sub compute_depslist { - my ($params) = @_; - - #- avoid recomputing already present infos, take care not to modify - #- existing entries, as the array here is used instead of values of infos. - my @info = grep { ! exists $_->{id} } values %{$params->{info}}; - - #- speed up the search by giving a provide from all packages. - #- and remove all dobles for each one ! - foreach (@info) { - $params->{provides}{$_->{name}}{"$_->{name}-$_->{version}-$_->{release}.$_->{arch}"} = undef; - } - - #- 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. - #- compute closed requires, do not take into account choices. - foreach (@info) { - my %required_packages; - my @required_packages; - my %requires; @requires{@{$_->{requires} || []}} = (); - my @requires = keys %requires; - - while (my $req = shift @requires) { - $req =~ /^basesystem/ and next; #- never need to requires basesystem directly as always required! what a speed up! - ref $req or $req = ($params->{info}{$req} && [ $req ] || - $params->{provides}{$req} && [ keys %{$params->{provides}{$req}} ] || - [ ($req !~ /NOTFOUND_/ && "NOTFOUND_") . $req ]); - if (@$req > 1) { - #- this is a choice, no closure need to be done here. - exists $requires{$req} or push @required_packages, $req; - $requires{$req} = undef; - } else { - #- this could be nothing if the provides is a file not found. - #- and this has been fixed above. - foreach (@$req) { - my $info = $params->{info}{$_}; - $required_packages{$_} = undef; $info or next; - if ($info->{deps} && !$info->{requires}) { - #- the package has been read from an ordered depslist file, and need - #- to rebuild its requires tags, so it can safely be used here. - my @rebuild_requires; - foreach (split ' ', $info->{deps}) { - if (/\|/) { - push @rebuild_requires, [ map { $params->{depslist}[$_]{name} || $_ } split /\|/, $_ ]; - } else { - push @rebuild_requires, $params->{depslist}[$_]{name} || $_; - } - } - $info->{requires} = \@rebuild_requires; - } - foreach (@{$info->{requires} || []}) { - unless (exists $requires{$_}) { - $requires{$_} = undef; - push @{ref $_ ? \@required_packages : \@requires}, $_; - } - } - } - } - } - unshift @required_packages, keys %required_packages; - - delete $_->{requires}; #- affecting it directly make perl crazy, oops for rpmtools. TODO - $_->{requires} = \@required_packages; - } - - #- sort packages, expand choices and closure again. - my %ordered; - foreach (@info) { - my %requires; - my @requires = ("$_->{name}-$_->{version}-$_->{release}.$_->{arch}"); - while (my $dep = shift @requires) { - foreach (@{$params->{info}{$dep} && $params->{info}{$dep}{requires} || []}) { - if (ref $_) { - foreach (@$_) { - unless (exists $requires{$_}) { - $requires{$_} = undef; - push @requires, $_; - } - } - } else { - unless (exists $requires{$_}) { - $requires{$_} = undef; - push @requires, $_; - } - } - } - } - - if ($_->{name} eq 'basesystem') { - foreach (keys %requires) { - $ordered{$_} += 10001; - } - } elsif ($_->{name} eq 'msec') { - foreach (keys %requires) { - $ordered{$_} += 20001; - } - } else { - foreach (keys %requires) { - ++$ordered{$_}; - } - } - } - - #- some package should be sorted at the beginning. - my $fixed_weight = 10000; - foreach (qw(basesystem msec * locales filesystem setup glibc sash bash libtermcap2 termcap readline ldconfig)) { - foreach (keys %{$params->{provides}{$_} || {}}) { - $ordered{$_} = $fixed_weight; - } - $fixed_weight += 10000; - } - foreach (grep { /locales-[a-zA-Z]/ } keys %ordered) { - $ordered{$_} = 35000; - } - - #- compute base flag, consists of packages which are required without - #- choices of basesystem and are ALWAYS installed. these packages can - #- safely be removed from requires of others packages. - foreach (keys %{$params->{provides}{basesystem} || {}}) { - foreach (@{$params->{info}{$_}{requires}}) { - ref $_ or $params->{info}{$_} and $params->{info}{$_}{base} = undef; - } - } - - #- some package are always installed as base and can safely be marked as such. - foreach (qw(basesystem glibc kernel)) { - foreach (keys %{$params->{provides}{$_} || {}}) { - $params->{info}{$_} and $params->{info}{$_}{base} = undef; - } - } - - #- give an id to each packages, start from number of package already - #- registered in depslist. - my $global_id = scalar @{$params->{depslist}}; - foreach (sort { ($ordered{"$b->{name}-$b->{version}-$b->{release}.$b->{arch}"} <=> - $ordered{"$a->{name}-$a->{version}-$a->{release}.$a->{arch}"}) || - package_name_compare($a->{name}, $b->{name}) } @info) { - $_->{id} = $global_id++; - } - - #- recompute requires to use packages id, drop any base packages or - #- reference of a package to itself. - foreach my $pkg (sort { $a->{id} <=> $b->{id} } @info) { - my ($id, $base, %requires_id, @requires_id); - foreach (@{$pkg->{requires}}) { - if (ref $_) { - #- all choices are grouped together at the end of requires, - #- this allow computation of dropable choices. - my ($to_drop, @choices_base_id, @choices_id); - foreach (@$_) { - my ($id, $base) = $params->{info}{$_} ? ($params->{info}{$_}{id}, exists $params->{info}{$_}{base}) : ($_, 0); - $base and push @choices_base_id, $id; - $base &&= ! exists $pkg->{base}; - $to_drop ||= $id == $pkg->{id} || $requires_id{$id} || $base; - push @choices_id, $id; - } - - #- package can safely be dropped as it will be selected in requires directly. - $to_drop and next; - - #- if a base package is in a list, keep it instead of the choice. - if (@choices_base_id) { - @choices_id = @choices_base_id; - $base = 1; - } - if (@choices_id == 1) { - $id = $choices_id[0]; - } else { - my $choices_key = join '|', sort { $a <=> $b } @choices_id; - exists $requires_id{$choices_key} or push @requires_id, \@choices_id; - $requires_id{$choices_key} = undef; - next; - } - } else { - ($id, $base) = $params->{info}{$_} ? ($params->{info}{$_}{id}, exists $params->{info}{$_}{base}) : ($_, 0); - } - - #- select individual package. - $base &&= ! exists $pkg->{base}; - $requires_id{$id} = $_; - $id == $pkg->{id} || $base or push @requires_id, $id; - } - #- cannot remove requires values as they are necessary for closure on incremental job. - $pkg->{deps} = join(' ', map { join '|', sort { $a <=> $b } @{ref $_ ? $_ : [$_]} } @requires_id); - push @{$params->{depslist}}, $pkg; - } - 1; -} - -#- read depslist.ordered file, as if it was computed internally. -sub read_depslist { - my ($params, $FILE) = @_; - my $global_id = scalar @{$params->{depslist}}; - - local $_; - while (<$FILE>) { - chomp; /^\s*#/ and next; - my ($name, $version, $release, $arch, $serial, $size, $deps) = - /^([^:\s]*)-([^:\-\s]+)-([^:\-\s]+)\.([^:\.\-\s]*)(?::(\d+)\S*)?\s+(\d+)\s*(.*)/; - - #- store values here according to it. - push @{$params->{depslist}}, - $params->{info}{"$name-$version-$release.$arch"} = { - name => $name, - version => $version, - release => $release, - arch => $arch, - $serial ? (serial => $serial) : (), - size => $size, - deps => $deps, - id => $global_id++, - }; - #- this can be really usefull as there are no more hash on name directly, - #- but provides gives something quite interesting here. - $params->{provides}{$name}{"$name-$version-$release.$arch"} = undef; - } - - #- compute base flag, consists of packages which are required without - #- choices of basesystem and are ALWAYS installed. these packages can - #- safely be removed from requires of others packages. - foreach (keys %{$params->{provides}{basesystem} || {}}) { - if ($params->{info}{$_} && ! exists $params->{info}{$_}{base}) { - my @requires_id; - foreach (split ' ', $params->{info}{$_}{deps}) { - /\|/ or push @requires_id, $_; - } - foreach ($params->{info}{$_}{id}, @requires_id) { - $params->{depslist}[$_] and $params->{depslist}[$_]{base} = undef; - } - } - } - 1; -} - -#- write depslist.ordered file according to info in params. -sub write_depslist { - my ($params, $FILE, $min, $max) = @_; - - $min > 0 or $min = 0; - defined $max && $max < scalar(@{$params->{depslist} || []}) or $max = scalar(@{$params->{depslist} || []}) - 1; - $max >= $min or return; - - for ($min..$max) { - my $pkg = $params->{depslist}[$_]; - printf $FILE ("%s-%s-%s.%s%s %s %s\n", - $pkg->{name}, $pkg->{version}, $pkg->{release}, $pkg->{arch}, - ($pkg->{serial} ? ":$pkg->{serial}" : ''), $pkg->{size} || 0, $pkg->{deps}); - } - 1; -} - -#- fill params provides with files that can be used, it use the format for -#- a provides file. -sub read_provides_files { - my ($params, $FILE) = @_; - - local $_; - while (<$FILE>) { - chomp; - my ($k, @v) = split '@'; - $k =~ /^\// and $params->{provides}{$k} ||= undef; - } - 1; -} - -#- check if there has been a problem with reading hdlists or rpms -#- to resolve provides on files. -#- this is done by checking whether there exists a keys in provides -#- hash where to value is null (and the key is a file). -#- give the result as output. -sub get_unresolved_provides_files { - my ($params) = @_; - my ($k, $v, @unresolved); - - while (($k, $v) = each %{$params->{provides}}) { - $k =~ /^\// && ! defined $v and push @unresolved, $k; - } - @unresolved; -} - -#- clean everything on provides but keep the files key entry on undef. -#- this is necessary to try a second pass. -#- support sense in flags. -sub keep_only_cleaned_provides_files { - my ($params) = @_; - my @keeplist = map { s/\[\*\]//g; $_ } grep { /^\// } keys %{$params->{provides}}; - - #- clean everything at this point, but keep file referenced. - $params->{info} = {}; - $params->{depslist} = []; - $params->{provides} = {}; @{$params->{provides}}{@keeplist} = (); -} - -#- reset params to allow other entries. -sub clean { - my ($params) = @_; - - $params->{info} = {}; - $params->{depslist} = []; - $params->{provides} = {}; -} - -#- read provides, first is key, after values. -sub read_provides { - my ($params, $FILE) = @_; - - local $_; - while (<$FILE>) { - chomp; - my ($k, @v) = split '@'; - foreach (@v) { - $params->{provides}{$k}{$_} = undef; - } - } -} - -#- write provides, first is key, after values. -sub write_provides { - my ($params, $FILE) = @_; - my ($k, $v); - - while (($k, $v) = each %{$params->{provides}}) { - printf $FILE "%s\n", join '@', $k, keys %{$v || {}}; - } -} - -#- read compss, look at DrakX for more info. -sub read_compss { - my ($params, $FILE) = @_; - my ($p, %compss); - - local $_; - while (<$FILE>) { - /^\s*$/ || /^#/ and next; - s/#.*//; - - if (/^(\S.*)/) { - $p = $1; - } else { - /(\S+)/; - $compss{$1} = $p; - } - } - - #- mark all packages which matching name with group. - foreach (@{$params->{depslist}}) { - $compss{$_->{name}} and $_->{group} = $compss{$_->{name}}; - } - - 1; -} - -#- write compss. -sub write_compss { - my ($params, $FILE) = @_; - my %p; - - foreach (values %{$params->{info}}) { - $_->{group} or next; - push @{$p{$_->{group}} ||= []}, $_->{name}; - } - foreach (sort keys %p) { - print $FILE $_, "\n"; - foreach (@{$p{$_}}) { - print $FILE "\t", $_, "\n"; - } - print $FILE "\n"; - } - 1; -} - -#- compare architecture. -sub better_arch { - my ($new, $old) = @_; - while ($new && $new ne $old) { $new = $compat_arch{$new} } - $new; -} -sub compat_arch { better_arch(arch(), $_[0]) } - -#- compare a version string, make sure no deadlock can occur. -#- try to return always a numerical value. -sub version_compare { - goto &rpmvercmp; -} -#- historical perl version (still breaks on "4m" with "4.1m"... -#- my ($a, $b) = @_; -#- local $_; -#- -#- while ($a || $b) { -#- my ($sb, $sa) = map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D*)// } ($b, $a); -#- $_ = ($sa =~ /^\d/ || $sb =~ /^\d/) && length($sa) <=> length($sb) || $sa cmp $sb and return $_ || 0; -#- $sa eq '' && $sb eq '' and return $a cmp $b || 0; -#- } -#- 0; - -#- compare package name to increase chance of avoiding loop in prerequisite chain. -sub package_name_compare { - my ($a, $b) = @_; - my ($sa,$sb); - - ($sa) = ($a =~ /^lib(.*)/); - ($sb) = ($b =~ /^lib(.*)/); - $sa && $sb and return $sa cmp $sb; - $sa and return -1; - $sb and return +1; - $a cmp $b; #- fall back. -} - -1; diff --git a/rpmtools.spec b/rpmtools.spec index 520290b..afd9593 100644 --- a/rpmtools.spec +++ b/rpmtools.spec @@ -1,5 +1,5 @@ %define name rpmtools -%define release 1mdk +%define release 2mdk # do not modify here, see Makefile in the CVS %define version 4.5 @@ -28,14 +28,17 @@ Various tools needed by urpmi and drakxtools for handling rpm files. %setup %build -%{__perl} Makefile.PL INSTALLDIRS=vendor -%{make} -f Makefile_core OPTIMIZE="$RPM_OPT_FLAGS" +( + cd packdrake-pm ; + %{__perl} Makefile.PL INSTALLDIRS=vendor + %{make} OPTIMIZE="$RPM_OPT_FLAGS" +) %{make} CFLAGS="$RPM_OPT_FLAGS" %install rm -rf $RPM_BUILD_ROOT %{make} install PREFIX=$RPM_BUILD_ROOT -%{make} -f Makefile_core install PREFIX=$RPM_BUILD_ROOT%{_prefix} +%{make} -C packdrake-pm install PREFIX=$RPM_BUILD_ROOT%{_prefix} %clean rm -rf $RPM_BUILD_ROOT @@ -48,13 +51,13 @@ rm -rf $RPM_BUILD_ROOT %{_bindir}/gendistrib %{_bindir}/distriblint %{_bindir}/genhdlist -#%{perl_vendorarch}/auto/rpmtools -%{perl_vendorarch}/packdrake.pm -#%{perl_vendorarch}/rpmtools.pm -#%{_mandir}/*/* -%{_mandir}/*/packdrake* +%{perl_vendorlib}/packdrake.pm +%{_mandir}/*/* %changelog +* Mon Aug 5 2002 Pixel 4.5-2mdk +- have packdrake.pm in non-arch dependent directory + * Mon Aug 5 2002 Guillaume Cottenceau 4.5-1mdk - add --fileswinfo query to parsehdlist so that we can know more informations on the package for which we print the files (needed by diff --git a/rpmtools.xs b/rpmtools.xs deleted file mode 100644 index 8363a7a..0000000 --- a/rpmtools.xs +++ /dev/null @@ -1,573 +0,0 @@ -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -#include -#include -#include -#include -#include -#include -#include - -#undef Fflush -#undef Mkdir -#undef Stat -#include -#include - -#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_SERIAL 0x00000040 -#define HDFLAGS_SUMMARY 0x00000080 -#define HDFLAGS_DESCRIPTION 0x00000100 -#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_CONFFILES 0x02000000 -#define HDFLAGS_SOURCERPM 0x04000000 - - -/* duplicate definition for rpmvercmp (not needed on 4.0.3 but needed on 4.0) */ -int rpmvercmp(const char *a, const char *b); - -char *get_name(Header header, int_32 tag) { - int_32 type, count; - char *name; - - headerGetEntry(header, tag, &type, (void **) &name, &count); - return name; -} - -int get_int(Header header, int_32 tag) { - int_32 type, count; - int *i; - - headerGetEntry(header, tag, &type, (void **) &i, &count); - return i ? *i : 0; -} - -int get_bflag(AV* flag) { - int bflag = 0; - int flag_len; - SV** ret; - STRLEN len; - char* str; - int i; - - 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 6: - if (!strncmp(str, "serial", 6)) bflag |= HDFLAGS_SERIAL; - break; - case 7: - if (!strncmp(str, "version", 7)) bflag |= HDFLAGS_VERSION; - else if (!strncmp(str, "release", 7)) bflag |= HDFLAGS_RELEASE; - else if (!strncmp(str, "summary", 7)) bflag |= HDFLAGS_SUMMARY; - break; - case 8: - if (!strncmp(str, "requires", 8)) bflag |= HDFLAGS_REQUIRES; - else if (!strncmp(str, "provides", 8)) bflag |= HDFLAGS_PROVIDES; - break; - case 9: - if (!strncmp(str, "obsoletes", 9)) bflag |= HDFLAGS_OBSOLETES; - else if (!strncmp(str, "conflicts", 9)) bflag |= HDFLAGS_CONFLICTS; - else if (!strncmp(str, "conffiles", 9)) bflag |= HDFLAGS_CONFFILES; - else if (!strncmp(str, "sourcerpm", 9)) bflag |= HDFLAGS_SOURCERPM; - break; - case 11: - if (!strncmp(str, "description", 11)) bflag |= HDFLAGS_DESCRIPTION; - } - } - bflag |= HDFLAGS_NAME; /* this one should always be used */ - - return bflag; -} - -STRLEN get_fullname(Header header, char *fullname) { - char *name = get_name(header, RPMTAG_NAME); - char *version = get_name(header, RPMTAG_VERSION); - char *release = get_name(header, RPMTAG_RELEASE); - char *arch = headerIsEntry(header, RPMTAG_SOURCEPACKAGE) ? "src" : get_name(header, RPMTAG_ARCH); - return sprintf(fullname, "%s-%s-%s.%s", name, version, release, arch); -} - -void update_provides(int force, HV* provides, char *name, STRLEN len, Header header) { - SV** isv; - - if (!len) len = strlen(name); - - if (provides) { - if ((isv = hv_fetch(provides, name, len, force))) { - if (isv && !SvROK(*isv) || SvTYPE(SvRV(*isv)) != SVt_PVHV) { - SV* choice_set = (SV*)newHV(); - SvREFCNT_dec(*isv); /* drop the old as we are changing it */ - *isv = choice_set ? newRV_noinc(choice_set) : &PL_sv_undef; - if (!*isv) *isv = &PL_sv_undef; - } - if (isv && *isv != &PL_sv_undef) { - char fullname[1024]; - STRLEN fullname_len = get_fullname(header, fullname); - hv_fetch((HV*)SvRV(*isv), fullname, fullname_len, 1); - } - } - } -} - -SV *get_table_sense(Header header, int_32 tag_name, int_32 tag_flags, int_32 tag_version, HV* iprovides) { - AV* table_sense; - int_32 type, count; - char **list = NULL; - int_32 *flags = NULL; - char **list_evr = NULL; - int i; - - char buff[4096]; - char *p; - int len; - - headerGetEntry(header, tag_name, &type, (void **) &list, &count); - if (tag_flags) headerGetEntry(header, tag_flags, &type, (void **) &flags, &count); - if (tag_version) headerGetEntry(header, tag_version, &type, (void **) &list_evr, &count); - - if (list) { - table_sense = newAV(); - if (!table_sense) { - free(list); - free(list_evr); - return &PL_sv_undef; - } - - for(i = 0; i < count; i++) { - len = strlen(list[i]); - if (len >= sizeof(buff) || !strncmp(list[i], "rpmlib(", 7)) continue; - memcpy(p = buff, list[i], len + 1); p+= len; - - if (flags) { - if (flags[i] & RPMSENSE_PREREQ) { - if (p - buff + 3 >= sizeof(buff)) continue; - memcpy(p, "[*]", 4); p += 3; - } - if (list_evr) { - if (list_evr[i]) { - len = strlen(list_evr[i]); - if (len > 0) { - if (p - buff + 6 + len >= sizeof(buff)) continue; - *p++ = '['; - if (flags[i] & RPMSENSE_LESS) *p++ = '<'; - if (flags[i] & RPMSENSE_GREATER) *p++ = '>'; - if (flags[i] & RPMSENSE_EQUAL) *p++ = '='; - if ((flags[i] & (RPMSENSE_LESS|RPMSENSE_EQUAL|RPMSENSE_GREATER)) == RPMSENSE_EQUAL) *p++ = '='; - *p++ = ' '; - memcpy(p, list_evr[i], len); p+= len; - *p++ = ']'; - } - } - } - } - *p = '\0'; /* make sure to mark null char, Is it really necessary ? - - /* for getting provides about required files */ - if (iprovides && buff[0] == '/') - hv_fetch(iprovides, buff, p - buff, 1); - - av_push(table_sense, newSVpv(buff, p - buff)); - } - - free(list); - free(list_evr); - return newRV_noinc((SV*)table_sense); - } - - free(list); - free(list_evr); - return &PL_sv_undef; -} - -HV* get_info(Header header, int bflag, HV* provides) { - int_32 type, count; - int_32 *flags; - SV** ret; - STRLEN len; - char* str; - int i; - 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, newSVpv(get_name(header, RPMTAG_NAME), 0), 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(headerIsEntry(header, RPMTAG_SOURCEPACKAGE) ? "src" : 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_SERIAL) - hv_store(header_info, "serial", 6, newSViv(get_int(header, RPMTAG_SERIAL)), 0); - if (bflag & HDFLAGS_SUMMARY) - hv_store(header_info, "summary", 7, newSVpv(get_name(header, RPMTAG_SUMMARY), 0), 0); - if (bflag & HDFLAGS_DESCRIPTION) - hv_store(header_info, "description", 11, newSVpv(get_name(header, RPMTAG_DESCRIPTION), 0), 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 (bflag & HDFLAGS_SOURCERPM) - hv_store(header_info, "sourcerpm", 9, newSVpv(get_name(header, RPMTAG_SOURCERPM), 0), 0); - if (provides || (bflag & (HDFLAGS_FILES | HDFLAGS_CONFFILES))) { - /* 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; - AV* table_conffiles = bflag & HDFLAGS_CONFFILES ? newAV() : 0; - char **list = NULL; - char ** baseNames = NULL; - char ** dirNames = NULL; - int_32 * dirIndexes; - - headerGetEntry(header, RPMTAG_FILEFLAGS, &type, (void **) &flags, &count); - - headerGetEntry(header, RPMTAG_OLDFILENAMES, &type, (void **) &list, &count); - if (list) { - for (i = 0; i < count; i++) { - len = strlen(list[i]); - - update_provides(0, provides, list[i], len, header); - - if (table_files) - av_push(table_files, newSVpv(list[i], len)); - if (table_conffiles && flags && flags[i] & RPMFILE_CONFIG) - av_push(table_conffiles, newSVpv(list[i], len)); - } - free(list); - } - - 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; - - update_provides(0, provides, buff, p - buff, header); - - if (table_files) - av_push(table_files, newSVpv(buff, p - buff)); - if (table_conffiles && flags && flags[i] & RPMFILE_CONFIG) - av_push(table_conffiles, newSVpv(buff, p - buff)); - } - free(baseNames); - free(dirNames); - } - - if (table_files) - hv_store(header_info, "files", 5, newRV_noinc((SV*)table_files), 0); - if (table_conffiles) - hv_store(header_info, "conffiles", 9, newRV_noinc((SV*)table_conffiles), 0); - } - if (provides) { - char **list = NULL; - /* 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++) { - update_provides(1, provides, list[i], 0, header); /* force extraction of provides */ - } - free(list); - } - } - - return header_info; -} - -void callback_empty(void) {} - -MODULE = rpmtools PACKAGE = rpmtools - - -int -rpmvercmp(a,b) - char *a - char *b - -char * -arch() - CODE: - struct utsname u; - if (uname(&u) == 0) RETVAL = u.machine; else RETVAL = NULL; - OUTPUT: - RETVAL - -void* -db_open(prefix) - char *prefix - CODE: - rpmdb db; - rpmErrorCallBackType old_cb; - old_cb = rpmErrorSetCallback(callback_empty); - rpmSetVerbosity(RPMMESS_FATALERROR); - RETVAL = rpmReadConfigFiles(NULL, NULL) == 0 && rpmdbOpen(prefix, &db, O_RDONLY, 0644) == 0 ? db : NULL; - rpmErrorSetCallback(old_cb); - rpmSetVerbosity(RPMMESS_NORMAL); - OUTPUT: - RETVAL - -void -db_close(db) - void *db - CODE: - rpmdbClose((rpmdb)db); - -void -_exit(code) - int code - -int -db_traverse_tag(db, tag, names, flags, callback) - void *db - char *tag - SV *names - SV *flags - SV *callback - PREINIT: - int count = 0; - CODE: - if (SvROK(flags) && SvTYPE(SvRV(flags)) == SVt_PVAV && - SvROK(names) && SvTYPE(SvRV(names)) == SVt_PVAV) { - AV* flags_av = (AV*)SvRV(flags); - AV* names_av = (AV*)SvRV(names); - int bflag = get_bflag(flags_av); - int len = av_len(names_av); - HV* info; - SV** isv; - int i, rpmtag; - STRLEN str_len; - char *name; - Header header; - rpmdbMatchIterator mi; - - if (!strcmp(tag, "name")) - rpmtag = RPMTAG_NAME; - else if (!strcmp(tag, "whatprovides")) - rpmtag = RPMTAG_PROVIDENAME; - else if (!strcmp(tag, "whatrequires")) - rpmtag = RPMTAG_REQUIRENAME; - else if (!strcmp(tag, "group")) - rpmtag = RPMTAG_GROUP; - else if (!strcmp(tag, "triggeredby")) - rpmtag = RPMTAG_BASENAMES; - else if (!strcmp(tag, "path")) - rpmtag = RPMTAG_BASENAMES; - else { - croak("unknown tag"); - len = 0; - } - - for (i = 0; i <= len; ++i) { - isv = av_fetch(names_av, i, 0); - name = SvPV(*isv, str_len); - mi = rpmdbInitIterator((rpmdb)db, rpmtag, name, str_len); - while (header = rpmdbNextIterator(mi)) { - count++; - info = get_info(header, bflag, NULL); - - if (info != 0 && callback != &PL_sv_undef && SvROK(callback)) { - dSP; - ENTER; - SAVETMPS; - PUSHMARK(SP); - XPUSHs(sv_2mortal(newRV_noinc((SV*)info))); - XPUSHs(sv_2mortal(newSVpv(name, str_len))); - PUTBACK; - call_sv(callback, G_DISCARD | G_SCALAR); - FREETMPS; - LEAVE; - } - } - rpmdbFreeIterator(mi); - } - } else croak("bad arguments list"); - RETVAL = count; - OUTPUT: - RETVAL - -int -db_traverse(db, flags, callback) - void *db - SV *flags - SV *callback - PREINIT: - int count = 0; - CODE: - if (SvROK(flags) && SvTYPE(SvRV(flags)) == SVt_PVAV) { - AV* flags_av = (AV*)SvRV(flags); - int bflag = get_bflag(flags_av); - HV* info; - Header header; - rpmdbMatchIterator mi; - - mi = rpmdbInitIterator(db, RPMDBI_PACKAGES, NULL, 0); - while (header = rpmdbNextIterator(mi)) { - info = get_info(header, bflag, NULL); - - if (info != 0 && callback != &PL_sv_undef && SvROK(callback)) { - dSP; - ENTER; - SAVETMPS; - PUSHMARK(SP); - XPUSHs(sv_2mortal(newRV_noinc((SV*)info))); - PUTBACK; - call_sv(callback, G_DISCARD | G_SCALAR); - FREETMPS; - LEAVE; - } - ++count; - } - rpmdbFreeIterator(mi); - } else croak("bad arguments list"); - RETVAL = count; - OUTPUT: - RETVAL - -void -_parse_(fileno_or_rpmfile, flag, info, ...) - SV* fileno_or_rpmfile - SV* flag - SV* info - PREINIT: - SV* provides = &PL_sv_undef; - PPCODE: - if (items > 3) - provides = ST(3); - if (SvROK(flag) && SvROK(info) && (provides == &PL_sv_undef || SvROK(provides))) { - FD_t fd; - int fd_is_hdlist; - Header header; - - int bflag; - AV* iflag; - HV* iinfo; - HV* iprovides; - SV** ret; - I32 flag_len; - STRLEN len; - char* str; - int i; - - if (SvIOK(fileno_or_rpmfile)) { - int d = SvIV(fileno_or_rpmfile); - fd_set readfds; - struct timeval timeout; - - FD_ZERO(&readfds); - FD_SET(d, &readfds); - timeout.tv_sec = 1; - timeout.tv_usec = 0; - select(d+1, &readfds, NULL, NULL, &timeout); - - fd = fdDup(SvIV(fileno_or_rpmfile)); - fd_is_hdlist = 1; - } else { - fd = fdOpen(SvPV_nolen(fileno_or_rpmfile), O_RDONLY, 0666); - if (fd < 0) croak("unable to open rpm file %s", SvPV_nolen(fileno_or_rpmfile)); - fd_is_hdlist = 0; - } - - if ((SvTYPE(SvRV(flag)) != SVt_PVAV) || - (SvTYPE(SvRV(info)) != SVt_PVHV) || - provides != &PL_sv_undef && (SvTYPE(SvRV(provides)) != SVt_PVHV)) - croak("bad arguments list"); - - iflag = (AV*)SvRV(flag); - iinfo = (HV*)SvRV(info); - iprovides = (HV*)(provides != &PL_sv_undef ? SvRV(provides) : 0); - - /* examine flag and set up iflag, which is faster to fecth out */ - bflag = get_bflag(iflag); - - /* start the big loop, - parse all header from fileno, then extract information to store into iinfo and iprovides. */ - if (fd_is_hdlist) { - while (fd_is_hdlist < 20 && (header=headerRead(fd, HEADER_MAGIC_YES)) == 0) { - struct timeval timeout; - - timeout.tv_sec = 0; - timeout.tv_usec = 10000; - select(0, NULL, NULL, NULL, &timeout); - - ++fd_is_hdlist; - } - } else { - if (rpmReadPackageHeader(fd, &header, &i, NULL, NULL) != 0) - header = 0; - } - while (header != 0) { - char fullname[1024]; - STRLEN fullname_len = get_fullname(header, fullname); - HV* header_info = get_info(header, bflag, iprovides); - - hv_store(iinfo, fullname, fullname_len, newRV_noinc((SV*)header_info), 0); - - /* return fullname on stack */ - EXTEND(SP, 1); - PUSHs(sv_2mortal(newSVpv(fullname, fullname_len))); - - /* dispose of some memory */ - headerFree(header); - - /* continue loop for hdlist */ - if (fd_is_hdlist) - header=headerRead(fd, HEADER_MAGIC_YES); - else - header=0; - } - fdClose(fd); - } else croak("bad arguments list"); -- cgit v1.2.1