rendered paste body#!/usr/bin/perl -w# Paulo Trezentos - Caixa Mágica 2009# This is the main wrapper responsible for the pipeline of apt-pbo## For example:# apt-pbo install car# |__ apt-get pboinstall car# + /tmp/problem.pbo# |__ minisat+ /tmp/problem.pbo# + car turbo wheel # |__ apt-get install car turbo wheel # use strict;use Term::ANSIColor;use Switch;use File::Copy;use Getopt::Long;use Data::Dumper;use AptPkg::Config '$_config';use AptPkg::System '$_system';use AptPkg::Cache;(my $self = $0) =~ s#.*/##;# Argumentsmy $pbopolicy="";my $solver="";my $pbooptimal="";my $cudfarg;my $benchmark = 0;# Process argumentsGetOptions("p=s"=>\$pbopolicy, "b" =>\$benchmark, "s=s" =>\$solver, "c=s" =>\$optconf, "to=i"=> \$pbooptimal, "cudfin=s" => \$cudfin, "cudfout=s" => \$cudfout, "criterion=s" => \$criterion);# $ARGV[0] must be "install" #$packagename=$ARGV[1];usage() if ((! defined $cudfin) && (! defined $ARGV[0]) && ($ARGV[0] ne "install") );my $logdir;my $aptdef;my $dpkgdef;my $aptconf;my $checkbroken;my $pbo ;my $pkgsfile ;my $statusfile;my $minisatbin;my $wbobin ;my $opbdpbin ;my $bsolobin ;my $timeelapse = 0;my $timepboenc = 0;my $timeminisat = 0;my $timeparsesol = 0;my $timeparserdeps = 0;my $timeinstall = 0;my $timestart = 0;my $timestop = 0;my %cacheprovides ;my %cacherdepends ;my %cacherconflicts ;my $tpkg = $ARGV[1];my $instcmd;my $line;my $line2=""; my %installedpackages;my %packages2install;my %packages2remove;my %packages2update;my %ipackages;my %upackages;my %dpackages;my %rpackages;my $print_upkgs="";my $print_dpkgs="";my @check_rdeps=();my @check_rconfs=();our @pbopkgs;my $worktodo=1;my $numiterations=0;my $cache;my $policy;if (defined $cudfin) { $homedir="."; die "\n Error: the solver is not being run from the solver directory. Change into it or correct \$homedir variable.\n\n" if (! -f $homedir . "/cudf_parsing.pl"); require "$homedir/cudf_parsing.pl";# Configuration variables $logdir = "$homedir/log/"; $aptdef = "$homedir/tools/apt-get.sh"; # Can't use a static binary due to C++ global constructors and linker $apt_cache_wrapper = "$homedir/tools/apt-cache"; $dpkgdef = "$homedir/tools/dpkg --admindir=dpkg/"; # static binary $aptconf = "-c=$homedir/conf/apt.conf"; $checkbroken = "-f"; $pbo = "$homedir/tmp/problem.pbo"; $pkgsfile = "$homedir/repo/Packages"; $statusfile = "$homedir/dpkg/status"; $minisatbin = "./tools/minisat+"; $wbobin = "./tools/wbo"; $bsolobin = "./tools/bsolo"; $opbdpbin = "./tools/opbdp"; $cudftodebbin = "./tools/cudftodeb.native"; if (defined $criterion) { &parse_criterion($criterion) } }else{ $bindir="/usr/bin/"; $tmpdir="/tmp/"; # Configuration variables $logdir = $tmpdir; $aptdef = $bindir . "apt-get"; # $aptdef = $bindir . "apt-get --reduced-tree"; $dpkgdef = `which dpkg`; if (defined $optconf) { $aptconf = "-c=" . $optconf; } else { $aptconf = ""; } $checkbroken = ""; $pbo = $tmpdir . "problem.pbo"; $minisatbin = $bindir . "minisat+"; $wbobin = $bindir . "wbo"; $opbdpbin = $bindir . "opbdp"; $bsolobin = $bindir . "bsolo";}if ($instcmd = `which rpm` ne ""){ $pkgsystem="rpm"; $instcmd = `which rpm`; chomp($instcmd);}elsif ($instcmd = `which dpkg` ne ""){ $pkgsystem="deb"; $instcmd = $dpkgdef; chomp($instcmd);}else{ die "Can't find rpm or dpkg commands!\n";}sub parse_criterion {}sub usage { print "apt-pbo (http://aptpbo.caixamagica.pt) \n"; print "Usage: apt-pbo [options] install pkg \n\n"; print "Apt-pbo is a meta-installer that uses pseudo-boolean optimization to find a solution of the packages to install / remove.\n\n"; print "Options:\n"; print " -p=? Policy for choosing the solution (-p=freshness|-removal|-number)\n"; print " -s=? PBO solver to be used (-s=minisat+|bsolo|opbdp|wbo[default]) \n"; print " -cudf=? CUDF file to load \n"; print " -o Solver provides the optimal solution.\n\n"; die "Error: wrong number of arguments. \n\n"; }#List membership sub member_of_list { my @list = $_[0]; my $elem = $_[1]; foreach my $e (@list) { if ($e == $elem) { return 1; } } return 0;}sub get_provides { my ($name, $version) = @_; if (! defined $version) { print (" Package $name does not have version. Broken? Ignoring it. \n"); return ; } if (!defined $cacheprovides{$name}) { my $p = $cache->{$name}; unless ($p) { # warn "$self: Don't know anything about package `$name'\n"; return; } if (my $available = $p->{VersionList}) { for my $v (@$available) { if ($v->{VerStr} eq $version) { if (my $prov = $v->{ProvidesList}) { $cacheprovides{$name}=join ' ', map $_->{Name}, @$prov; return (map $_->{Name}, @$prov); } } } } $cacheprovides{$name}=""; } else { return $cacheprovides{$name}; }}sub extract_version() { my ($elem)=@_; my $name; my $version; # Finding version and release #print "Elem: $elem \n" if ($elem =~ m/libstdc/); if ($elem =~ /(.+)_(\d[^_]*-[^-]*)$/) { $name=$1; $version=$2; $elem =~ s/-([^-]*-[^-]*)$/.............................$1/g; } elsif ($elem =~ /(.+)_(\d[^_]*)$/) { #print " Package name no release: $elem - $1 - $2.\n"; # Package name does not have release, so by the rules # version number can not have "-" # print "Package name:$1\n"; $name=$1; # print "Version-release:$2\n"; $version=$2; } else { $name=$elem; } # $version =~ s/(-[\w+\.]+\d)$//g; # Apaga a release # Remove epoch # $version =~ s/^[\d]://g; #print "$name | $version\n"; return ($name,$version);}sub extract_qa_rpm() { my ($elem)=@_; my $name; my $version; my $release; my $tversion; if($elem =~ s/-([^-]*)$//g){ $release=$1; } if($elem =~ s/-([\w+.\w+]*)$/-$1/g){ $tversion=$1; } if($elem =~ s/-([^-]*)$//g){ $name=$elem; } $version = $tversion . "-" . $release; return ($name, $version);}sub extract_qa_deb(){ my ($elem)=@_; my $name; my $version;# format of dpkg -l:# ii apt-pbo 0.91-1 An meta-installer that uses PBO solving if($elem =~ s/^\w\w\s+(\S+)\s+(\S+)//g){ $name=$1; $version=$2; # Remove epoch # $version =~ s/^[\d]://g; }# print " - $name | $version - \n"; return ($name, $version);}sub list_pkg { my $pkglist = ( $pkgsystem eq "rpm" ) ? "$instcmd -qa" : "$instcmd -l "; my %ipkgs; my ($name, $version); open(PKGLIST, "$pkglist |") or die "Can't execute '$pkglist'!\n"; foreach $elem (<PKGLIST>) { chomp($elem); if ($pkgsystem eq "rpm") { ($name,$version) = &extract_qa_rpm($elem); } elsif ($pkgsystem eq "deb") { if ($elem =~ /^\wi/ || $elem =~ /^\wU/) { # ii/iU and rc are valid lines in dpkg output ($name,$version) = &extract_qa_deb($elem); } else { next; } } $ipkgs{$name}=$version; } close (PKGLIST); return %ipkgs;}sub cache_installed_versions { my $pkgname = $_[0]; my @installed_versions;#Grab all "installed" versions from apt-cache show $vs = `$apt_cache_wrapper $aptconf show $pkgname`; foreach my $pkg_block (split(/\n\n/, $vs)) { if ($pkg_block =~ /Status:.+installed/) { if ($pkg_block =~ /Version: (\d+)/) { push(@installed_versions, $1); } } }return @installed_versions;}#Returns a hash with lists as values for all installed versionssub list_installed_versions { my %ipkgs; my ($name, $version); $pkglist_cmd = "$instcmd -l"; open(PKGLIST, "$pkglist_cmd |") or die "Can't execute '$pkglist'!\n"; foreach my $elem (<PKGLIST>) { chomp($elem); if ($elem =~ /^\wi/ || $elem =~ /^\wU/) { # ii/iU and rc are valid lines in dpkg output ($name,$version) = &extract_qa_deb($elem); } else { next; } foreach my $ver (cache_installed_versions($name)) { push(@{$ipkgs{$name}}, $ver); } } close (PKGLIST); return %ipkgs;}sub print { my ($options, $string) = @_; print color $options; print $string; print color 'reset';}sub runapt{ my $pbotmp=shift(@_); my $pkgtmp = join(' ',@_); if ( $numiterations eq 1) { print "\nBeginning dependencies problem solving...\n"; } else { print "\n New iteration (#$numiterations) \n"; } print " [1] Encoding problem as PBO...\n"; # print "$aptdef $pbotmp pboinstall $pkgtmp\n";# print "$aptdef $pbotmp pboinstall " . length($pkgtmp) . " \n"; $timestart=time(); $pbopolicy="removal" if ($pbopolicy eq "" ); open(APTPBOCMD, "$aptdef $aptconf $checkbroken -p=$pbopolicy pboinstall $pkgtmp 2>&1 |") or die "Can't execute apt-get 'apt-get pboinstall $ARGV[1]'\n!\n"; #print "Debug: Running $aptdef $aptconf $checkbroken -p=$pbopolicy pboinstall $pkgtmp \n"; while (<APTPBOCMD>) { $line = $_; #print "\t PBOINSTALL $line"; # Unable to locate package aasas die "Can't execute 'apt-get -p $pbopolicy pboinstall $pkgtmp'\n $line\n" if ( ($line =~/^W:/) || ($line =~ /^E:/) || ($line =~ /[sS]egmentation fault/) ); } close(APTPBOCMD); $timestop = time(); $timepboenc = $timepboenc + $timestop - $timestart; my $pbologname=$pkgtmp; $pbologname =~ s/ //g; $pbologname =~ s/://g; $pbologname = substr($pbologname, 0, 32); copy($pbo, $logdir . "pbo/" . $pbologname . "." . $numiterations . ".pbo"); print " PBO problem encoding finished. \n";# print " Stored in: $pbo. \n\n"; }sub parsing_solver_output { my $solverSolution; while (<MINICMD>) { $line = $_; if ( $line =~ /^v/) { # wbo / minisat+ output solution $line =~ s/^v //g; $solverSolution = $line; } elsif ( $line =~ /^0-1 Variables fixed to 1 :/) { # opbdp output solution $line =~ s/^0-1 Variables fixed to 1 : //g; $solverSolution = $line; print "opbdp: $line \n"; } elsif (( $line =~ /^s\sUNSATISFIABLE/) || ( $line =~ /^Constraint Set is unsatisfiable/)) { print "\n [3] No solution found. \n"; my @broken; my $failmsg; open(PBOFILE, "<$pbo") or die "Can't open PBO file to parse ($pbo)!\n"; while (<PBOFILE>) { $line = $_; if($line =~ s/BROKEN_(\w[^_]+)_(\w[^_]+)_(.*?)\s+(.*)//g){ @brokdep=($1,$2,$3,$4); if ( $brokdep[3] =~ /^-1\*(.*?)\s+/ ) { print " Relation \"package $1 $brokdep[0] -> $brokdep[1] -$brokdep[2]\" is broken in the repository\n"; $failmsg=$failmsg . "Relation \"package $1 $brokdep[0] -> $brokdep[1]-$brokdep[2]\" is broken in the repository\n"; } } } close (PBOFILE); if (defined $cudfout) { &write_no_solution_cudf($cudfout,$failmsg) ; exit(0); } die "\n \n"; } elsif ( $line =~ /^s\sUNKNOWN/) { if (defined $cudfout) { &write_no_solution_cudf($cudfout,"Solver timeout") ; exit(2); } } } return $solverSolution;}sub parsing_solution_install {#print "Debugging packages2install:\n";#print Dumper(\%packages2install); foreach $pkgname_in (keys %packages2install){ foreach $version_in (@{$packages2install{$pkgname_in}}) { #print Dumper(); if (!grep {$_ eq $version_in} @{$installedpackages{$pkgname_in}}) { $ipackages{$pkgname_in} = $version_in; #TODO: still doesnt cope with multiple versions # print "Not installed: $name1 | $ipackages{$name1} | $version1\n"; print "Vou instalar: $pkgname_in - $version_in\n"; if ( ! grep( /^$name1$/,@check_rconfs ) ) { push(@check_rconfs,$pkgname_in); } } }}}sub parsing_solution_remove{ foreach $name1 (keys %packages2remove) { foreach $version1 (@{$packages2remove{$name1}}) { # warn chomp($version1); # print " H:$name1 1:$version1 \n"; if (exists $installedpackages{$name1}){ # Pacote está instalado #if(!exists $packages2install{$name1}){ #Ignore removed packages involved in {up,down}grades #print " H:$name1 -$version1-$version2- \n"; if (grep {$_ eq $version1} @{$installedpackages{$name1}}) { $rpackages {$name1} = $version1; if ( ! grep( /^$name1$/,@check_rdeps ) ) { push(@check_rdeps,$name1); print "Vou remover: $name1-$version1\n"; }# If the package has a "Provides:" we have to check # if the provides is not a dependency of a installed package my @provides=&get_provides($name1,$version1); foreach $elem (@provides) { if ( ! grep( /^$elem$/,@check_rdeps ) ) { print "Vou remover: $elem \n"; push(@check_rdeps,$elem); } } } # } } } }}sub parsing_solution{ my $solution=shift(@_); my @foo = (split / /,$solution); foreach $elem (@foo) { if ($elem =~ m/^-.*/) { # Pacotes que não podem estar instalados $elem =~ s/^-//g; # Remove o - do início chomp($elem); ($name,$version) = &extract_version($elem); if ($elem){ # A simple hash doesn't work because a package can have multiple versions. # We use an array of the versions to be removed in the value of the hash. push(@{ $packages2remove{$name} }, $version); # $packages2remove{$name}=$version; } next } chomp($elem); if ( ! $elem ) { next } ($name,$version) = &extract_version($elem); if ( $elem ) { # Remove epoch# $version =~ s/^\d://g; push (@{$packages2install{$name}},$version); } # print "$name | $version\n"; } &parsing_solution_remove(); &parsing_solution_install(); }sub write_solution_cudf2 { my $cudfoutfile=shift; my %ipackages=%{$_[0]}; my %upackages=%{$_[1]}; my %dpackages=%{$_[2]}; my %rpackages=%{$_[3]}; my $print_upkgs=$_[4]; my $print_dpkgs=$_[5]; #print Data::Dumper->Dump([\%ipackages, \%upackages, \%dpackages, \%rpackages], [qw(i u d r)]); #TODO: Choose correctly the tempfile location open(TEMPFILE, ">", './tmp/changes.out'); if(keys( %ipackages ) != 0 ){ while ( my ($key, $value) = each(%ipackages) ) { print TEMPFILE "Inst $key [$value]\n"; } } if(keys ( %rpackages ) != 0){ while ( my ($key, $value) = each(%rpackages) ) { print TEMPFILE "Remv $key [$value]\n"; } } if (keys( %upackages) != 0) { while ( my ($key, $value) = each(%upackages) ) { my $temp = quotemeta($key); if ($print_upkgs =~ m/\s$temp\((.*?)\s.*?\s(.*?)\)/) { print TEMPFILE "Inst $key [$1] [$2]\n"; } } } if (keys( %dpackages) != 0) { while ( my ($key, $value) = each(%dpackages) ) { my $temp = quotemeta($key); if ($print_dpkgs =~ m/\s$temp\((.*?)\s.*?\s(.*?)\)/) { print TEMPFILE "Inst $key [$1] [$2]\n"; } } }#Call aptsolutions.native print "Writing cudf solution to $cudfout\n"; my $cudfoutput = `./tools/aptsolutions.native cudf://$cudfin ./tmp/changes.out`;#Write the output to cudfoutfile open(TEMPFILE, ">", $cudfout); print TEMPFILE $cudfoutput; close(TEMPFILE);}sub call_minisat{ %packages2install=(); %packages2remove=(); %packages2update=(); %ipackages=(); %upackages=(); %dpackages=(); %rpackages=(); $print_upkgs=""; $print_dpkgs=""; if (! $pbooptimal) { # Default. No timeout. $msat_timeout=0; } else { # User set alarm time (in seconds). $msat_timeout=$pbooptimal; } my ($pbotmp) = @_; my $line; my $solution; if (! $solver) { $solver="wbo"; } print " [2] Executing solver ($solver)...\n"; $timestart = time(); open STDERR, '>&STDOUT'; if ($solver eq "minisat+") { if ( ! -e $minisatbin) { die "Solver binary $wbobin is not present in the system\n\n"; } open(MINICMD, "$minisatbin -alarm=$msat_timeout $pbotmp 2>&1 |") or die "Can't execute minisat '$minisatbin -alarm=$msat_timeout $pbotmp'\n!\n"; } elsif ( $solver =~ /wbo/) { if ( ! -e $wbobin) { die "Solver binary $wbobin is not present in the system\n\n"; } if (! $msat_timeout ) { open(MINICMD, "$wbobin -file-format=opb $pbotmp 2>&1 |") or die "Can't execute solver '$wbobin -file-format=opb $pbotmp'\n!\n"; } else { open(MINICMD, "$wbobin -file-format=opb -search-mode=2 -time-limit=$msat_timeout $pbotmp 2>&1 |") or die "Can't execute solver '$wbobin -file-format=opb $pbotmp'\n!\n"; # print "Debug: $wbobin -file-format=opb -search-mode=2 -time-limit=$msat_timeout $pbotmp "; } } elsif ( $solver =~ /bsolo/) { if ( ! -e $bsolobin) { die "Solver binary $bsolobin is not present in the system\n\n"; } open(MINICMD, "$bsolobin -t$msat_timeout $pbotmp 2>&1 |") or die "Can't execute solver '$bsolobin -file-format=opb $pbotmp'\n!\n"; } elsif ( $solver =~ /opbdp/) { if ( ! -e $opbdpbin) { die "Solver binary $opbdpbin is not present in the system\n\n"; } open(MINICMD, "$opbdpbin -f$pbotmp -s 2>&1 |") or die "Can't execute solver '$opbdpbin -file$pbotmp'\n!\n"; } else { die "\n Invalid solver. Solvers available: wbo, minisat+,opbd . \n\n"; } close STDERR; $solution=&parsing_solver_output(); $timestop = time(); $timeminisat = $timeminisat + $timestop-$timestart; # print " Time minisat: $timeminisat \n"; print " Parsing the solution\n"; $timestart = time(); &parsing_solution($solution); $timeparsesol = $timeparsesol + $timestop-$timestart; # print " Time parsesol: $timeparsesol \n";}sub print_solution{ if ((keys( %ipackages ) == 0 ) && (keys( %upackages ) == 0) && (keys( %dpackages ) == 0) && (keys ( %rpackages ) == 0 ) ) { if (defined $cudfout) { # &write_no_solution_cudf($cudfout,"No solution found. Verify if package is not already installed or inexistent.\n\n") ; return; } die "\n [3] No solution found. Verify if package is not already installed or inexistent.\n\n"; } print " [3] Found a solution: \n"; if(keys( %ipackages ) != 0 ){ &print ("bold green", " Packages to install:"); while ( my ($key, $value) = each(%ipackages) ) { print "$key(=$value) "; } &print ("bold", "\n Total packages to install: " . keys( %ipackages ) ."\n\n"); } if(keys( %upackages ) != 0){ &print ("bold yellow", " Packages to update: "); print "$print_upkgs\n"; &print ("bold", " Total packages to update: ". keys( %upackages ) ." \n\n"); } if(keys ( %dpackages ) != 0){ &print ("bold yellow", " Packages to downgrade: "); print "$print_dpkgs\n"; &print ("bold", " Total packages to downgrade: ". keys( %dpackages ) ."\n\n"); } if(keys ( %rpackages ) != 0){ &print ("bold red", " Packages to remove: "); while ( my ($key, $value) = each(%rpackages) ) { print "$key(=$value) "; } &print ("bold", "\n Total packages to remove: ". keys( %rpackages ) ."\n"); }}sub install_packages{ # TODO # 1.- este install package tem de ter o caminho para o ficheiro # 2.- O caminho tem de ter a versao escapada my @installpackages; $timestart = time(); # Merge dpkgs into upkgs @ipackages{keys %dpackages} = values %dpackages; @ipackages{keys %upackages} = values %upackages; while ( my ($key, $value) = each(%ipackages) ) { my $esc_version = $value; $esc_version=~ s/:/%3a/g; push(@installpackages, '/var/cache/apt/archives/' . $key . "_" . $esc_version . "_*deb"); } my @removepackages=(keys(%rpackages)); if ($pkgsystem eq "rpm") { $raptcmd = $instcmd . " -e @removepackages"; $iaptcmd = $instcmd . " -Uh @installpackages"; } elsif ($pkgsystem eq "deb") { $raptcmd = $instcmd . " -r --force-depends --force-conflicts @removepackages"; $iaptcmd = $instcmd . " -i --force-depends --force-conflicts @installpackages"; } print "\n [4] Preparing packages to install \n"; if (keys ( %rpackages ) != 0) { print " Removing packages...\n"; open(RAPTCMD, "$raptcmd |") or die "Can't execute apt '$raptcmd'!\n"; while (<RAPTCMD>) { $line = $_; # print $line; } close(RAPTCMD); } # We will ask apt to download packages. Possible reasons to not download: already locally cached, file method,... # This options may change in the future. Allow unsigned? Avoid recommends? print " Downloading packages (if needed)...\n"; @installpackages=(); while ( my ($key, $value) = each(%ipackages) ) { push(@installpackages, " $key=$value"); } my $daptcmd = "$aptdef -y --allow-unauthenticated --force-yes --no-install-recommends -d install @installpackages" ; # print "CMD-$daptcmd \n"; open(APTCMD, "$daptcmd 2>&1 |") or die "Apt can't execute download of @installpackages !\n"; while (<APTCMD>) { $line = $_; print " " . $line if ( $line =~ /^Get:/ ); # Print Get lines... #print "$line"; if ( $line =~/^E:/ ) { print "$line"; die "\n Problems with package download. \n\n Instalation aborted \n\n" ; } } close (APTCMD); print " Installing / updating packages... \n"; # print "CMD-$iaptcmd \n"; open(IAPTCMD, "$iaptcmd 2>&1 |") or die "Can't execute package install '$iaptcmd'!\n"; while (<IAPTCMD>) { $line = $_; # print $line; die "\n Problems with package installation. \n\n Instalation aborted \n\n" if ( $line =~/Errors\swere\sencountered\swhile\sprocessing/ ); } close(IAPTCMD); $timestop = time(); $timeinstall = $timeinstall + $timestop-$timestart; # print " Time install: $timeinstall \n"; # Benchmark: iterations , elapse , minisat , parse sol, parse rdeps , install pkgs print " Benchmark: " . $numiterations . "," . (time() - $timeelapse) . "," . $timepboenc . "," . $timeminisat . "," . $timeparsesol . "," . $timeparserdeps . "," . $timeinstall . "\n" if $benchmark; print " Instalation completed with success\n\n"; }sub check_revdeps_confs { #print "Debug (check_rconfs): @check_rconfs \n"; for my $elem (@check_rconfs) { my $elem_transaction=""; if ($elem =~ s/^upgrade-(.*)$/$1/g) { #print "Upgrade:$elem\n" ; $elem_transaction="upgrade"; } elsif ($elem =~ s/^downgrade-(.*)$/$1/g) { #print "Downgrade:$elem\n" ; $elem_transaction="downgrade"; } else { $elem_transaction=""; } if (! defined $cacherconflicts{$elem}) { $cacherconflicts{$elem}=""; my $p = $cache->{$elem}; unless ($p) { # warn "$self: Don't know anything about package `$name'\n"; next; } if (my $revdeps = $p->{RevDependsList}) { my $parent = ''; my $type = ''; for my $r (@$revdeps) { my $new_parent = "$r->{ParentPkg}{Name} $r->{ParentVer}{VerStr}"; unless ($new_parent eq $parent) { $parent = $new_parent; $type = ''; } # print $r->{TargetPkg}{Name}; # print " ($r->{CompTypeDeb} $r->{TargetVer})" if $r->{TargetVer}; if ($r->{DepType} ne 'Conflicts' && $r->{DepType} ne 'Replaces') { next; } if (($elem_transaction eq "upgrade") && ($r->{CompTypeDeb} eq "<<" || $r->{CompTypeDeb} eq "<=")) {# print "$elem tem rdep de $1 (op $depsOper=$2 e operacao $elem_transaction)\n"; next; } if (($elem_transaction eq "downgrade") && ($r->{CompTypeDeb} eq ">>" || $r->{CompTypeDeb} eq ">=")) {# print "$elem tem rdep de $1 (op $depsOper=$2 e operacao $elem_transaction)\n"; next; } if ($r->{DepType} ne $type) { # printf "\n %-30s", $type ? '' : $parent; # $type = $r->{DepType}; # print " $parent $r->{DepType} $r->{CompTypeDeb}: $r->{TargetPkg}{Name} \n"; $cacherconflicts{$elem}=$cacherconflicts{$elem} . " " . $parent ; } } } } print "Checking following rev_confs of pkg $elem:\n"; print Dumper(split / /, @cacherconflicts{$elem}); for $relem (split(/ /, $cacherconflicts{$elem})) { if ( (! exists $check_rconfs{ $relem }) && ( exists $installedpackages{ $relem } ) ) { print " --> Pushed reverse_conflicts: $relem (a partir de $elem)\n"; push (@pbopkgs, $relem.'-') ; $check_rconfs { $relem } = 'checked'; $worktodo=1; } } }}sub check_revdeps_deps { print "Debug (check_rdeps): @check_rdeps \n"; for my $elem (@check_rdeps) { my $elem_transaction=""; if ($elem =~ s/^upgrade-(.*)$/$1/g) { #print "Upgrade:$elem\n" ; $elem_transaction="upgrade"; } elsif ($elem =~ s/^downgrade-(.*)$/$1/g) { #print "Downgrade:$elem\n" ; $elem_transaction="downgrade"; } else { $elem_transaction=""; } if (! defined $cacherdepends{$elem}) { $cacherdepends{$elem}=""; my $p = $cache->{$elem}; unless ($p) { warn "$self: Don't know anything about package `$name'\n"; next; } if (my $revdeps = $p->{RevDependsList}) { my $parent = ''; my $type = ''; for my $r (@$revdeps) { my $new_parent = "$r->{ParentPkg}{Name} $r->{ParentVer}{VerStr}"; unless ($new_parent eq $parent) { $parent = $new_parent; $type = ''; } # print "Revdeps: $r->{TargetPkg}{Name} "; # print " ($r->{CompTypeDeb} $r->{TargetVer})" if $r->{TargetVer}; # print "\n"; if ($r->{DepType} ne 'Depends' && $r->{DepType} ne 'PreDepends') { next; } if (($elem_transaction eq "upgrade") && ($r->{CompTypeDeb} eq ">>" || $r->{CompTypeDeb} eq ">=")) { #print " $parent tem rdep $elem \n"; #print " Upgrade ($r->{CompTypeDeb}) - exiting \n"; next; } if (($elem_transaction eq "downgrade") && ($r->{CompTypeDeb} eq "<=" || $r->{CompTypeDeb} eq "<<")) { #print " $parent tem rdep $elem \n"; #print " Downgrade ($r->{CompTypeDeb}) - exiting \n"; next; } if ($r->{DepType} ne $type) { # printf "\n %-30s", $type ? '' : $parent; # $type = $r->{DepType}; # print " rcacherdepends += $parent ($r->{DepType}) \n"; $cacherdepends{$elem}=$cacherdepends{$elem} . " " . $parent; } } } } print "Checking following rev_deps of pkg $elem:\n"; print Dumper(split / /, @cacherdepends{$elem}); for $relem (split(/ /, $cacherdepends{$elem})) { if ( (! exists $check_rdeps{ $relem }) && ( exists $installedpackages{ $relem } ) ) { print "--->Pushed reverse_depends $relem (a partir de $elem) \n"; push(@pbopkgs,$relem); $check_rdeps { $relem } = 'checked'; $worktodo=1; } } }}sub check_revdeps { $timestart = time(); $worktodo=0; &check_revdeps_deps(); &check_revdeps_confs(); $timestop = time(); $timeparserdeps = $timeparserdeps + $timestop-$timestart; # print " Time parserdeps: $timeparserdeps \n";}# What one can call "main"# initialise the global config object with the default values and# setup the $_system object$_config->init;# if needed, read cudf and generate cacheif (defined $cudfin) { print "Reading CUDF and generating status / repo...\n"; my $cudfout = `$cudftodebbin --arch=i586 $cudfin`; move('./Packages', './repo/'); move('./status', './dpkg/status'); open(REQ, '<', './Request') or die('Cant open Request file!'); my $req = <REQ>; chomp($req); @pbopkgs = split(" ", $req); print "Generating cache...\n"; open(UPDATECMD, "$aptdef $aptconf update 2>&1 |") or die "Can't execute apt '$raptcmd'!\n"; #while (<UPDATECMD>) { # $line = $_; # print("Update->>", $line); #} close(UPDATECMD); my @configarg; push(@configarg, $aptconf); $_config->parse_cmdline([ [ 'c', 'config-file', '', 'ConfigFile' ] ], @configarg );} else { @pbopkgs = @ARGV; shift @pbopkgs; # discard "install" argument}$_system = $_config->system;# Debug#$_config->dump;# supress cache building messages$_config->{quiet} = 2;# set up the cache$cache = AptPkg::Cache->new;$policy = $cache->policy;my $somethingtodo=0;for my $packagename (@pbopkgs) { $to_remove = 0; #Cleanup apt-get request operators (version and trailing hyphen) $strict_name = $packagename; $strict_name =~ s/(.+)=\d$/$1/g; if (substr($strict_name, -1) eq "-") { $to_remove = 1; } $strict_name =~ s/(.+)-$/$1/g; my $p = $cache->{$strict_name}; unless ($p) { warn "$self: Don't know anything about package `$packagename'\n";# die "\n Package is not available. Verify you repositories.\n\n"; next; } #if (!$to_remove && $p->{CurrentState} =~ /^Installed$/) { # warn "$self: Package '$packagename' is already installed. \n"; # next; #} #if ($to_remove && !$p->{CurrentState} =~ /^Installed$/) { # warn "$self: Package '$packagename' is not installed. \n"; # next; #} $somethingtodo=1;}# separator of arguments to pass to "apt-get pboinstall"push (@pbopkgs,"aux:");#TODO: Ticket#662 - Here we should append the Recommends packages%installedpackages = &list_installed_versions();$timeelapse=time();print "Initial package Status: \n";print Data::Dumper->Dump([\%installedpackages], ["installedpackages"]);do { $numiterations++; #Introduce the bug-fixing mode if nothing to install/remove/upgrade &runapt($pbopolicy, @pbopkgs); &call_minisat($pbo); $worktodo=0; &check_revdeps();} until ($worktodo eq 0); &print_solution;if (defined $cudfout) { #&write_solution_cudf($cudfout,\%ipackages,\%upackages,\%dpackages,\%rpackages,$print_upkgs,$print_dpkgs); &write_solution_cudf2($cudfout,\%ipackages,\%upackages,\%dpackages,\%rpackages,$print_upkgs,$print_dpkgs); print " Benchmark: " . $numiterations . "," . (time() - $timeelapse) . "," . $timepboenc . "," . $timeminisat . "," . $timeparsesol . "," . $timeparserdeps . "," . $timeinstall . "\n" if $benchmark; exit(0);}print "Do you want to install the solution (y/n)? ";#$x=<STDIN>;$x="n";#$x="y";if ( $x =~ /y/ ) { &install_packages; exit; } else{ if ($x =~ /n/){# &handle_options; # Benchmark: iterations , elapse , minisat , parse sol, parse rdeps , install pkgs print " Benchmark: " . $numiterations . "," . (time() - $timeelapse) . "," . $timepboenc . "," . $timeminisat . "," . $timeparsesol . "," . $timeparserdeps . "," . $timeinstall . "\n" if $benchmark; exit; }}