#! /usr/bin/perl # ex:ts=8 sw=4: # $OpenBSD: pkg_create,v 1.134 2010/01/24 14:23:47 espie Exp $ # # Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org> # # 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::PackingList; use OpenBSD::PackageInfo; use OpenBSD::Getopt; use OpenBSD::Temp; use OpenBSD::Error; use OpenBSD::Ustar; use OpenBSD::ArcCheck; use OpenBSD::Paths; use OpenBSD::Subst; use File::Basename; # Extra stuff needed to archive files package OpenBSD::PackingElement; sub create_package { my ($self, $arc, $base, $verbose) = @_; $self->archive($arc, $base); if ($verbose) { $self->comment_create_package; } } sub pretend_to_archive { my ($self, $arc, $base) = @_; $self->comment_create_package; } sub archive {} sub comment_create_package {} sub print_file {} sub avert_duplicates_and_other_checks { my ($self, $allfiles) = @_; return unless $self->NoDuplicateNames; my $n = $self->fullname; if (defined $allfiles->{$n}) { print STDERR "Error in packing-list: duplicate item $n\n"; $main::errors++; } $allfiles->{$n} = 1; } sub makesum_plist { my ($self, $plist, $base, $stash) = @_; $self->add_object($plist); } sub verify_checksum { } sub compute_checksum { my ($self, $result, $base, $stash) = @_; my $name = $self->fullname; my $fname = $name; if (defined $base) { $fname = $base.$fname; } if (-l $fname) { my $value = readlink $fname; $result->make_symlink($value); } elsif (-f _) { my ($dev, $ino, $size) = (stat _)[0,1,7]; if (defined $stash->{"$dev/$ino"}) { $result->make_hardlink($stash->{"$dev/$ino"}); } else { $stash->{"$dev/$ino"} = $name; $result->add_digest($self->compute_digest($fname)); $result->add_size($size); } } else { print STDERR "Error in package: $fname does not exist\n"; $main::errors++; } } sub makesum_plist_with_base { my ($self, $plist, $base, $stash) = @_; $self->compute_checksum($self, $base, $stash); $self->add_object($plist); } sub verify_checksum_with_base { my ($self, $base, $stash) = @_; my $check = ref($self)->new($self->name); $self->compute_checksum($check, $base, $stash); 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})) { print STDERR "Error: $field inconsistency for ", $self->fullname, "\n"; $main::errors++; } } if ((defined $check->{d} && defined $self->{d} && !$check->{d}->equals($self->{d})) || (defined $check->{d} xor defined $self->{d})) { print STDERR "Error: checksum inconsistency for ", $self->fullname, "\n"; $main::errors++; } } sub prepare_for_archival { my ($self, $arc) = @_; my $o = $arc->prepare_long($self); if (!$o->verify_modes($self)) { $main::errors++; } return $o; } sub copy_over { } package OpenBSD::PackingElement::SpecialFile; sub archive { &OpenBSD::PackingElement::FileBase::archive; } sub pretend_to_archive { &OpenBSD::PackingElement::FileBase::pretend_to_archive; } sub comment_create_package { my ($self) = @_; print "Adding ", $self->name, "\n"; } sub makesum_plist { my ($self, $plist, $base, $stash) = @_; $self->makesum_plist_with_base($plist, undef, $stash); } sub verify_checksum { my ($self, $base, $stash) = @_; $self->verify_checksum_with_base(undef, $stash); } sub prepare_for_archival { my ($self, $arc) = @_; my $o = $arc->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 copy_over { my ($self, $wrarc, $rdarc) = @_; $wrarc->destdir($rdarc->info); my $e = $wrarc->prepare($self->{name}); $e->write; } # override for CONTENTS: we cannot checksum this. package OpenBSD::PackingElement::FCONTENTS; sub makesum_plist { } sub verify_checksum { } package OpenBSD::PackingElement::Cwd; sub archive { my ($self, $arc, $base) = @_; $arc->destdir($base."/".$self->name); } sub pretend_to_archive { my ($self, $arc, $base) = @_; $arc->destdir($base."/".$self->name); $self->comment_create_package; } sub comment_create_package { my ($self) = @_; print "Cwd: ", $self->name, "\n"; } package OpenBSD::PackingElement::FileBase; sub archive { my ($self, $arc, $base) = @_; my $o = $self->prepare_for_archival($arc); $o->write unless $main::errors; } sub pretend_to_archive { my ($self, $arc, $base) = @_; $self->prepare_for_archival($arc); $self->comment_create_package; } sub comment_create_package { my ($self) = @_; print "Adding ", $self->name, "\n"; } sub print_file { my ($item) = @_; print '@', $item->keyword, " ", $item->fullname, "\n"; } sub makesum_plist { my ($self, $plist, $base, $stash) = @_; $self->makesum_plist_with_base($plist, $base, $stash); } sub verify_checksum { my ($self, $base, $stash) = @_; $self->verify_checksum_with_base($base, $stash); } sub copy_over { my ($self, $wrarc, $rdarc) = @_; my $e = $rdarc->next; if (!$e->check_name($self)) { die "Names don't match: ", $e->{name}, " ", $self->{name}; } $e->copy_long($wrarc); } package OpenBSD::PackingElement::InfoFile; sub makesum_plist { my ($self, $plist, $base, $stash) = @_; $self->SUPER::makesum_plist($plist, $base, $stash); my $fname = $self->fullname; for (my $i = 1; ; $i++) { if (-e "$base/$fname-$i") { my $e = OpenBSD::PackingElement::File->add($plist, $self->name."-".$i); $e->compute_checksum($e, $base, $stash); } else { last; } } } package OpenBSD::PackingElement::Depend; sub avert_duplicates_and_other_checks { my ($self, $allfiles) = @_; if (!$self->spec->is_valid) { print STDERR "Error in packing-list: invalid \@", $self->keyword, " ", $self->stringize, "\n"; $main::errors++; } $self->SUPER::avert_duplicates_and_other_checks($allfiles); } package OpenBSD::PackingElement::Dependency; sub avert_duplicates_and_other_checks { my ($self, $allfiles) = @_; my @issues = OpenBSD::PackageName->from_string($self->{def})->has_issues; if (@issues > 0) { print STDERR "Error in packing-list: invalid \@", $self->keyword, " ", $self->stringize, "\n"; print STDERR "$self->{def}: ", join(' ', @issues), "\n"; $main::errors++; } $self->SUPER::avert_duplicates_and_other_checks($allfiles); } package OpenBSD::PackingElement::Name; sub avert_duplicates_and_other_checks { my ($self, $allfiles) = @_; my @issues = OpenBSD::PackageName->from_string($self->name)->has_issues; if (@issues > 0) { print STDERR "Bad packagename ", $self->name, ":", join(' ', @issues), "\n"; $main::errors++; } } # put together file and filename, in order to handle fragments simply package MyFile; sub new { my ($class, $filename) = @_; open(my $fh, '<', $filename) or die "Missing file $filename"; bless { fh => $fh, name => $filename }, $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}); } package main; my $subst = OpenBSD::Subst->new; our ($opt_p, $opt_f, $opt_d, $opt_v, $opt_s, $opt_A, $opt_L, $opt_M, $opt_U, $opt_P, $opt_W, $opt_n, $opt_B, $opt_q, $opt_Q); sub deduce_name { my ($o, $frag, $not) = @_; 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) { die "Missing fragments for $frag: $o and $noto don't exist"; } if ($not) { print "Switching to $noto\n" if !defined $opt_q; return $noto if -e $noto; } else { print "Switching to $o\n" if !defined $opt_q; return $o if -e $o; } return; } sub read_fragments { my ($plist, $filename) = @_; my $stack = []; push(@$stack, MyFile->new($filename)); return $plist->read($stack, sub { my ($stack, $cont) = @_; local $_; while(my $file = pop @$stack) { GETLINE: while ($_ = $file->readline) { if (my ($not, $frag) = m/^(\!)?\%\%(.*)\%\%$/) { my $def = $frag; if ($frag eq 'SHARED') { $def = 'SHARED_LIBS'; $frag = 'shared'; } if ($subst->has_fragment($def, $frag)) { next GETLINE if defined $not; } else { next GETLINE unless defined $not; } my $newname = deduce_name($file->name, $frag, $not); if (defined $newname) { push(@$stack, $file); $file = MyFile->new($newname); } next GETLINE; } if (m/^(\@comment\s+\$(?:Open)BSD\$)$/o) { $_ = '@comment $'.'OpenBSD: '.basename($file->name).',v$'; } if (m/^\@lib\s+(.*)$/o && OpenBSD::PackingElement::Lib->parse($1)) { Warn "Shared library without SHARED_LIBS: $_"; $main::errors++; } &$cont($subst->do($_)); } } } ); } sub add_special_file { my ($plist, $name, $opt) = @_; if (defined $opt) { my $o = OpenBSD::PackingElement::File->add($plist, $name); $subst->copy($opt, $o->fullname) if defined $o->fullname; } } sub add_description { my ($plist, $name, $opt_d) = @_; my $o = OpenBSD::PackingElement::FDESC->add($plist, $name); my $comment = $subst->value('COMMENT'); if (defined $comment) { if (length $comment > 60) { print STDERR "Error: comment is too long\n"; print STDERR $comment, "\n"; print STDERR ' 'x60, "^"x (length($comment)-60), "\n"; exit 1; } } else { Usage "Comment required"; } if (!defined $opt_d) { Usage "Description required"; } if (defined $o->fullname) { open(my $fh, '>', $o->fullname) or die "Can't write to DESC: $!"; 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')) { Warn "no MAINTAINER\n"; } else { print $fh "\n", $subst->do('Maintainer: ${MAINTAINER}'), "\n"; } if (!$subst->empty('HOMEPAGE')) { print $fh "\n", $subst->do('WWW: ${HOMEPAGE}'), "\n"; } } close($fh); } } our $errors = 0; my (@contents, %dependencies, %wantlib, @signature_params); my $regen_package = 0; my $sign_only = 0; my ($cert, $privkey); set_usage( 'pkg_create [-nQqv] [-A arches] [-B pkg-destdir] [-D name[=value]]', '[-L localbase] [-M displayfile] [-P pkg-dependency]', '[-s x509 -s cert -s priv] [-U undisplayfile] [-W wantedlib]', '-d desc -D COMMENT=value -f packinglist -p prefix pkg-name'); my $plist = new OpenBSD::PackingList; try { getopts('p:f:d:vM:U:hs:A:L:B:D:P:W:nqQ', {'D' => sub { $subst->parse_option(shift); }, 'f' => sub { push(@contents, shift); }, 'h' => sub { Usage(); }, 'P' => sub { my $d = shift; $dependencies{$d} = 1; }, 'W' => sub { my $w = shift; $wantlib{$w} = 1; }, 's' => sub { push(@signature_params, shift); } }); } catchall { Usage($_); }; if (@ARGV == 0) { $regen_package = 1; } elsif (@ARGV != 1) { if (@contents || @signature_params == 0) { Usage "Exactly one single package name is required: ", join(' ', @ARGV); } } try { if (@signature_params > 0) { if (@signature_params != 3 || $signature_params[0] ne 'x509' || !-f $signature_params[1] || !-f $signature_params[2]) { Usage "Signature only works as -s x509 -s cert -s privkey"; } $cert = $signature_params[1]; $privkey = $signature_params[2]; } if (defined $opt_Q) { $opt_q = 1; } if (!@contents) { if (@signature_params > 0) { $sign_only = 1; } else { Usage "Packing list required"; } } if ($regen_package) { if (@contents != 1) { Usage "Exactly one single packing list is required"; } if (-d $contents[0] && -f $contents[0].'/'.CONTENTS) { $plist->set_infodir($contents[0]); $contents[0] .= '/'.CONTENTS; } else { $plist->set_infodir(dirname($contents[0])); } $plist->fromfile($contents[0]) or Fatal "Can't read packing list $contents[0]"; } elsif ($sign_only) { if ($opt_n) { Fatal "Can't pretend to sign existing packages"; } for my $pkgname (@ARGV) { require OpenBSD::PackageLocator; require OpenBSD::x509; my $true_package = OpenBSD::PackageLocator->find($pkgname); die "No such package $pkgname" unless $true_package; my $dir = $true_package->info; my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS); $plist->set_infodir($dir); my $sig = OpenBSD::PackingElement::DigitalSignature->new_x509; $sig->add_object($plist); $sig->{b64sig} = OpenBSD::x509::compute_signature($plist, $cert, $privkey); $plist->save; my $tmp = OpenBSD::Temp::permanent_file(".", "pkg"); open( my $outfh, "|-", OpenBSD::Paths->gzip, "-o", $tmp); my $wrarc = OpenBSD::Ustar->new($outfh, "."); $plist->copy_over($wrarc, $true_package); $wrarc->close; $true_package->wipe_info; unlink($plist->pkgname.".tgz"); rename($tmp, $plist->pkgname.".tgz") or die "Can't create final signed package $!"; } exit(0); } else { print "Creating package $ARGV[0]\n" if !(defined $opt_q) && $opt_v; if (!$opt_q) { $plist->set_infodir(OpenBSD::Temp->dir); } add_description($plist, DESC, $opt_d); add_special_file($plist, DISPLAY, $opt_M); add_special_file($plist, UNDISPLAY, $opt_U); if (defined $opt_p) { OpenBSD::PackingElement::Cwd->add($plist, $opt_p); } else { Usage "Prefix required"; } for my $d (sort keys %dependencies) { OpenBSD::PackingElement::Dependency->add($plist, $d); } for my $w (sort keys %wantlib) { OpenBSD::PackingElement::Wantlib->add($plist, $w); } if (defined $opt_A) { OpenBSD::PackingElement::Arch->add($plist, $opt_A); } if (defined $opt_L) { OpenBSD::PackingElement::LocalBase->add($plist, $opt_L); } if ($ARGV[0] =~ m|([^/]+)$|o) { my $pkgname = $1; $pkgname =~ s/\.tgz$//o; $plist->set_pkgname($pkgname); } my $fullpkgpath = $subst->value('FULLPKGPATH'); my $cdrom = $subst->value('PERMIT_PACKAGE_CDROM') || $subst->value('CDROM');; my $ftp = $subst->value('PERMIT_PACKAGE_FTP') || $subst->value('FTP'); if (defined $fullpkgpath || defined $cdrom || defined $ftp) { $fullpkgpath //= ''; $cdrom //= 'no'; $ftp //= 'no'; $cdrom = 'yes' if $cdrom =~ m/^yes$/io; $ftp = 'yes' if $ftp =~ m/^yes$/io; OpenBSD::PackingElement::ExtraInfo->add($plist, $fullpkgpath, $cdrom, $ftp); } else { Warn "Package without FULLPKGPATH\n"; } for my $contentsfile (@contents) { read_fragments($plist, $contentsfile) or Fatal "Can't read packing list $contentsfile"; } } my $base = '/'; if (defined $opt_B) { $base = $opt_B; } elsif (defined $ENV{'PKG_PREFIX'}) { $base = $ENV{'PKG_PREFIX'}; } unless (defined $opt_q && defined $opt_n) { if ($regen_package) { $plist->verify_checksum($base, {}); } else { my $p2 = OpenBSD::PackingList->new; $plist->makesum_plist($p2, $base, {}); $p2->set_infodir($plist->infodir); $plist = $p2; } } if (!defined $plist->{name}) { print STDERR "Can't write unnamed packing list\n"; exit 1; } if (defined $opt_q) { if (defined $opt_Q) { $plist->print_file; } else { $plist->write(\*STDOUT); } exit 0 if defined $opt_n; } if ($plist->{deprecated}) { print STDERR "Error: found obsolete constructs\n"; exit 1; } $plist->avert_duplicates_and_other_checks({}); if ($errors && $subst->empty('REGRESSION_TESTING')) { exit 1; } $errors = 0; if (defined $cert) { my $sig = OpenBSD::PackingElement::DigitalSignature->new_x509; $sig->add_object($plist); require OpenBSD::x509; $sig->{b64sig} = OpenBSD::x509::compute_signature($plist, $cert, $privkey); $plist->save if $regen_package; } my $wname; if ($regen_package) { $wname = $plist->pkgname.".tgz"; } else { $plist->save or Fatal "Can't write packing list"; $wname = $ARGV[0]; } if ($opt_n) { my $dummy = OpenBSD::Ustar->new(undef, $plist->infodir); $plist->pretend_to_archive($dummy, $base); } else { print "Creating gzip'd tar ball in '$wname'\n" if $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; open(my $fh, "|-", OpenBSD::Paths->gzip, "-f", "-o", $wname); my $wrarc = OpenBSD::Ustar->new($fh, $plist->infodir); $plist->create_package($wrarc, $base, $opt_v); $wrarc->close; if ($errors) { unlink($wname); exit(1); } } } catch { print STDERR "$0: $_\n"; exit(1); };