1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: PkgCreate.pm,v 1.64 2012/05/07 15:56:18 espie Exp $
4#
5# Copyright (c) 2003-2010 Marc Espie <espie@openbsd.org>
6#
7# Permission to use, copy, modify, and distribute this software for any
8# purpose with or without fee is hereby granted, provided that the above
9# copyright notice and this permission notice appear in all copies.
10#
11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18
19use strict;
20use warnings;
21
22use OpenBSD::AddCreateDelete;
23use OpenBSD::Dependencies;
24use OpenBSD::SharedLibs;
25
26package OpenBSD::PkgCreate::State;
27our @ISA = qw(OpenBSD::AddCreateDelete::State);
28
29sub init
30{
31	my $self = shift;
32
33	$self->{stash} = {};
34	$self->SUPER::init(@_);
35	$self->{simple_status} = 0;
36}
37
38sub stash
39{
40	my ($self, $key) = @_;
41	return $self->{stash}{$key};
42}
43
44sub error
45{
46	my $self = shift;
47	my $msg = shift;
48	$self->{bad}++;
49	$self->errsay("Error: $msg", @_);
50}
51
52sub set_status
53{
54	my ($self, $status) = @_;
55	if ($self->{simple_status}) {
56		print "\n$status";
57	} else {
58		if ($self->progress->set_header($status)) {
59			$self->progress->message('');
60		} else {
61			$| = 1;
62			print "$status...";
63			$self->{simple_status} = 1;
64		}
65	}
66}
67
68sub end_status
69{
70	my $self = shift;
71
72	if ($self->{simple_status}) {
73		print "\n";
74	} else {
75		$self->progress->clear;
76	}
77}
78
79sub handle_options
80{
81	my $state = shift;
82
83	$state->{opt} = {
84	    'f' =>
85		    sub {
86			    push(@{$state->{contents}}, shift);
87		    },
88	    'p' =>
89		    sub {
90			    $state->{prefix} = shift;
91		    },
92	    'P' => sub {
93			    my $d = shift;
94			    $state->{dependencies}{$d} = 1;
95		    },
96	    'W' => sub {
97			    my $w = shift;
98			    $state->{wantlib}{$w} = 1;
99		    },
100	    's' => sub {
101			    push(@{$state->{signature_params}}, shift);
102		    },
103	};
104	$state->{no_exports} = 1;
105	$state->SUPER::handle_options('p:f:d:M:U:s:A:B:P:W:qQ',
106	    '[-nQqvx] [-A arches] [-B pkg-destdir] [-D name[=value]]',
107	    '[-L localbase] [-M displayfile] [-P pkg-dependency]',
108	    '[-s x509 -s cert -s priv] [-U undisplayfile] [-W wantedlib]',
109	    '-d desc -D COMMENT=value -f packinglist -p prefix pkg-name');
110
111	my $base = '/';
112	if (defined $state->opt('B')) {
113		$base = $state->opt('B');
114	} elsif (defined $ENV{'PKG_PREFIX'}) {
115		$base = $ENV{'PKG_PREFIX'};
116	}
117
118	$state->{base} = $base;
119
120}
121
122package OpenBSD::PkgCreate;
123
124use OpenBSD::PackingList;
125use OpenBSD::PackageInfo;
126use OpenBSD::Getopt;
127use OpenBSD::Temp;
128use OpenBSD::Error;
129use OpenBSD::Ustar;
130use OpenBSD::ArcCheck;
131use OpenBSD::Paths;
132use File::Basename;
133
134# Extra stuff needed to archive files
135package OpenBSD::PackingElement;
136sub create_package
137{
138	my ($self, $state) = @_;
139
140	$self->archive($state);
141	if ($state->verbose) {
142		$self->comment_create_package;
143	}
144}
145
146sub pretend_to_archive
147{
148	my ($self, $state) = @_;
149	$self->comment_create_package;
150}
151
152sub archive {}
153sub comment_create_package {}
154sub grab_manpages {}
155
156sub print_file {}
157
158sub avert_duplicates_and_other_checks
159{
160	my ($self, $state) = @_;
161	return unless $self->NoDuplicateNames;
162	my $n = $self->fullname;
163	if (defined $state->stash($n)) {
164		$state->error("duplicate item in packing-list #1", $n);
165	}
166	$state->{stash}{$n} = 1;
167}
168
169sub makesum_plist
170{
171	my ($self, $plist, $state) = @_;
172	$self->add_object($plist);
173}
174
175sub verify_checksum
176{
177}
178
179sub resolve_link
180{
181	my ($filename, $base, $level) = @_;
182	$level //= 0;
183	if (-l $filename) {
184		my $l = readlink($filename);
185		if ($level++ > 14) {
186			return undef;
187		}
188		if ($l =~ m|^/|) {
189			return $base.resolve_link($l, $base, $level);
190		} else {
191			return resolve_link(File::Spec->catfile(File::Basename::dirname($filename),$l), $base, $level);
192		}
193	} else {
194		return $filename;
195	}
196}
197
198sub compute_checksum
199{
200	my ($self, $result, $state, $base) = @_;
201	my $name = $self->fullname;
202	my $fname = $name;
203	if (defined $base) {
204		$fname = $base.$fname;
205	}
206	for my $field (qw(symlink link size)) {  # md5
207		if (defined $result->{$field}) {
208			$state->error("User tried to define @#1 for #2",
209			    $field, $fname);
210		}
211	}
212	if (defined $self->{wtempname}) {
213		$fname = $self->{wtempname};
214	}
215	if (-l $fname) {
216		if (!defined $base) {
217			$state->error("special file #1 can't be a symlink",
218			    $self->stringize);
219		}
220		my $value = readlink $fname;
221		my $chk = resolve_link($fname, $base);
222		$fname =~ s|^//|/|; # cosmetic
223		if (!defined $chk) {
224			$state->error("bogus symlink: #1 (too deep)", $fname);
225		} elsif (!-e $chk) {
226			push(@{$state->{bad_symlinks}{$chk}}, $fname);
227		}
228		$result->make_symlink($value);
229	} elsif (-f _) {
230		my ($dev, $ino, $size) = (stat _)[0,1,7];
231		if (defined $state->stash("$dev/$ino")) {
232			$result->make_hardlink($state->stash("$dev/$ino"));
233		} else {
234			$state->{stash}{"$dev/$ino"} = $name;
235			$result->add_digest($self->compute_digest($fname));
236			$result->add_size($size);
237		}
238	} elsif (-d _) {
239		$state->error("#1 should be a file and not a directory", $fname);
240	} else {
241		$state->error("#1 does not exist", $fname);
242	}
243}
244
245sub makesum_plist_with_base
246{
247	my ($self, $plist, $state, $base) = @_;
248	$self->compute_checksum($self, $state, $base);
249	$self->add_object($plist);
250}
251
252sub verify_checksum_with_base
253{
254	my ($self, $state, $base) = @_;
255	my $check = ref($self)->new($self->name);
256	$self->compute_checksum($check, $state, $base);
257
258	for my $field (qw(symlink link size)) {  # md5
259		if ((defined $check->{$field} && defined $self->{$field} &&
260		    $check->{$field} ne $self->{$field}) ||
261		    (defined $check->{$field} xor defined $self->{$field})) {
262		    	$state->error("#1 inconsistency for #2",
263			    $field, $self->fullname);
264		}
265	}
266	if ((defined $check->{d} && defined $self->{d} &&
267	    !$check->{d}->equals($self->{d})) ||
268	    (defined $check->{d} xor defined $self->{d})) {
269	    	$state->error("checksum inconsistency for #1",
270		    $self->fullname);
271	}
272}
273
274
275sub prepare_for_archival
276{
277	my ($self, $state) = @_;
278
279	my $o = $state->{archive}->prepare_long($self);
280	if (!$o->verify_modes($self)) {
281		$state->error("modes don't match for #1", $self->fullname);
282	}
283	return $o;
284}
285
286sub copy_over
287{
288}
289
290sub discover_directories
291{
292}
293
294package OpenBSD::PackingElement::RcScript;
295sub archive
296{
297	my ($self, $state) = @_;
298	if ($self->name =~ m/^\//) {
299		$state->{archive}->destdir($state->{base});
300	}
301	$self->SUPER::archive($state);
302}
303
304package OpenBSD::PackingElement::SpecialFile;
305sub archive
306{
307	&OpenBSD::PackingElement::FileBase::archive;
308}
309
310sub pretend_to_archive
311{
312	&OpenBSD::PackingElement::FileBase::pretend_to_archive;
313}
314
315sub comment_create_package
316{
317	my ($self) = @_;
318	print "Adding ", $self->name, "\n";
319}
320
321sub makesum_plist
322{
323	my ($self, $plist, $state) = @_;
324	$self->makesum_plist_with_base($plist, $state, undef);
325}
326
327sub verify_checksum
328{
329	my ($self, $state) = @_;
330	$self->verify_checksum_with_base($state, undef);
331}
332
333sub prepare_for_archival
334{
335	my ($self, $state) = @_;
336
337	my $o = $state->{archive}->prepare_long($self);
338	$o->{uname} = 'root';
339	$o->{gname} = 'wheel';
340	$o->{uid} = 0;
341	$o->{gid} = 0;
342	$o->{mode} &= 0555; # zap all write and suid modes
343	return $o;
344}
345
346sub copy_over
347{
348	my ($self, $wrarc, $rdarc) = @_;
349	$wrarc->destdir($rdarc->info);
350	my $e = $wrarc->prepare($self->{name});
351	$e->write;
352}
353
354# override for CONTENTS: we cannot checksum this.
355package OpenBSD::PackingElement::FCONTENTS;
356sub makesum_plist
357{
358}
359
360sub verify_checksum
361{
362}
363
364
365package OpenBSD::PackingElement::Cwd;
366sub archive
367{
368	my ($self, $state) = @_;
369	$state->{archive}->destdir($state->{base}."/".$self->name);
370}
371
372sub pretend_to_archive
373{
374	my ($self, $state) = @_;
375	$state->{archive}->destdir($state->{base}."/".$self->name);
376	$self->comment_create_package;
377}
378
379sub comment_create_package
380{
381	my ($self) = @_;
382	print "Cwd: ", $self->name, "\n";
383}
384
385package OpenBSD::PackingElement::FileBase;
386
387sub archive
388{
389	my ($self, $state) = @_;
390
391	my $o = $self->prepare_for_archival($state);
392
393	$o->write unless $state->{bad};
394}
395
396sub pretend_to_archive
397{
398	my ($self, $state) = @_;
399
400	$self->prepare_for_archival($state);
401	$self->comment_create_package;
402}
403
404sub comment_create_package
405{
406	my ($self) = @_;
407	print "Adding ", $self->name, "\n";
408}
409
410sub print_file
411{
412	my ($item) = @_;
413	print '@', $item->keyword, " ", $item->fullname, "\n";
414}
415
416sub makesum_plist
417{
418	my ($self, $plist, $state) = @_;
419	$self->makesum_plist_with_base($plist, $state, $state->{base});
420}
421
422sub verify_checksum
423{
424	my ($self, $state) = @_;
425	$self->verify_checksum_with_base($state, $state->{base});
426}
427
428sub copy_over
429{
430	my ($self, $wrarc, $rdarc) = @_;
431	my $e = $rdarc->next;
432	if (!$e->check_name($self)) {
433		die "Names don't match: ", $e->{name}, " ", $self->{name};
434	}
435	$e->copy_long($wrarc);
436}
437
438package OpenBSD::PackingElement::Dir;
439sub discover_directories
440{
441	my ($self, $state) = @_;
442	$state->{known_dirs}->{$self->fullname} = 1;
443}
444
445package OpenBSD::PackingElement::InfoFile;
446sub makesum_plist
447{
448	my ($self, $plist, $state) = @_;
449	$self->SUPER::makesum_plist($plist, $state);
450	my $fname = $self->fullname;
451	for (my $i = 1; ; $i++) {
452		if (-e "$state->{base}/$fname-$i") {
453			my $e = OpenBSD::PackingElement::File->add($plist, $self->name."-".$i);
454			$e->compute_checksum($e, $state, $state->{base});
455		} else {
456			last;
457		}
458	}
459}
460
461package OpenBSD::PackingElement::Manpage;
462use File::Basename;
463
464sub grab_manpages
465{
466	my ($self, $state) = @_;
467	my $filename;
468	if ($self->{wtempname}) {
469		$filename = $self->{wtempname};
470	} else {
471		$filename = $state->{base}.$self->fullname;
472	}
473	push(@{$state->{manpages}}, $filename);
474}
475
476sub makesum_plist
477{
478	my ($self, $plist, $state) = @_;
479	if ($state->{subst}->empty("USE_GROFF") || !$self->is_source) {
480		return $self->SUPER::makesum_plist($plist, $state);
481	}
482	my $dest = $self->source_to_dest;
483	my $fullname = $self->cwd."/".$dest;
484	my $d = dirname($fullname);
485	$state->{mandir} //= OpenBSD::Temp::permanent_dir(
486	    $ENV{TMPDIR} // '/tmp', "manpage");
487	my $tempname = $state->{mandir}."/".$fullname;
488	require File::Path;
489	File::Path::make_path($state->{mandir}."/".$d);
490	open my $fh, ">", $tempname or $state->error("can't create #1: #2",
491	    $tempname, $!);
492	chmod 0444, $fh;
493	if (-d $state->{base}.$d) {
494		undef $d;
495	}
496	$self->format($state, $tempname, $fh);
497	if (-z $tempname) {
498		$state->errsay("groff produced empty result for #1", $dest);
499		$state->errsay("\tkeeping source manpage");
500		return $self->SUPER::makesum_plist($plist, $state);
501	}
502	if (defined $d && !$state->{known_dirs}->{$d}) {
503		$state->{known_dirs}->{$d} = 1;
504		OpenBSD::PackingElement::Dir->add($plist, dirname($dest));
505	}
506	my $e = OpenBSD::PackingElement::Manpage->add($plist, $dest);
507	$e->{wtempname} = $tempname;
508	$e->compute_checksum($e, $state, $state->{base});
509}
510
511package OpenBSD::PackingElement::Depend;
512sub avert_duplicates_and_other_checks
513{
514	my ($self, $state) = @_;
515	if (!$self->spec->is_valid) {
516		$state->error("invalid \@#1 #2 in packing-list",
517		    $self->keyword, $self->stringize);
518	}
519	$self->SUPER::avert_duplicates_and_other_checks($state);
520}
521
522package OpenBSD::PackingElement::Conflict;
523sub avert_duplicates_and_other_checks
524{
525	$_[1]->{has_conflict}++;
526	&OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks;
527}
528
529package OpenBSD::PackingElement::AskUpdate;
530sub avert_duplicates_and_other_checks
531{
532	&OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks;
533}
534
535package OpenBSD::PackingElement::Dependency;
536sub avert_duplicates_and_other_checks
537{
538	my ($self, $state) = @_;
539
540	$self->SUPER::avert_duplicates_and_other_checks($state);
541
542	my @issues = OpenBSD::PackageName->from_string($self->{def})->has_issues;
543	if (@issues > 0) {
544		$state->error("\@#1 #2\n  #3, #4",
545		    $self->keyword, $self->stringize,
546		    $self->{def}, join(' ', @issues));
547	} elsif ($self->spec->is_valid) {
548		my @m = $self->spec->filter($self->{def});
549		if (@m == 0) {
550			$state->error("\@#1 #2\n  pattern #3 doesn't match default #4\n",
551			    $self->keyword, $self->stringize,
552			    $self->{pattern}, $self->{def});
553		}
554	}
555}
556
557package OpenBSD::PackingElement::Name;
558sub avert_duplicates_and_other_checks
559{
560	my ($self, $state) = @_;
561
562	my @issues = OpenBSD::PackageName->from_string($self->name)->has_issues;
563	if (@issues > 0) {
564		$state->error("bad package name #1: ", $self->name,
565		    join(' ', @issues));
566	}
567	$self->SUPER::avert_duplicates_and_other_checks($state);
568}
569
570package OpenBSD::PackingElement::NoDefaultConflict;
571sub avert_duplicates_and_other_checks
572{
573	my ($self, $state) = @_;
574	$state->{has_no_default_conflict}++;
575}
576
577
578# put together file and filename, in order to handle fragments simply
579package MyFile;
580sub new
581{
582	my ($class, $filename) = @_;
583
584	open(my $fh, '<', $filename) or die "Missing file $filename";
585
586	bless { fh => $fh, name => $filename }, (ref($class) || $class);
587}
588
589sub readline
590{
591	my $self = shift;
592	return readline $self->{fh};
593}
594
595sub name
596{
597	my $self = shift;
598	return $self->{name};
599}
600
601sub close
602{
603	my $self = shift;
604	close($self->{fh});
605}
606
607sub deduce_name
608{
609	my ($self, $frag, $not) = @_;
610
611	my $o = $self->name;
612	my $noto = $o;
613	my $nofrag = "no-$frag";
614
615	$o =~ s/PFRAG\./PFRAG.$frag-/o or
616	    $o =~ s/PLIST/PFRAG.$frag/o;
617
618	$noto =~ s/PFRAG\./PFRAG.no-$frag-/o or
619	    $noto =~ s/PLIST/PFRAG.no-$frag/o;
620	unless (-e $o or -e $noto) {
621		die "Missing fragments for $frag: $o and $noto don't exist";
622	}
623	if ($not) {
624		return $noto if -e $noto;
625    	} else {
626		return $o if -e $o;
627	}
628	return;
629}
630
631# special solver class for PkgCreate
632package OpenBSD::Dependencies::CreateSolver;
633our @ISA = qw(OpenBSD::Dependencies::SolverBase);
634
635# we need to "hack" a special set
636sub new
637{
638	my ($class, $plist) = @_;
639	bless { set => OpenBSD::PseudoSet->new($plist), bad => [] }, $class;
640}
641
642sub solve_all_depends
643{
644	my ($solver, $state) = @_;
645
646	while (1) {
647		my @todo = $solver->solve_depends($state);
648		if (@todo == 0) {
649			return;
650		}
651		if ($solver->solve_wantlibs($state, 0)) {
652			return;
653		}
654		$solver->{set}->add_new(@todo);
655	}
656}
657
658sub solve_wantlibs
659{
660	my ($solver, $state, $final) = @_;
661
662	my $okay = 1;
663	my $lib_finder = OpenBSD::lookup::library->new($solver);
664	my $h = $solver->{set}->{new}[0];
665	for my $lib (@{$h->{plist}->{wantlib}}) {
666		$solver->{localbase} = $h->{plist}->localbase;
667		next if $lib_finder->lookup($solver,
668		    $solver->{to_register}->{$h}, $state,
669		    $lib->spec);
670		$okay = 0;
671		OpenBSD::SharedLibs::report_problem($state,
672		    $lib->spec) if $final;
673	}
674	if (!$okay && $final) {
675		$solver->dump($state);
676		$lib_finder->dump($state);
677	}
678	return $okay;
679}
680
681sub really_solve_dependency
682{
683	my ($self, $state, $dep, $package) = @_;
684
685	$state->progress->message($dep->{pkgpath});
686
687	# look in installed packages
688	my $v = $self->find_dep_in_installed($state, $dep);
689	if (!defined $v) {
690		$v = $self->find_dep_in_self($state, $dep);
691	}
692
693	# and in portstree otherwise
694	if (!defined $v) {
695		$v = $self->solve_from_ports($state, $dep, $package);
696	}
697	return $v;
698}
699
700my $cache = {};
701sub solve_from_ports
702{
703	my ($self, $state, $dep, $package) = @_;
704
705	my $portsdir = $state->defines('PORTSDIR');
706	return undef unless defined $portsdir;
707	my $pkgname;
708	if (defined $cache->{$dep->{pkgpath}}) {
709		$pkgname = $cache->{$dep->{pkgpath}};
710	} else {
711		my ($plist, $diskcache);
712		if ($ENV{_DEPENDS_CACHE}) {
713			$diskcache = $dep->{pkgpath};
714			$diskcache =~ s/\//--/g;
715			$diskcache = $ENV{_DEPENDS_CACHE}."/pkgcreate-".
716			    $diskcache;
717		}
718		if (defined $diskcache && -f $diskcache) {
719			$plist = OpenBSD::PackingList->fromfile($diskcache);
720		} else {
721			$plist = $self->ask_tree($state, $dep, $portsdir,
722			    'print-plist-libs-with-depends',
723			    'wantlib_args=no-wantlib-args');
724			if ($? != 0 || !defined $plist->pkgname) {
725				$state->error("Can't obtain dependency #1 from ports tree",
726				    $dep->{pattern});
727				return undef;
728			}
729			$plist->tofile($diskcache) if defined $diskcache;
730		}
731		OpenBSD::SharedLibs::add_libs_from_plist($plist, $state);
732		$self->add_dep($plist);
733		$pkgname = $plist->pkgname;
734		$cache->{$dep->{pkgpath}} = $pkgname;
735	}
736	if ($dep->spec->filter($pkgname) == 0) {
737		$state->error("Dependency #1 doesn't match FULLPKGNAME: #2",
738		    $dep->{pattern}, $pkgname);
739		return undef;
740	}
741
742	return $pkgname;
743}
744
745sub ask_tree
746{
747	my ($self, $state, $dep, $portsdir, @action) = @_;
748
749	my $make = OpenBSD::Paths->make;
750	my $pid = open(my $fh, "-|");
751	if (!defined $pid) {
752		$state->fatal("cannot fork: $!");
753	}
754	if ($pid == 0) {
755		chdir $portsdir or exit 2;
756		open STDERR, '>', '/dev/null';
757		$ENV{FULLPATH} = 'Yes';
758		delete $ENV{FLAVOR};
759		delete $ENV{SUBPACKAGE};
760		$ENV{SUBDIR} = $dep->{pkgpath};
761		$ENV{ECHO_MSG} = ':';
762		exec $make ('make', @action);
763	}
764	my $plist = OpenBSD::PackingList->read($fh,
765	    \&OpenBSD::PackingList::PrelinkStuffOnly);
766	close($fh);
767	return $plist;
768}
769
770# we don't want old libs
771sub find_old_lib
772{
773	return undef;
774}
775
776package OpenBSD::PseudoHandle;
777sub new
778{
779	my ($class, $plist) = @_;
780	bless { plist => $plist}, $class;
781}
782
783sub pkgname
784{
785	my $self = shift;
786
787	return $self->{plist}->pkgname;
788}
789
790package OpenBSD::PseudoSet;
791sub new
792{
793	my ($class, @elements) = @_;
794
795	my $o = bless {}, $class;
796	$o->add_new(@elements);
797}
798
799sub add_new
800{
801	my ($self, @elements) = @_;
802	for my $i (@elements) {
803		push(@{$self->{new}}, OpenBSD::PseudoHandle->new($i));
804	}
805	return $self;
806}
807
808sub newer
809{
810	return @{shift->{new}};
811}
812
813
814sub newer_names
815{
816	return map {$_->pkgname} @{shift->{new}};
817}
818
819sub older
820{
821	return ();
822}
823
824sub older_names
825{
826	return ();
827}
828
829sub kept
830{
831	return ();
832}
833
834sub print
835{
836	my $self = shift;
837	return $self->{new}[0]->pkgname;
838}
839
840package OpenBSD::PkgCreate;
841our @ISA = qw(OpenBSD::AddCreateDelete);
842
843sub handle_fragment
844{
845	my ($self, $state, $old, $not, $frag, $_, $cont) = @_;
846	my $def = $frag;
847	if ($frag eq 'SHARED') {
848		$def = 'SHARED_LIBS';
849		$frag = 'shared';
850	}
851	if ($state->{subst}->has_fragment($def, $frag)) {
852		return undef if defined $not;
853	} else {
854		return undef unless defined $not;
855	}
856	my $newname = $old->deduce_name($frag, $not);
857	if (defined $newname) {
858		$state->set_status("switching to $newname")
859		    if !defined $state->opt('q');
860		return $old->new($newname);
861	}
862	return undef;
863}
864
865sub FileClass
866{
867	return "MyFile";
868}
869
870sub read_fragments
871{
872	my ($self, $state, $plist, $filename) = @_;
873
874	my $stack = [];
875	my $subst = $state->{subst};
876	push(@$stack, $self->FileClass->new($filename));
877	my $fast = $subst->value("LIBS_ONLY");
878
879	return $plist->read($stack,
880	    sub {
881		my ($stack, $cont) = @_;
882		while(my $file = pop @$stack) {
883			while (my $_ = $file->readline) {
884				$state->progress->working(2048) unless $state->opt('q');
885				if (m/^(\@comment\s+\$(?:Open)BSD\$)$/o) {
886					$_ = '@comment $'.'OpenBSD: '.basename($file->name).',v$';
887				}
888				if (m/^\@lib\s+(.*)$/o &&
889				    OpenBSD::PackingElement::Lib->parse($1)) {
890				    	$state->error("shared library without SHARED_LIBS: #1", $_);
891				}
892				if (m/^(\!)?\%\%(.*)\%\%$/) {
893					if (my $f2 = $self->handle_fragment($state, $file, $1, $2, $_, $cont)) {
894						push(@$stack, $file);
895						$file = $f2;
896					}
897					next;
898				}
899				my $s = $subst->do($_);
900				if ($fast) {
901					next unless $s =~ m/^\@(?:cwd|lib|depend|wantlib)\b/o || $s =~ m/lib.*\.a$/o;
902				}
903	# XXX some things, like @comment no checksum, don't produce an object
904				my $o = &$cont($s);
905				if (defined $o) {
906					$self->annotate($o, $_, $file);
907				}
908			}
909		}
910	    });
911}
912
913sub annotate
914{
915}
916
917sub add_special_file
918{
919	my ($subst, $plist, $name, $opt) = @_;
920	if (defined $opt) {
921	    my $o = OpenBSD::PackingElement::File->add($plist, $name);
922	    $subst->copy($opt, $o->fullname) if defined $o->fullname;
923	}
924}
925
926sub add_description
927{
928	my ($state, $plist, $name, $opt_d) = @_;
929	my $o = OpenBSD::PackingElement::FDESC->add($plist, $name);
930	my $subst = $state->{subst};
931	my $comment = $subst->value('COMMENT');
932	if (defined $comment) {
933		if (length $comment > 60) {
934			$state->fatal("comment is too long\n#1\n#2\n",
935			    $comment, ' 'x60 . "^" x (length($comment)-60));
936		}
937	} else {
938		$state->usage("Comment required");
939	}
940	if (!defined $opt_d) {
941		$state->usage("Description required");
942	}
943	if (defined $o->fullname) {
944	    open(my $fh, '>', $o->fullname) or die "Can't write to DESC: $!";
945	    if (defined $comment) {
946	    	print $fh $subst->do($comment), "\n";
947	    }
948	    if ($opt_d =~ /^\-(.*)$/o) {
949		print $fh $1, "\n";
950	    } else {
951		$subst->copy_fh($opt_d, $fh);
952	    }
953	    if (defined $comment) {
954		if ($subst->empty('MAINTAINER')) {
955			$state->errsay("no MAINTAINER");
956		} else {
957			print $fh "\n", $subst->do('Maintainer: ${MAINTAINER}'), "\n";
958		}
959		if (!$subst->empty('HOMEPAGE')) {
960			print $fh "\n", $subst->do('WWW: ${HOMEPAGE}'), "\n";
961		}
962	    }
963	    close($fh);
964	}
965}
966
967sub add_signature
968{
969	my ($self, $plist, $cert, $privkey) = @_;
970
971	require OpenBSD::x509;
972
973	my $sig = OpenBSD::PackingElement::DigitalSignature->new_x509;
974	$sig->add_object($plist);
975	$sig->{b64sig} = OpenBSD::x509::compute_signature($plist,
976	    $cert, $privkey);
977}
978
979sub create_archive
980{
981	my ($self, $state, $filename, $dir) = @_;
982	open(my $fh, "|-", OpenBSD::Paths->gzip, "-f", "-o", $filename);
983	return  OpenBSD::Ustar->new($fh, $state, $dir);
984}
985
986sub sign_existing_package
987{
988	my ($self, $state, $pkgname, $cert, $privkey) = @_;
989
990
991	my $true_package = $state->repo->find($pkgname);
992	$state->fatal("No such package #1", $pkgname) unless $true_package;
993	my $dir = $true_package->info;
994	my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
995	$plist->set_infodir($dir);
996	$self->add_signature($plist, $cert, $privkey);
997	$plist->save;
998	my $tmp = OpenBSD::Temp::permanent_file(".", "pkg");
999	my $wrarc = $self->create_archive($state, $tmp, ".");
1000	$plist->copy_over($wrarc, $true_package);
1001	$wrarc->close;
1002	$true_package->wipe_info;
1003	unlink($plist->pkgname.".tgz");
1004	rename($tmp, $plist->pkgname.".tgz") or
1005	    $state->fatal("Can't create final signed package: #1", $!);
1006}
1007
1008sub add_extra_info
1009{
1010	my ($self, $plist, $state) = @_;
1011
1012	my $subst = $state->{subst};
1013	my $fullpkgpath = $subst->value('FULLPKGPATH');
1014	my $cdrom = $subst->value('PERMIT_PACKAGE_CDROM') ||
1015	    $subst->value('CDROM');;
1016	my $ftp = $subst->value('PERMIT_PACKAGE_FTP') ||
1017	    $subst->value('FTP');
1018	if (defined $fullpkgpath || defined $cdrom || defined $ftp) {
1019		$fullpkgpath //= '';
1020		$cdrom //= 'no';
1021		$ftp //= 'no';
1022		$cdrom = 'yes' if $cdrom =~ m/^yes$/io;
1023		$ftp = 'yes' if $ftp =~ m/^yes$/io;
1024
1025		OpenBSD::PackingElement::ExtraInfo->add($plist,
1026		    $fullpkgpath, $cdrom, $ftp);
1027	} else {
1028		$state->errsay("Package without FULLPKGPATH");
1029	}
1030}
1031
1032sub add_elements
1033{
1034	my ($self, $plist, $state) = @_;
1035
1036	my $subst = $state->{subst};
1037	add_description($state, $plist, DESC, $state->opt('d'));
1038	add_special_file($subst, $plist, DISPLAY, $state->opt('M'));
1039	add_special_file($subst, $plist, UNDISPLAY, $state->opt('U'));
1040	for my $d (sort keys %{$state->{dependencies}}) {
1041		OpenBSD::PackingElement::Dependency->add($plist, $d);
1042	}
1043
1044	for my $w (sort keys %{$state->{wantlib}}) {
1045		OpenBSD::PackingElement::Wantlib->add($plist, $w);
1046	}
1047
1048	if (defined $state->opt('A')) {
1049		OpenBSD::PackingElement::Arch->add($plist, $state->opt('A'));
1050	}
1051
1052	if (defined $state->opt('L')) {
1053		OpenBSD::PackingElement::LocalBase->add($plist, $state->opt('L'));
1054	}
1055	$self->add_extra_info($plist, $state);
1056}
1057
1058sub cant_read_fragment
1059{
1060	my ($self, $state, $frag) = @_;
1061	$state->fatal("can't read packing-list #1", $frag);
1062}
1063
1064sub read_all_fragments
1065{
1066	my ($self, $state, $plist) = @_;
1067
1068	if (defined $state->{prefix}) {
1069		OpenBSD::PackingElement::Cwd->add($plist, $state->{prefix});
1070	} else {
1071		$state->usage("Prefix required");
1072	}
1073	for my $contentsfile (@{$state->{contents}}) {
1074		$self->read_fragments($state, $plist, $contentsfile) or
1075		    $self->cant_read_fragment($state, $contentsfile);
1076	}
1077}
1078
1079sub create_plist
1080{
1081	my ($self, $state, $pkgname) = @_;
1082
1083	my $plist = OpenBSD::PackingList->new;
1084
1085	if ($pkgname =~ m|([^/]+)$|o) {
1086		$pkgname = $1;
1087		$pkgname =~ s/\.tgz$//o;
1088	}
1089	$plist->set_pkgname($pkgname);
1090	$state->say("Creating package #1", $pkgname)
1091	    if !(defined $state->opt('q')) && $state->opt('v');
1092	if (!$state->opt('q')) {
1093		$plist->set_infodir(OpenBSD::Temp->dir);
1094	}
1095
1096	$self->add_elements($plist, $state);
1097	unless (defined $state->opt('q') && defined $state->opt('n')) {
1098		$state->set_status("reading plist");
1099	}
1100	$self->read_all_fragments($state, $plist);
1101	return $plist;
1102}
1103
1104sub make_plist_with_sum
1105{
1106	my ($self, $state, $plist) = @_;
1107	my $p2 = OpenBSD::PackingList->new;
1108	$state->progress->visit_with_count($plist, 'makesum_plist', $p2, $state);
1109	$p2->set_infodir($plist->infodir);
1110	return $p2;
1111}
1112
1113sub read_existing_plist
1114{
1115	my ($self, $state, $contents) = @_;
1116
1117	my $plist = OpenBSD::PackingList->new;
1118	if (-d $contents && -f $contents.'/'.CONTENTS) {
1119		$plist->set_infodir($contents);
1120		$contents .= '/'.CONTENTS;
1121	} else {
1122		$plist->set_infodir(dirname($contents));
1123	}
1124	$plist->fromfile($contents) or
1125	    $state->fatal("can't read packing-list #1", $contents);
1126	return $plist;
1127}
1128
1129sub create_package
1130{
1131	my ($self, $state, $plist, $wname) = @_;
1132
1133	$state->say("Creating gzip'd tar ball in '#1'", $wname)
1134	    if $state->opt('v');
1135	my $h = sub {
1136		unlink $wname;
1137		my $caught = shift;
1138		$SIG{$caught} = 'DEFAULT';
1139		kill $caught, $$;
1140	};
1141
1142	local $SIG{'INT'} = $h;
1143	local $SIG{'QUIT'} = $h;
1144	local $SIG{'HUP'} = $h;
1145	local $SIG{'KILL'} = $h;
1146	local $SIG{'TERM'} = $h;
1147	$state->{archive} = $self->create_archive($state, $wname,
1148	    $plist->infodir);
1149	$state->set_status("archiving");
1150	$state->progress->visit_with_size($plist, 'create_package', $state);
1151	$state->end_status;
1152	$state->{archive}->close;
1153	if ($state->{bad}) {
1154		unlink($wname);
1155		exit(1);
1156	}
1157}
1158
1159sub show_bad_symlinks
1160{
1161	my ($self, $state) = @_;
1162	for my $dest (sort keys %{$state->{bad_symlinks}}) {
1163		$state->errsay("Warning: symlink(s) point to non-existent #1",
1164		    $dest);
1165		for my $link (@{$state->{bad_symlinks}{$dest}}) {
1166			$state->errsay("\t#1", $link);
1167		}
1168	}
1169}
1170
1171sub check_dependencies
1172{
1173	my ($self, $plist, $state) = @_;
1174
1175	my $solver = OpenBSD::Dependencies::CreateSolver->new($plist);
1176
1177	# look for libraries in the "real" tree
1178	$state->{destdir} = '/';
1179
1180	$solver->solve_all_depends($state);
1181	if (!$solver->solve_wantlibs($state, 1)) {
1182		$state->{bad}++;
1183	}
1184}
1185
1186sub finish_manpages
1187{
1188	my ($self, $state, $plist) = @_;
1189	$plist->grab_manpages($state);
1190	if (defined $state->{manpages}) {
1191		$state->{v} ++;
1192
1193		require OpenBSD::Makewhatis;
1194
1195		try {
1196			OpenBSD::Makewhatis::scan_manpages($state->{manpages},
1197			    $state);
1198		} catchall {
1199			$state->errsay("Error in makewhatis: #1", $_);
1200		};
1201		$state->{v} --;
1202	}
1203
1204	if (defined $state->{mandir}) {
1205		require File::Path;
1206		File::Path::remove_tree($state->{mandir});
1207	}
1208}
1209
1210sub parse_and_run
1211{
1212	my ($self, $cmd) = @_;
1213
1214	my ($cert, $privkey);
1215	my $regen_package = 0;
1216	my $sign_only = 0;
1217
1218	my $state = OpenBSD::PkgCreate::State->new($cmd);
1219	$state->handle_options;
1220
1221	if (@ARGV == 0) {
1222		$regen_package = 1;
1223	} elsif (@ARGV != 1) {
1224		if (defined $state->{contents} ||
1225		    !defined $state->{signature_params}) {
1226			$state->usage("Exactly one single package name is required: #1", join(' ', @ARGV));
1227		}
1228	}
1229
1230	try {
1231	if (defined $state->{signature_params}) {
1232		my @p = @{$state->{signature_params}};
1233		if (@p != 3 || $p[0] ne 'x509' || !-f $p[1] || !-f $p[2]) {
1234			$state->usage("Signature only works as -s x509 -s cert -s privkey");
1235		}
1236		$cert = $p[1];
1237		$privkey = $p[2];
1238	}
1239
1240	if (defined $state->opt('Q')) {
1241		$state->{opt}{q} = 1;
1242	}
1243
1244	if (!defined $state->{contents}) {
1245		if (defined $cert) {
1246			$sign_only = 1;
1247		} else {
1248			$state->usage("Packing-list required");
1249		}
1250	}
1251
1252	my $plist;
1253	if ($regen_package) {
1254		if (!defined $state->{contents} || @{$state->{contents}} > 1) {
1255			$state->usage("Exactly one single packing-list is required");
1256		}
1257		$plist = $self->read_existing_plist($state,
1258		    $state->{contents}[0]);
1259	} elsif ($sign_only) {
1260		if ($state->not) {
1261			$state->fatal("can't pretend to sign existing packages");
1262		}
1263		for my $pkgname (@ARGV) {
1264			$self->sign_existing($state, $pkgname, $cert, $privkey);
1265		}
1266		return 0;
1267	} else {
1268		$plist = $self->create_plist($state, $ARGV[0]);
1269	}
1270
1271
1272	$plist->discover_directories($state);
1273	unless (defined $state->opt('q') && defined $state->opt('n')) {
1274		$state->set_status("checking dependencies");
1275		$self->check_dependencies($plist, $state);
1276		$state->set_status("checksumming");
1277		if ($regen_package) {
1278			$state->progress->visit_with_count($plist, 'verify_checksum', $state);
1279		} else {
1280			$plist = $self->make_plist_with_sum($state, $plist);
1281		}
1282		$self->show_bad_symlinks($state);
1283		$state->end_status;
1284	}
1285
1286	if (!defined $plist->pkgname) {
1287		$state->fatal("can't write unnamed packing-list");
1288	}
1289
1290	if (defined $state->opt('q')) {
1291		if (defined $state->opt('Q')) {
1292			$plist->print_file;
1293		} else {
1294			$plist->write(\*STDOUT);
1295		}
1296		return 0 if defined $state->opt('n');
1297	}
1298
1299	if ($plist->{deprecated}) {
1300		$state->fatal("found obsolete constructs");
1301	}
1302
1303	$plist->avert_duplicates_and_other_checks($state);
1304	if ($state->{has_no_default_conflict} && !$state->{has_conflict}) {
1305		$state->errsay("Warning: \@option no-default-conflict without \@conflict");
1306	}
1307	$state->{stash} = {};
1308
1309	if ($state->{bad} && !$state->defines('REGRESSION_TESTING')) {
1310		$state->fatal("can't continue");
1311	}
1312	$state->{bad} = 0;
1313
1314	if (defined $cert) {
1315		$self->add_signature($plist, $cert, $privkey);
1316		$plist->save if $regen_package;
1317	}
1318
1319	my $wname;
1320	if ($regen_package) {
1321		$wname = $plist->pkgname.".tgz";
1322	} else {
1323		$plist->save or $state->fatal("can't write packing-list");
1324		$wname = $ARGV[0];
1325	}
1326
1327	if ($state->opt('n')) {
1328		$state->{archive} = OpenBSD::Ustar->new(undef, $state,
1329		    $plist->infodir);
1330		$plist->pretend_to_archive($state);
1331	} else {
1332		$self->create_package($state, $plist, $wname);
1333	}
1334	$self->finish_manpages($state, $plist);
1335	}catch {
1336		print STDERR "$0: $_\n";
1337		return 1;
1338	};
1339	return 0;
1340}
1341
13421;
1343