# $OpenBSD: PlistScanner.pm,v 1.19 2023/05/30 07:30:02 espie Exp $ # Copyright (c) 2014 Marc Espie # # Permission to use, copy, modify, and distribute this software for any # purpose with or without fee is hereby granted, provided that the above # copyright notice and this permission notice appear in all copies. # # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. use v5.36; package OpenBSD::PlistScanner; use OpenBSD::PackageInfo; use OpenBSD::AddCreateDelete; use OpenBSD::PackingList; sub handle_plist($self, $filename, $plist) { if (!defined $plist) { $self->ui->errsay("Error reading #1", $filename); return; } if (!defined $plist->pkgname) { if (-z $filename) { $self->ui->errsay("Empty plist file #1", $filename); } else { $self->ui->errsay("Invalid package #1", $filename); } return; } $self->{name2path}{$plist->pkgname} = $plist->fullpkgpath; $self->{currentname} = $plist->pkgname." - ".$plist->fullpkgpath; $self->say("#1 -> #2", $filename, $plist->pkgname) if $self->ui->verbose; $self->register_plist($plist); } sub progress($self) { return $self->ui->progress; } sub handle_file($self, $filename) { return if -d $filename; my $plist = OpenBSD::PackingList->fromfile($filename); $self->handle_plist($filename, $plist); } sub handle_portspath($self, $path) { foreach (split(/:/, $path)) { $self->handle_portsdir($_); } } sub find_current_pkgnames($self, $dir) { my $done = {}; my @todo = (); while (my ($name, $path) = each %{$self->{name2path}}) { next if $self->{current}{$name}; next if $done->{$path}; push(@todo, $path); } my $total = scalar(@todo); my $i = 0; while (my @l = (splice @todo, 0, 1000)) { my $pid = open(my $output, "-|"); if ($pid == 0) { $DB::inhibit_exit = 0; chdir($dir) or die "bad directory $dir"; $ENV{SUBDIR} = join(' ', @l); open STDERR, ">", "/dev/null"; exec { $self->{make} } ("make", 'show=FULLPKGNAME${SUBPACKAGE}', 'REPORT_PROBLEM=true', 'ECHO_MSG=:'); exit(1); } while (<$output>) { $i++; $self->progress->show($i, $total); chomp; $self->{current}{$_} = 1; } close($output); } } sub find_all_current_pkgnames($self, $dir) { $self->progress->set_header("Figuring out current names"); open(my $input, "cd $dir && $self->{make} show='PKGPATHS PKGNAMES' ECHO_MSG=:|"); while (<$input>) { chomp; my @values = split(/\s+/, $_); my $line2 = <$input>; chomp $line2; my @keys = split(/\s+/, $line2); $self->progress->message($values[0]); while (my $key = shift @keys) { my $value = shift @values; $self->{name2path}{$key} = $value; $self->{current}{$key} = 1; # $self->ui->say("pkgname: #1", $key); } } $self->progress->next; } sub reader($self, $rdone) { return sub($fh, $cont) { local $_; while (<$fh>) { return if m/^\=\=\=\> /o; &$cont($_); } $$rdone = 1; }; } sub scan_ports($self, $dir, $paths) { my $child_pid = open(my $input, "-|"); if (!$child_pid) { chdir($dir); open(STDERR, "/dev/null"); $ENV{REPORT_PROBLEM} = 'true'; if (defined $paths) { $ENV{SUBDIR} = join(' ', sort keys %$paths); } exec("$self->{make} print-plist-all-with-depends"); } my $done = 0; while (!$done) { my $plist = OpenBSD::PackingList->read($input, $self->reader(\$done)); if (defined $plist && $plist->pkgname) { $self->progress->message($plist->fullpkgpath || $plist->pkgname); $self->handle_plist($dir, $plist); } } waitpid $child_pid, 0; } sub handle_portsdir($self, $dir) { # prime initial run $self->scan_ports($dir, undef); # and now the rescans; my $tried = {}; while (1) { my $totry = undef; for my $pkgname (keys %{$self->{wanted}}) { next if $self->{got}{$pkgname}; my $path = $self->{pkgpath}{$pkgname}; next if $tried->{$path}; $totry->{$path} = 1; $tried->{$path} = 1; } return if !defined $totry; $self->scan_ports($dir, $totry); } } sub rescan_dependencies($self, $dir) { $self->progress->set_header("Scanning extra dependencies"); my $notfound = {}; my $todo; do { $todo = {}; while (my ($pkg, $reason) = each %{$self->{wanted}}) { next if $self->{got}{$pkg}; next if $notfound->{$pkg}; $todo->{$pkg} = $reason; } while (my ($pkgname, $reason) = each %$todo) { $self->ui->say("rescanning: #1 (#2)", $pkgname, $reason); my $file = "$dir/$pkgname"; if (-f $file) { $self->handle_file($file); } else { $notfound->{$pkgname} = $reason; } } } while (keys %$todo > 0); $self->progress->next; } sub scan($self) { $self->progress->set_header("Scanning"); if ($self->ui->opt('d')) { opendir(my $dir, $self->ui->opt('d')); my @l = readdir $dir; closedir($dir); $self->progress->for_list("Scanning", \@l, sub($pkgname) { return if $pkgname eq '.' or $pkgname eq '..'; if ($self->ui->opt('f') && !defined $self->{current}{$pkgname}) { return; } # $self->ui->say("doing: #1", $pkgname); $self->handle_file($self->ui->opt('d')."/$pkgname"); }); if ($self->ui->opt('f')) { } } elsif ($self->ui->opt('p')) { $self->handle_portspath($self->ui->opt('p')); } elsif (@ARGV==0) { @ARGV=(<*.tgz>); } if (@ARGV > 0) { $self->progress->for_list("Scanning", \@ARGV, sub($pkgname) { my $true_package = $self->ui->repo->find($pkgname); return unless $true_package; my $dir = $true_package->info; $true_package->close; $self->handle_file($dir.CONTENTS); rmtree($dir); }); } if ($self->ui->opt('d')) { $self->rescan_dependencies($self->ui->opt('d')); } } sub run($self) { if ($self->ui->opt('p') && $self->ui->opt('f')) { $self->find_all_current_pkgnames($self->ui->opt('p')); } $self->scan; if ($self->ui->opt('d') && $self->ui->opt('p')) { $self->progress->set_header("Computing current pkgnames"); $self->find_current_pkgnames($self->ui->opt('p')); } $self->display_results; } sub say($self, @msg) { my $msg = $self->ui->f(@msg)."\n"; $self->ui->_print($msg) unless $self->ui->opt('s'); if (defined $self->{output}) { print {$self->{output}} $msg; } } sub fullname($self, $pkgname) { my $path = $self->{name2path}{$pkgname}; if ($self->{current}{$pkgname}) { return "!$pkgname($path)"; } else { return "$pkgname($path)"; } } sub ui($self) { return $self->{ui}; } sub handle_options($self, $extra = '', $usage = "[-vefS] [-d plist_dir] [-o output] [-p ports_dir] [pkgname ...]") { $self->ui->handle_options($extra.'d:efo:p:sS', $usage); } sub new($class, $cmd) { my $ui = OpenBSD::AddCreateDelete::State->new($cmd); my $o = bless {ui => $ui, make => $ENV{MAKE} || 'make', name2path => {}, current => {} }, $class; $o->handle_options; if ($ui->opt('o')) { open $o->{output}, '>', $ui->opt('o') or $ui->fatal("Can't write to #1: #2", $ui->opt('o'), $!); } return $o; } 1;