#! /usr/bin/perl # ex:ts=8 sw=4: # $OpenBSD: PkgCreate.pm,v 1.184 2022/11/01 17:41:19 espie Exp $ # # Copyright (c) 2003-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 strict; use warnings; use OpenBSD::AddCreateDelete; use OpenBSD::Dependencies::SolverBase; use OpenBSD::SharedLibs; use OpenBSD::Signer; package OpenBSD::PkgCreate::State; our @ISA = qw(OpenBSD::CreateSign::State); sub init { my $self = shift; $self->{stash} = {}; $self->SUPER::init(@_); $self->{simple_status} = 0; } sub stash { my ($self, $key) = @_; return $self->{stash}{$key}; } sub error { my $self = shift; my $msg = shift; $self->{bad}++; $self->progress->disable; # XXX the actual format is $msg. $self->errsay("Error: $msg", @_); } sub set_status { my ($self, $status) = @_; if ($self->{simple_status}) { print "\n$status"; } else { if ($self->progress->set_header($status)) { $self->progress->message(''); } else { $| = 1; print "$status..."; $self->{simple_status} = 1; } } } sub end_status { my $self = shift; if ($self->{simple_status}) { print "\n"; } else { $self->progress->clear; } } sub handle_options { my $state = shift; $state->{system_version} = 0; $state->{opt} = { 'f' => sub { push(@{$state->{contents}}, shift); }, 'p' => sub { $state->{prefix} = shift; }, 'P' => sub { my $d = shift; $state->{dependencies}{$d} = 1; }, 'V' => sub { my $d = shift; if ($d !~ m/^\d+$/) { $state->usage("-V option requires a number"); } $state->{system_version} += $d; }, 'w' => sub { my $w = shift; $state->{libset}{$w} = 1; }, 'W' => sub { my $w = shift; $state->{wantlib}{$w} = 1; }, }; $state->{no_exports} = 1; $state->SUPER::handle_options('p:f:d:M:U:u:A:B:P:V:w:W:qQS', '[-nQqvSx] [-A arches] [-B pkg-destdir] [-D name[=value]]', '[-L localbase] [-M displayfile] [-P pkg-dependency]', '[-U undisplayfile] [-u userlist] [-V n] [-W wantedlib]', '[-w libset] [-d desc -D COMMENT=value -f packinglist -p prefix]', 'pkg-name'); my $base = '/'; if (defined $state->opt('B')) { $base = $state->opt('B'); } $state->{base} = $base; # switch to silent mode for *any* introspection option $state->{silent} = defined $state->opt('n') || defined $state->opt('q') || defined $state->opt('Q') || defined $state->opt('S'); if (defined $state->opt('u')) { $state->{userlist} = $state->parse_userdb($state->opt('u')); } $state->{wrkobjdir} = $state->defines('WRKOBJDIR'); $state->{fullpkgpath} = $state->{subst}->value('FULLPKGPATH') // ''; $state->{no_ts_in_plist} = $state->defines('NO_TS_IN_PLIST'); } sub parse_userdb { my ($self, $fname) = @_; my $result = {}; my $bad = 0; open(my $fh, '<', $fname) or $bad = 1; if ($bad) { $self->error("Can't open #1: #2", $fname, $!); return; } # skip header my $separator_found = 0; while (<$fh>) { if (m/^\-\-\-\-\-\-\-/) { $separator_found = 1; last; } } if (!$separator_found) { $self->error("File #1 does not appear to be a user.db", $fname); return; } # record ids and error out on duplicates my $known = {}; while (<$fh>) { next if m/^\#/; chomp; my @l = split(/\s+/, $_); if (@l < 3 || $l[0] !~ m/^\d+$/ || $l[1] !~ m/^_/) { $self->error("Bad line: #1 at #2 of #3", $_, $., $fname); next; } if (defined $known->{$l[0]}) { $self->error("Duplicate id: #1 in #2", $l[0], $fname); next; } $known->{$l[0]} = 1; $result->{$l[1]} = $l[0]; } return $result; } package OpenBSD::PkgCreate; use OpenBSD::PackingList; use OpenBSD::PackageInfo; use OpenBSD::Getopt; use OpenBSD::Temp; use OpenBSD::Error; use OpenBSD::Ustar; use OpenBSD::ArcCheck; use OpenBSD::Paths; use File::Basename; # Extra stuff needed to archive files package OpenBSD::PackingElement; sub create_package { my ($self, $state) = @_; $self->archive($state); if ($state->verbose) { $self->comment_create_package($state); } } sub pretend_to_archive { my ($self, $state) = @_; $self->comment_create_package($state); } sub record_digest {} sub stub_digest {} sub archive {} sub comment_create_package {} sub grab_manpages {} sub register_for_archival {} sub print_file {} sub avert_duplicates_and_other_checks { my ($self, $state) = @_; return unless $self->NoDuplicateNames; my $n = $self->fullname; if (defined $state->stash($n)) { $state->error("duplicate item in packing-list #1", $n); } $state->{stash}{$n} = 1; } sub makesum_plist { my ($self, $state, $plist) = @_; $self->add_object($plist); } sub verify_checksum { } sub register_forbidden { my ($self, $state) = @_; if ($self->is_forbidden) { push(@{$state->{forbidden}}, $self); } } sub is_forbidden() { 0 } sub resolve_link { my ($filename, $base, $level) = @_; $level //= 0; if (-l $filename) { my $l = readlink($filename); if ($level++ > 14) { return undef; } if ($l =~ m|^/|) { return $base.resolve_link($l, $base, $level); } else { return resolve_link(File::Spec->catfile(File::Basename::dirname($filename),$l), $base, $level); } } else { return $filename; } } sub compute_checksum { my ($self, $result, $state, $base) = @_; my $name = $self->fullname; my $fname = $name; my $okay = 1; if (defined $base) { $fname = $base.$fname; } for my $field (qw(symlink link size ts)) { # md5 if (defined $result->{$field}) { $state->error("User tried to define @#1 for #2", $field, $fname); $okay = 0; } } if (defined $self->{wtempname}) { $fname = $self->{wtempname}; } if (-l $fname) { if (!defined $base) { $state->error("special file #1 can't be a symlink", $self->stringize); $okay = 0; } my $value = readlink $fname; my $chk = resolve_link($fname, $base); $fname =~ s|^//|/|; # cosmetic if (!defined $chk) { $state->error("bogus symlink: #1 (too deep)", $fname); $okay = 0; } elsif (!-e $chk) { push(@{$state->{bad_symlinks}{$chk}}, $fname); } if (defined $state->{wrkobjdir} && $value =~ m/^\Q$state->{wrkobjdir}\E\//) { $state->error( "bad symlink: #1 (points into WRKOBJDIR)", $fname); $okay = 0; } $result->make_symlink($value); } elsif (-f _) { my ($dev, $ino, $size, $mtime) = (stat _)[0,1,7, 9]; # XXX when rebuilding packages, tied updates can produce # spurious hardlinks. We also refer to the installed plist # we're rebuilding to know if we must checksum. if (defined $state->stash("$dev/$ino") && !defined $self->{d}) { $result->make_hardlink($state->stash("$dev/$ino")); } else { $state->{stash}{"$dev/$ino"} = $name; $result->add_digest($self->compute_digest($fname)) unless $state->{bad}; $result->add_size($size); unless ($state->{no_ts_in_plist}) { $result->add_timestamp($mtime); } } } elsif (-d _) { $state->error("#1 should be a file and not a directory", $fname); $okay = 0; } else { $state->error("#1 does not exist", $fname); $okay = 0; } return $okay; } sub makesum_plist_with_base { my ($self, $plist, $state, $base) = @_; if ($self->compute_checksum($self, $state, $base)) { $self->add_object($plist); } } sub verify_checksum_with_base { my ($self, $state, $base) = @_; my $check = ref($self)->new($self->name); if (!$self->compute_checksum($check, $state, $base)) { return; } for my $field (qw(symlink link size)) { # md5 if ((defined $check->{$field} && defined $self->{$field} && $check->{$field} ne $self->{$field}) || (defined $check->{$field} xor defined $self->{$field})) { $state->error("#1 inconsistency for #2", $field, $self->fullname); } } if ((defined $check->{d} && defined $self->{d} && !$check->{d}->equals($self->{d})) || (defined $check->{d} xor defined $self->{d})) { $state->error("checksum inconsistency for #1", $self->fullname); } } sub prepare_for_archival { my ($self, $state) = @_; my $o = $state->{archive}->prepare_long($self); if (!$o->verify_modes($self)) { $state->error("modes don't match for #1", $self->fullname); } if (!$o->is_allowed) { $state->error("can't package #1", $self->fullname); } return $o; } sub discover_directories { } sub check_version { } package OpenBSD::PackingElement::StreamMarker; our @ISA = qw(OpenBSD::PackingElement::Meta); sub new { my $class = shift; bless {}, $class; } sub comment_create_package { my ($self, $state) = @_; $self->SUPER::comment_create_package($state); $state->say("Gzip: next chunk"); } sub archive { my ($self, $state) = @_; $state->new_gstream; } package OpenBSD::PackingElement::LRUFrontier; our @ISA = qw(OpenBSD::PackingElement::Meta); sub new { my $class = shift; bless {}, $class; } sub comment_create_package { my ($self, $state) = @_; $self->SUPER::comment_create_package($state); $state->say("LRU: end of modified files"); } package OpenBSD::PackingElement::RcScript; sub set_destdir { my ($self, $state) = @_; if ($self->name =~ m/^\//) { $state->{archive}->destdir($state->{base}); } else { $self->SUPER::set_destdir($state); } } package OpenBSD::PackingElement::SpecialFile; sub record_digest { my ($self, $original, $entries, $new, $tail) = @_; push(@$new, $self); } sub stub_digest { my ($self, $ordered) = @_; push(@$ordered, $self); } sub archive { &OpenBSD::PackingElement::FileBase::archive; } sub pretend_to_archive { &OpenBSD::PackingElement::FileBase::pretend_to_archive; } sub set_destdir { } sub may_add { my ($class, $subst, $plist, $opt) = @_; if (defined $opt) { my $o = $class->add($plist); $subst->copy($opt, $o->fullname) if defined $o->fullname; } } sub comment_create_package { my ($self, $state) = @_; $state->say("Adding #1", $self->name); } sub makesum_plist { my ($self, $state, $plist) = @_; $self->makesum_plist_with_base($plist, $state, undef); } sub verify_checksum { my ($self, $state) = @_; $self->verify_checksum_with_base($state, undef); } sub prepare_for_archival { my ($self, $state) = @_; my $o = $state->{archive}->prepare_long($self); $o->{uname} = 'root'; $o->{gname} = 'wheel'; $o->{uid} = 0; $o->{gid} = 0; $o->{mode} &= 0555; # zap all write and suid modes return $o; } sub forbidden() { 1 } sub register_for_archival { my ($self, $ordered) = @_; push(@$ordered, $self); } # override for CONTENTS: we cannot checksum this. package OpenBSD::PackingElement::FCONTENTS; sub makesum_plist { } sub verify_checksum { } sub archive { my ($self, $state) = @_; $self->SUPER::archive($state); } sub comment_create_package { my ($self, $state) = @_; $self->SUPER::comment_create_package($state); } sub stub_digest { my ($self, $ordered) = @_; push(@$ordered, $self); } package OpenBSD::PackingElement::Cwd; sub archive { my ($self, $state) = @_; } sub pretend_to_archive { my ($self, $state) = @_; $self->comment_create_package($state); } sub comment_create_package { my ($self, $state) = @_; $state->say("Cwd: #1", $self->name); } package OpenBSD::PackingElement::FileBase; sub record_digest { my ($self, $original, $entries, $new, $tail) = @_; if (defined $self->{d}) { my $k = $self->{d}->stringize; push(@{$entries->{$k}}, $self); push(@$original, $k); } else { push(@$tail, $self); } } sub register_for_archival { my ($self, $ordered) = @_; push(@$ordered, $self); } sub set_destdir { my ($self, $state) = @_; $state->{archive}->destdir($state->{base}."/".$self->cwd); } sub archive { my ($self, $state) = @_; $self->set_destdir($state); my $o = $self->prepare_for_archival($state); $o->write unless $state->{bad}; } sub pretend_to_archive { my ($self, $state) = @_; $self->set_destdir($state); $self->prepare_for_archival($state); $self->comment_create_package($state); } sub comment_create_package { my ($self, $state) = @_; $state->say("Adding #1", $self->name); } sub print_file { my ($item) = @_; print '@', $item->keyword, " ", $item->fullname, "\n"; } sub makesum_plist { my ($self, $state, $plist) = @_; $self->makesum_plist_with_base($plist, $state, $state->{base}); } sub verify_checksum { my ($self, $state) = @_; $self->verify_checksum_with_base($state, $state->{base}); } package OpenBSD::PackingElement::Dir; sub discover_directories { my ($self, $state) = @_; $state->{known_dirs}->{$self->fullname} = 1; } package OpenBSD::PackingElement::InfoFile; sub makesum_plist { my ($self, $state, $plist) = @_; $self->SUPER::makesum_plist($state, $plist); my $fname = $self->fullname; for (my $i = 1; ; $i++) { if (-e "$state->{base}/$fname-$i") { my $e = OpenBSD::PackingElement::File->add($plist, $self->name."-".$i); $e->compute_checksum($e, $state, $state->{base}); } else { last; } } } package OpenBSD::PackingElement::Manpage; use File::Basename; sub grab_manpages { my ($self, $state) = @_; my $filename; if ($self->{wtempname}) { $filename = $self->{wtempname}; } else { $filename = $state->{base}.$self->fullname; } push(@{$state->{manpages}}, $filename); } sub format_source_page { my ($self, $state, $plist) = @_; if ($state->{subst}->empty("USE_GROFF") || !$self->is_source) { return 0; } my $dest = $self->source_to_dest; my $fullname = $self->cwd."/".$dest; my $d = dirname($fullname); $state->{mandir} //= OpenBSD::Temp::permanent_dir( $ENV{TMPDIR} // '/tmp', "manpage") or $state->error(OpenBSD::Temp->last_error) and return 0; my $tempname = $state->{mandir}.$fullname; require File::Path; File::Path::make_path($state->{mandir}.$d); open my $fh, ">", $tempname; if (!defined $fh) { $state->error("can't create #1: #2", $tempname, $!); return 0; } chmod 0444, $fh; if (-d $state->{base}.$d) { undef $d; } if (!$self->format($state, $tempname, $fh)) { return 0; } if (-z $tempname) { $state->errsay("groff produced empty result for #1", $dest); $state->errsay("\tkeeping source manpage"); return 0; } if (defined $d && !$state->{known_dirs}->{$d}) { $state->{known_dirs}->{$d} = 1; OpenBSD::PackingElement::Dir->add($plist, dirname($dest)); } my $e = OpenBSD::PackingElement::Manpage->add($plist, $dest); $e->{wtempname} = $tempname; $e->compute_checksum($e, $state, $state->{base}); return 1; } sub makesum_plist { my ($self, $state, $plist) = @_; if (!$self->format_source_page($state, $plist)) { $self->SUPER::makesum_plist($state, $plist); } } package OpenBSD::PackingElement::Depend; sub avert_duplicates_and_other_checks { my ($self, $state) = @_; if (!$self->spec->is_valid) { $state->error("invalid \@#1 #2 in packing-list", $self->keyword, $self->stringize); } $self->SUPER::avert_duplicates_and_other_checks($state); } sub forbidden() { 1 } package OpenBSD::PackingElement::Conflict; sub avert_duplicates_and_other_checks { $_[1]->{has_conflict}++; &OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks; } package OpenBSD::PackingElement::AskUpdate; sub avert_duplicates_and_other_checks { &OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks; } package OpenBSD::PackingElement::Dependency; sub avert_duplicates_and_other_checks { my ($self, $state) = @_; $self->SUPER::avert_duplicates_and_other_checks($state); my @issues = OpenBSD::PackageName->from_string($self->{def})->has_issues; if (@issues > 0) { $state->error("\@#1 #2\n #3, #4", $self->keyword, $self->stringize, $self->{def}, join(' ', @issues)); } elsif ($self->spec->is_valid) { my @m = $self->spec->filter($self->{def}); if (@m == 0) { $state->error("\@#1 #2\n pattern #3 doesn't match default #4\n", $self->keyword, $self->stringize, $self->{pattern}, $self->{def}); } } } package OpenBSD::PackingElement::Name; sub avert_duplicates_and_other_checks { my ($self, $state) = @_; my @issues = OpenBSD::PackageName->from_string($self->name)->has_issues; if (@issues > 0) { $state->error("bad package name #1: ", $self->name, join(' ', @issues)); } $self->SUPER::avert_duplicates_and_other_checks($state); } sub forbidden() { 1 } package OpenBSD::PackingElement::NoDefaultConflict; sub avert_duplicates_and_other_checks { my ($self, $state) = @_; $state->{has_no_default_conflict}++; } package OpenBSD::PackingElement::NewAuth; sub avert_duplicates_and_other_checks { my ($self, $state) = @_; my $userlist = $state->{userlist}; if (defined $userlist) { my $entry = $userlist->{$self->{name}}; my $id = $self->id; $id =~ s/^!//; if (!defined $entry) { $state->error("#1 #2: not registered in #3", $self->keyword, $self->{name}, $state->opt('u')); } elsif ($entry != $id) { $state->error( "#1 #2: id mismatch in #3 (#4 vs #5)", $self->keyword, $self->{name}, $state->opt('u'), $entry, $id); } } $self->SUPER::avert_duplicates_and_other_checks($state); } package OpenBSD::PackingElement::NewUser; sub id { return shift->{uid}; } package OpenBSD::PackingElement::NewGroup; sub id { return shift->{gid}; } package OpenBSD::PackingElement::Lib; sub check_version { my ($self, $state, $unsubst) = @_; my @l = $self->parse($self->name); if (defined $l[0]) { if (!$unsubst =~ m/\$\{LIB$l[0]_VERSION\}/) { $state->error("Incorrectly versioned shared library: #1", $unsubst); } } else { $state->error("Invalid shared library #1", $unsubst); } $state->{has_libraries} = 1; } package OpenBSD::PackingElement::DigitalSignature; sub is_forbidden() { 1 } package OpenBSD::PackingElement::Signer; sub is_forbidden() { 1 } package OpenBSD::PackingElement::ExtraInfo; sub is_forbidden() { 1 } package OpenBSD::PackingElement::ManualInstallation; sub is_forbidden() { 1 } package OpenBSD::PackingElement::Firmware; sub is_forbidden() { 1 } package OpenBSD::PackingElement::Url; sub is_forbidden() { 1 } package OpenBSD::PackingElement::Arch; sub is_forbidden() { 1 } package OpenBSD::PackingElement::LocalBase; sub is_forbidden() { 1 } package OpenBSD::PackingElement::Version; sub is_forbidden() { 1 } # put together file and filename, in order to handle fragments simply package MyFile; sub new { my ($class, $filename) = @_; open(my $fh, '<', $filename) or return undef; bless { fh => $fh, name => $filename }, (ref($class) || $class); } sub readline { my $self = shift; return readline $self->{fh}; } sub name { my $self = shift; return $self->{name}; } sub close { my $self = shift; close($self->{fh}); } sub deduce_name { my ($self, $frag, $not, $p, $state) = @_; my $o = $self->name; my $noto = $o; my $nofrag = "no-$frag"; $o =~ s/PFRAG\./PFRAG.$frag-/o or $o =~ s/PLIST/PFRAG.$frag/o; $noto =~ s/PFRAG\./PFRAG.no-$frag-/o or $noto =~ s/PLIST/PFRAG.no-$frag/o; unless (-e $o or -e $noto) { $p->missing_fragments($state, $frag, $o, $noto); return; } if ($not) { return $noto if -e $noto; } else { return $o if -e $o; } return; } # special solver class for PkgCreate package OpenBSD::Dependencies::CreateSolver; our @ISA = qw(OpenBSD::Dependencies::SolverBase); # we need to "hack" a special set sub new { my ($class, $plist) = @_; bless { set => OpenBSD::PseudoSet->new($plist), old_dependencies => {}, bad => [] }, $class; } sub solve_all_depends { my ($solver, $state) = @_; $solver->{tag_finder} = OpenBSD::lookup::tag->new($solver, $state); while (1) { my @todo = $solver->solve_depends($state); if (@todo == 0) { return; } if ($solver->solve_wantlibs($state, 0)) { return; } $solver->{set}->add_new(@todo); } } sub solve_wantlibs { my ($solver, $state, $final) = @_; my $okay = 1; my $lib_finder = OpenBSD::lookup::library->new($solver); my $h = $solver->{set}{new}[0]; for my $lib (@{$h->{plist}{wantlib}}) { $solver->{localbase} = $h->{plist}->localbase; next if $lib_finder->lookup($solver, $solver->{to_register}{$h}, $state, $lib->spec); $okay = 0; OpenBSD::SharedLibs::report_problem($state, $lib->spec) if $final; } if (!$okay && $final) { $solver->dump($state); $lib_finder->dump($state); } return $okay; } sub really_solve_dependency { my ($self, $state, $dep, $package) = @_; $state->progress->message($dep->{pkgpath}); my $v; # look in installed packages, but only for different paths my $p1 = $dep->{pkgpath}; my $p2 = $state->{fullpkgpath}; $p1 =~ s/\,.*//; $p2 =~ s/\,.*//; $p2 =~ s,^debug/,,; if ($p1 ne $p2) { # look in installed packages $v = $self->find_dep_in_installed($state, $dep); } if (!defined $v) { $v = $self->find_dep_in_self($state, $dep); } # and in portstree otherwise if (!defined $v) { $v = $self->solve_from_ports($state, $dep, $package); } return $v; } sub diskcachename { my ($self, $dep) = @_; if ($ENV{_DEPENDS_CACHE}) { my $diskcache = $dep->{pkgpath}; $diskcache =~ s/\//--/g; return $ENV{_DEPENDS_CACHE}."/pkgcreate-".$diskcache; } else { return undef; } } sub to_cache { my ($self, $plist, $final) = @_; # try to cache atomically. # no error if it doesn't work require OpenBSD::MkTemp; my ($fh, $tmp) = OpenBSD::MkTemp::mkstemp( "$ENV{_DEPENDS_CACHE}/my.XXXXXXXXXXX") or return; chmod 0644, $fh; $plist->write($fh); close($fh); rename($tmp, $final); unlink($tmp); } sub ask_tree { my ($self, $state, $pkgpath, $portsdir, $data, @action) = @_; my $make = OpenBSD::Paths->make; my $errors = OpenBSD::Temp->file; if (!defined $errors) { $state->fatal(OpenBSD::Temp->last_error); } my $pid = open(my $fh, "-|"); if (!defined $pid) { $state->fatal("cannot fork: #1", $!); } if ($pid == 0) { $ENV{FULLPATH} = 'Yes'; delete $ENV{FLAVOR}; delete $ENV{SUBPACKAGE}; $ENV{SUBDIR} = $pkgpath; $ENV{ECHO_MSG} = ':'; if (!chdir $portsdir) { $state->errsay("Can't chdir #1: #2", $portsdir, $!); exit(2); } open STDERR, ">>", $errors; # make sure the child starts with a single identity $( = $); $< = $>; # XXX we're already running as ${BUILD_USER} # so we can't do this again push(@action, 'PORTS_PRIVSEP=No'); $DB::inhibit_exit = 0; exec $make ('make', @action); } my $plist = OpenBSD::PackingList->read($fh, $data); while(<$fh>) { # XXX avoid spurious errors from child } close($fh); if ($? != 0) { $state->errsay("child running '#2' failed: #1", $state->child_error, join(' ', 'make', @action)); if (open my $fh, '<', $errors) { while(<$fh>) { $state->errprint("#1", $_); } close($fh); } } unlink($errors); return $plist; } sub really_solve_from_ports { my ($self, $state, $dep, $portsdir) = @_; my $diskcache = $self->diskcachename($dep); my $plist; if (defined $diskcache && -f $diskcache) { $plist = OpenBSD::PackingList->fromfile($diskcache); } else { $plist = $self->ask_tree($state, $dep->{pkgpath}, $portsdir, \&OpenBSD::PackingList::PrelinkStuffOnly, 'print-plist-libs-with-depends', 'wantlib_args=no-wantlib-args'); if ($? != 0 || !defined $plist->pkgname) { return undef; } if (defined $diskcache) { $self->to_cache($plist, $diskcache); } } OpenBSD::SharedLibs::add_libs_from_plist($plist, $state); $self->{tag_finder}->find_in_plist($plist, $dep->{pkgpath}); $self->add_dep($plist); return $plist->pkgname; } my $cache = {}; sub solve_from_ports { my ($self, $state, $dep, $package) = @_; my $portsdir = $state->defines('PORTSDIR'); return undef unless defined $portsdir; my $pkgname; if (defined $cache->{$dep->{pkgpath}}) { $pkgname = $cache->{$dep->{pkgpath}}; } else { $pkgname = $self->really_solve_from_ports($state, $dep, $portsdir); $cache->{$dep->{pkgpath}} = $pkgname; } if (!defined $pkgname) { $state->error("Can't obtain dependency #1 from ports tree", $dep->{pattern}); return undef; } if ($dep->spec->filter($pkgname) == 0) { $state->error("Dependency #1 doesn't match FULLPKGNAME: #2", $dep->{pattern}, $pkgname); return undef; } return $pkgname; } # we don't want old libs sub find_old_lib { return undef; } package OpenBSD::PseudoHandle; sub new { my ($class, $plist) = @_; bless { plist => $plist}, $class; } sub pkgname { my $self = shift; return $self->{plist}->pkgname; } sub dependency_info { my $self = shift; return $self->{plist}; } package OpenBSD::PseudoSet; sub new { my ($class, @elements) = @_; my $o = bless {}, $class; $o->add_new(@elements); } sub add_new { my ($self, @elements) = @_; for my $i (@elements) { push(@{$self->{new}}, OpenBSD::PseudoHandle->new($i)); } return $self; } sub newer { return @{shift->{new}}; } sub newer_names { return map {$_->pkgname} @{shift->{new}}; } sub older { return (); } sub older_names { return (); } sub kept { return (); } sub kept_names { return (); } sub print { my $self = shift; return $self->{new}[0]->pkgname; } package OpenBSD::PkgCreate; our @ISA = qw(OpenBSD::AddCreateDelete); sub handle_fragment { my ($self, $state, $old, $not, $frag, undef, $cont, $msg) = @_; my $def = $frag; if ($state->{subst}->has_fragment($def, $frag, $msg)) { return undef if defined $not; } else { return undef unless defined $not; } my $newname = $old->deduce_name($frag, $not, $self, $state); if (defined $newname) { $state->set_status("switching to $newname") unless $state->{silent}; my $f = $old->new($newname); if (!defined $f) { $self->cant_read_fragment($state, $newname); } else { return $f; } } return undef; } sub FileClass { return "MyFile"; } # hook for update-plist, which wants to record fragment positions sub record_fragment { } # hook for update-plist, which wants to record original file info sub annotate { } sub read_fragments { my ($self, $state, $plist, $filename) = @_; my $stack = []; my $subst = $state->{subst}; my $main = $self->FileClass->new($filename); return undef if !defined $main; push(@$stack, $main); my $fast = $subst->value("LIBS_ONLY"); return $plist->read($stack, sub { my ($stack, $cont) = @_; while(my $file = pop @$stack) { while (my $l = $file->readline) { $state->progress->working(2048) unless $state->{silent}; # add a file name to uncommitted cvs tags so # that the plist is always the same if ($l =~m/^(\@comment\s+\$(?:Open)BSD\$)$/o) { $l = '@comment $'.'OpenBSD: '.basename($file->name).',v$'; } if ($l =~ m/^(\!)?\%\%(.*)\%\%$/) { $self->record_fragment($plist, $1, $2, $file); if (my $f2 = $self->handle_fragment($state, $file, $1, $2, $l, $cont, $filename)) { push(@$stack, $file); $file = $f2; } next; } my $s = $subst->do($l); if ($fast) { next unless $s =~ m/^\@(?:cwd|lib|libset|define-tag|depend|wantlib)\b/o || $s =~ m/lib.*\.a$/o; } # XXX some things, like @comment no checksum, don't produce an object my $o = &$cont($s); if (defined $o) { $o->check_version($state, $s); $self->annotate($o, $l, $file); } } } }); } sub add_description { my ($state, $plist, $name, $opt_d) = @_; my $o = OpenBSD::PackingElement::FDESC->add($plist, $name); my $subst = $state->{subst}; my $comment = $subst->value('COMMENT'); if (defined $comment) { if (length $comment > 60) { $state->fatal("comment is too long\n#1\n#2\n", $comment, ' 'x60 . "^" x (length($comment)-60)); } } else { $state->usage("Comment required"); } if (!defined $opt_d) { $state->usage("Description required"); } return if defined $state->opt('q'); open(my $fh, '+>', $o->fullname) or die "Can't write to DESCR: $!"; if (defined $comment) { print $fh $subst->do($comment), "\n"; } if ($opt_d =~ /^\-(.*)$/o) { print $fh $1, "\n"; } else { $subst->copy_fh($opt_d, $fh); } if (defined $comment) { if ($subst->empty('MAINTAINER')) { $state->errsay("no MAINTAINER"); } else { print $fh "\n", $subst->do('Maintainer: ${MAINTAINER}'), "\n"; } if (!$subst->empty('HOMEPAGE')) { print $fh "\n", $subst->do('WWW: ${HOMEPAGE}'), "\n"; } } seek($fh, 0, 0) or die "Can't rewind DESCR: $!"; my $errors = 0; while (<$fh>) { chomp; if ($state->safe($_) ne $_) { $state->errsay( "DESCR contains weird characters: #1 on line #2", $_, $.); $errors++; } } if ($errors) { $state->fatal("Can't continue"); } close($fh); } sub add_extra_info { my ($self, $plist, $state) = @_; my $subst = $state->{subst}; my $fullpkgpath = $state->{fullpkgpath}; my $cdrom = $subst->value('PERMIT_PACKAGE_CDROM') || $subst->value('CDROM');; my $ftp = $subst->value('PERMIT_PACKAGE_FTP') || $subst->value('FTP'); $ftp //= 'no'; $ftp = 'yes' if $ftp =~ m/^yes$/io; $cdrom = 'yes' if defined $cdrom && $cdrom =~ m/^yes$/io; OpenBSD::PackingElement::ExtraInfo->add($plist, $fullpkgpath, $cdrom, $ftp); } sub add_elements { my ($self, $plist, $state) = @_; my $subst = $state->{subst}; add_description($state, $plist, DESC, $state->opt('d')); OpenBSD::PackingElement::FDISPLAY->may_add($subst, $plist, $state->opt('M')); OpenBSD::PackingElement::FUNDISPLAY->may_add($subst, $plist, $state->opt('U')); for my $d (sort keys %{$state->{dependencies}}) { OpenBSD::PackingElement::Dependency->add($plist, $d); } for my $w (sort keys %{$state->{wantlib}}) { OpenBSD::PackingElement::Wantlib->add($plist, $w); } for my $w (sort keys %{$state->{libset}}) { OpenBSD::PackingElement::Libset->add($plist, $w); } if (defined $state->opt('A')) { OpenBSD::PackingElement::Arch->add($plist, $state->opt('A')); } if (defined $state->opt('L')) { OpenBSD::PackingElement::LocalBase->add($plist, $state->opt('L')); $state->{groff} = $state->opt('L'). '/bin/groff'; } $self->add_extra_info($plist, $state); if ($state->{system_version}) { OpenBSD::PackingElement::Version->add($plist, $state->{system_version}); } } sub cant_read_fragment { my ($self, $state, $frag) = @_; $state->fatal("can't read packing-list #1", $frag); } sub missing_fragments { my ($self, $state, $frag, $o, $noto) = @_; $state->fatal("Missing fragments for #1: #2 and #3 don't exist", $frag, $o, $noto); } sub read_all_fragments { my ($self, $state, $plist) = @_; if (defined $state->{prefix}) { OpenBSD::PackingElement::Cwd->add($plist, $state->{prefix}); } else { $state->usage("Prefix required"); } for my $contentsfile (@{$state->{contents}}) { $self->read_fragments($state, $plist, $contentsfile) or $self->cant_read_fragment($state, $contentsfile); } $plist->register_forbidden($state); if (defined $state->{forbidden}) { for my $e (@{$state->{forbidden}}) { $state->errsay("Error: #1 can't be set explicitly", "\@".$e->keyword." ".$e->stringize); } $state->fatal("Can't continue"); } } sub create_plist { my ($self, $state, $pkgname) = @_; my $plist = OpenBSD::PackingList->new; if ($pkgname =~ m|([^/]+)$|o) { $pkgname = $1; $pkgname =~ s/\.tgz$//o; } $plist->set_pkgname($pkgname); unless ($state->{silent}) { $state->say("Creating package #1", $pkgname) if defined $state->opt('v'); $state->set_status("reading plist"); } my $dir = OpenBSD::Temp->dir; if (!$dir) { $state->fatal(OpenBSD::Temp->last_error); } $plist->set_infodir($dir); # XXX optimization: we want -S to be fast even if we don't check # everything, e.g., we don't need the actual packing-list to # print a signature if that's all we do. if (!(defined $state->opt('S') && defined $state->opt('n'))) { $self->read_all_fragments($state, $plist); } $self->add_elements($plist, $state); return $plist; } sub make_plist_with_sum { my ($self, $state, $plist) = @_; my $p2 = OpenBSD::PackingList->new; $state->progress->visit_with_count($plist, 'makesum_plist', $p2); $p2->set_infodir($plist->infodir); return $p2; } sub read_existing_plist { my ($self, $state, $contents) = @_; my $plist = OpenBSD::PackingList->new; if (-d $contents && -f $contents.'/'.CONTENTS) { $plist->set_infodir($contents); $contents .= '/'.CONTENTS; } else { $plist->set_infodir(dirname($contents)); } $plist->fromfile($contents) or $state->fatal("can't read packing-list #1", $contents); return $plist; } sub create_package { my ($self, $state, $plist, $ordered, $wname) = @_; $state->say("Creating gzip'd tar ball in '#1'", $wname) if $state->opt('v'); my $h = sub { unlink $wname; my $caught = shift; $SIG{$caught} = 'DEFAULT'; kill $caught, $$; }; local $SIG{'INT'} = $h; local $SIG{'QUIT'} = $h; local $SIG{'HUP'} = $h; local $SIG{'KILL'} = $h; local $SIG{'TERM'} = $h; $state->{archive} = $state->create_archive($wname, $plist->infodir); $state->set_status("archiving"); my $p = $state->progress->new_sizer($plist, $state); for my $e (@$ordered) { $e->create_package($state); $p->advance($e); } $state->end_status; $state->{archive}->close; if ($state->{bad}) { unlink($wname); exit(1); } } sub show_bad_symlinks { my ($self, $state) = @_; for my $dest (sort keys %{$state->{bad_symlinks}}) { $state->errsay("Warning: symlink(s) point to non-existent #1", $dest); for my $link (@{$state->{bad_symlinks}{$dest}}) { $state->errsay("\t#1", $link); } } } sub check_dependencies { my ($self, $plist, $state) = @_; my $solver = OpenBSD::Dependencies::CreateSolver->new($plist); # look for libraries in the "real" tree $state->{destdir} = '/'; $solver->solve_all_depends($state); if (!$solver->solve_wantlibs($state, 1)) { $state->{bad}++; } } sub finish_manpages { my ($self, $state, $plist) = @_; $plist->grab_manpages($state); if (defined $state->{manpages}) { $state->run_makewhatis(['-t'], $state->{manpages}); } if (defined $state->{mandir}) { require File::Path; File::Path::remove_tree($state->{mandir}); } } # we maintain an LRU cache of files (by checksum) to speed-up # pkg_add -u sub save_history { my ($self, $plist, $state, $dir) = @_; unless (-d $dir) { require File::Path; File::Path::make_path($dir); } my $name = $plist->fullpkgpath; $name =~ s,/,.,g; my $fname = "$dir/$name"; # if we have history, we record the order of checksums my $known = {}; if (open(my $f, '<', $fname)) { while (<$f>) { chomp; $known->{$_} //= $.; } close($f); } my $todo = []; my $entries = {}; my $list = []; my $tail = []; # scan the plist: find data we need to sort, index them by hash, # directly put some stuff at start of list, and put non indexed stuff # at end (e.g., symlinks and hardlinks) $plist->record_digest($todo, $entries, $list, $tail); my $name2 = "$fname.new"; open(my $f, ">", $name2) or $state->fatal("Can't create #1: #2", $name2, $!); my $found = {}; # split the remaining list # - first, unknown stuff for my $h (@$todo) { if ($known->{$h}) { $found->{$h} = $known->{$h}; } else { print $f "$h\n" if defined $f; push(@$list, (shift @{$entries->{$h}})); } } # dummy entry for verbose output push(@$list, OpenBSD::PackingElement::LRUFrontier->new); # - then known stuff, preserve the order for my $h (sort {$found->{$a} <=> $found->{$b}} keys %$found) { print $f "$h\n" if defined $f; push(@$list, @{$entries->{$h}}); } close($f); rename($name2, $fname) or $state->fatal("Can't rename #1->#2: #3", $name2, $fname, $!); # even with no former history, it's a good idea to save chunks # for instance: packages like texlive will not change all that # fast, so there's a good chance the end chunks will be ordered # correctly my $l = [@$tail]; my $i = 0; my $end_marker = OpenBSD::PackingElement::StreamMarker->new; while (@$list > 0) { my $e = pop @$list; if ($i++ % 16 == 0) { unshift @$l, $end_marker; } unshift @$l, $e; } # remove extraneous marker if @$tail is empty. if ($l->[-1] eq $end_marker) { pop @$l; } return $l; } sub validate_pkgname { my ($self, $state, $pkgname) = @_; my $revision = $state->defines('REVISION_CHECK'); my $epoch = $state->defines('EPOCH_CHECK'); my $flavor_list = $state->defines('FLAVOR_LIST_CHECK'); if ($revision eq '') { $revision = -1; } if ($epoch eq '') { $epoch = -1; } my $okay_flavors = {map {($_, 1)} split(/\s+/, $flavor_list) }; my $v = OpenBSD::PackageName->from_string($pkgname); my $errors = 0; if ($v->{version}->p != $revision) { $state->errsay("REVISION mismatch (REVISION=#1)", $revision); $errors++; } if ($v->{version}->v != $epoch) { $state->errsay("EPOCH mismatch (EPOCH=#1)", $epoch); $errors++; } for my $f (keys %{$v->{flavors}}) { if (!exists $okay_flavors->{$f}) { $state->errsay("bad FLAVOR #1 (admissible flavors #2)", $f, $flavor_list); $errors++; } } if ($errors) { $state->fatal("Can't continue"); } } sub run_command { my ($self, $state) = @_; if (defined $state->opt('Q')) { $state->{opt}{q} = 1; } if (!defined $state->{contents}) { $state->usage("Packing-list required"); } my $plist; if ($state->{regen_package}) { if (!defined $state->{contents} || @{$state->{contents}} > 1) { $state->usage("Exactly one single packing-list is required"); } $plist = $self->read_existing_plist($state, $state->{contents}[0]); } else { $plist = $self->create_plist($state, $ARGV[0]); } if (defined $state->opt('S')) { print $plist->signature->string, "\n"; # no need to check anything else if we're running -n exit 0 if defined $state->opt('n'); } $plist->discover_directories($state); my $ordered = []; unless (defined $state->opt('q') && defined $state->opt('n')) { $state->set_status("checking dependencies"); $self->check_dependencies($plist, $state); if ($state->defines("stub")) { $plist->stub_digest($ordered); } else { $state->set_status("checksumming"); if ($state->{regen_package}) { $state->progress->visit_with_count($plist, 'verify_checksum'); } else { $plist = $self->make_plist_with_sum($state, $plist); my $h = $plist->get('always-update'); if (defined $h) { $h->hash_plist($plist); } } if (defined(my $dir = $state->defines('HISTORY_DIR'))) { $ordered = $self->save_history($plist, $state, $dir); } else { $plist->register_for_archival($ordered); } $self->show_bad_symlinks($state); } $state->end_status; } if (!defined $plist->pkgname) { $state->fatal("can't write unnamed packing-list"); } if (defined $state->defines('REVISION_CHECK')) { $self->validate_pkgname($state, $plist->pkgname); } if (defined $state->opt('q')) { if (defined $state->opt('Q')) { $plist->print_file; } else { $plist->write(\*STDOUT); } return 0 if defined $state->opt('n'); } if ($plist->{deprecated}) { $state->fatal("found obsolete constructs"); } $plist->avert_duplicates_and_other_checks($state); if ($state->{has_no_default_conflict} && !$state->{has_conflict}) { $state->errsay("Warning: \@option no-default-conflict without \@conflict"); } $state->{stash} = {}; if ($state->{bad} && !$state->defines('REGRESSION_TESTING')) { $state->fatal("can't continue"); } $state->{bad} = 0; my $wname; if ($state->{regen_package}) { $wname = $plist->pkgname.".tgz"; } else { $plist->save or $state->fatal("can't write packing-list"); $wname = $ARGV[0]; } if ($state->opt('n')) { $state->{archive} = OpenBSD::Ustar->new(undef, $state, $plist->infodir); $plist->pretend_to_archive($state); } else { $self->create_package($state, $plist, $ordered, $wname); } if (!$state->defines("stub")) { $self->finish_manpages($state, $plist); } } sub parse_and_run { my ($self, $cmd) = @_; my $sign_only = 0; my $rc = 0; my $state = OpenBSD::PkgCreate::State->new($cmd); $state->handle_options; if (@ARGV == 0) { $state->{regen_package} = 1; } elsif (@ARGV != 1) { $state->usage("Exactly one single package name is required: #1", join(' ', @ARGV)); } $self->try_and_run_command($state); return $state->{bad} != 0; } 1;