1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: PkgCreate.pm,v 1.197 2023/10/11 13:54:43 espie Exp $
4#
5# Copyright (c) 2003-2014 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 v5.36;
20
21use OpenBSD::AddCreateDelete;
22use OpenBSD::Dependencies::SolverBase;
23use OpenBSD::Signer;
24
25package OpenBSD::PkgCreate::State;
26our @ISA = qw(OpenBSD::CreateSign::State);
27
28sub init($self, @p)
29{
30	$self->{stash} = {};
31	$self->SUPER::init(@p);
32	$self->{simple_status} = 0;
33}
34
35sub stash($self, $key)
36{
37	return $self->{stash}{$key};
38}
39
40sub error($self, $msg, @p)
41{
42	$self->{bad}++;
43	$self->progress->disable;
44	# XXX the actual format is $msg.
45	$self->errsay("Error: $msg", @p);
46}
47
48sub set_status($self, $status)
49{
50	if ($self->{simple_status}) {
51		print "\n$status";
52	} else {
53		if ($self->progress->set_header($status)) {
54			$self->progress->message('');
55		} else {
56			$| = 1;
57			print "$status...";
58			$self->{simple_status} = 1;
59		}
60	}
61}
62
63sub end_status($self)
64{
65	if ($self->{simple_status}) {
66		print "\n";
67	} else {
68		$self->progress->clear;
69	}
70}
71
72sub handle_options($state)
73{
74	$state->{system_version} = 0;
75	$state->{opt} = {
76	    'f' =>
77		    sub($opt) {
78			    push(@{$state->{contents}}, $opt);
79		    },
80	    'p' =>
81		    sub($opt) {
82			    $state->{prefix} = $opt;
83		    },
84	    'P' => sub($opt) {
85			    $state->{dependencies}{$opt} = 1;
86		    },
87	    'V' => sub($opt) {
88			    if ($opt !~ m/^\d+$/) {
89			    	$state->usage("-V option requires a number");
90			    }
91			    $state->{system_version} += $opt;
92		    },
93	    'w' => sub($opt) {
94			    $state->{libset}{$opt} = 1;
95		    },
96	    'W' => sub($opt) {
97			    $state->{wantlib}{$opt} = 1;
98		    },
99	};
100	$state->{no_exports} = 1;
101	$state->SUPER::handle_options('p:f:d:M:U:u:A:B:P:V:w:W:qQS',
102	    '[-nQqvSx] [-A arches] [-B pkg-destdir] [-D name[=value]]',
103	    '[-L localbase] [-M displayfile] [-P pkg-dependency]',
104	    '[-U undisplayfile] [-u userlist] [-V n] [-W wantedlib]',
105	    '[-w libset] [-d desc -D COMMENT=value -f packinglist -p prefix]',
106	    'pkg-name');
107
108	my $base = '/';
109	if (defined $state->opt('B')) {
110		$base = $state->opt('B');
111	}
112
113	$state->{base} = $base;
114	# switch to silent mode for *any* introspection option
115	$state->{silent} = defined $state->opt('n') || defined $state->opt('q')
116	    || defined $state->opt('Q') || defined $state->opt('S');
117	if (defined $state->opt('u')) {
118		$state->{userlist} = $state->parse_userdb($state->opt('u'));
119	}
120	$state->{wrkobjdir} = $state->defines('WRKOBJDIR');
121	$state->{fullpkgpath} = $state->{subst}->value('FULLPKGPATH') // '';
122	$state->{no_ts_in_plist} = $state->defines('NO_TS_IN_PLIST');
123}
124
125sub parse_userdb($self, $fname)
126{
127	my $result = {};
128	my $bad = 0;
129	open(my $fh, '<', $fname) or $bad = 1;
130	if ($bad) {
131		$self->error("Can't open #1: #2", $fname, $!);
132		return;
133	}
134	# skip header
135	my $separator_found = 0;
136	while (<$fh>) {
137		if (m/^\-\-\-\-\-\-\-/) {
138			$separator_found = 1;
139			last;
140		}
141	}
142	if (!$separator_found) {
143		$self->error("File #1 does not appear to be a user.db", $fname);
144		return;
145	}
146	# record ids and error out on duplicates
147	my $known = {};
148	while (<$fh>) {
149		next if m/^\#/;
150		chomp;
151		my @l = split(/\s+/, $_);
152		if (@l < 3 || $l[0] !~ m/^\d+$/ || $l[1] !~ m/^_/) {
153			$self->error("Bad line: #1 at #2 of #3",
154			    $_, $., $fname);
155			next;
156		}
157		if (defined $known->{$l[0]}) {
158			$self->error("Duplicate id: #1 in #2",
159			    $l[0], $fname);
160			next;
161		}
162		$known->{$l[0]} = 1;
163		$result->{$l[1]} = $l[0];
164	}
165	return $result;
166}
167
168package OpenBSD::PkgCreate;
169
170use OpenBSD::PackingList;
171use OpenBSD::PackageInfo;
172use OpenBSD::Getopt;
173use OpenBSD::Temp;
174use OpenBSD::Error;
175use OpenBSD::Ustar;
176use OpenBSD::ArcCheck;
177use OpenBSD::Paths;
178use File::Basename;
179
180# Extra stuff needed to archive files
181package OpenBSD::PackingElement;
182sub create_package($self, $state)
183{
184	$self->archive($state);
185	if ($state->verbose) {
186		$self->comment_create_package($state);
187	}
188}
189
190sub pretend_to_archive($self,$state)
191{
192	$self->comment_create_package($state);
193}
194
195# $self->record_digest($original, $entries, $new, $tail)
196sub record_digest($, $, $, $, $) {}
197# $self->stub_digest($ordered)
198sub stub_digest($, $) {}
199# $self->archive($state)
200sub archive($, $) {}
201# $self->comment_create_package($state)
202sub comment_create_package($, $) {}
203# $self->grab_manpages($state)
204sub grab_manpages($, $) {}
205# $self->register_for_archival($state)
206sub register_for_archival($, $) {}
207
208# $self->print_file
209sub print_file($) {}
210
211sub avert_duplicates_and_other_checks($self, $state)
212{
213	return unless $self->NoDuplicateNames;
214	my $n = $self->fullname;
215	if (defined $state->stash($n)) {
216		$state->error("duplicate item in packing-list #1", $n);
217	}
218	$state->{stash}{$n} = 1;
219}
220
221sub makesum_plist($self, $state, $plist)
222{
223	$self->add_object($plist);
224}
225
226# $self->verify_checksum($state)
227sub verify_checksum($, $)
228{
229}
230
231sub register_forbidden($self, $state)
232{
233	if ($self->is_forbidden) {
234		push(@{$state->{forbidden}}, $self);
235	}
236}
237
238sub is_forbidden($) { 0 }
239sub resolve_link($filename, $base, $level = 0)
240{
241	if (-l $filename) {
242		my $l = readlink($filename);
243		if ($level++ > 14) {
244			return undef;
245		}
246		if ($l =~ m|^/|) {
247			return $base.resolve_link($l, $base, $level);
248		} else {
249			return resolve_link(File::Spec->catfile(File::Basename::dirname($filename),$l), $base, $level);
250		}
251	} else {
252		return $filename;
253	}
254}
255
256sub compute_checksum($self, $result, $state, $base)
257{
258	my $name = $self->fullname;
259	my $fname = $name;
260	my $okay = 1;
261	if (defined $base) {
262		$fname = $base.$fname;
263	}
264	for my $field (qw(symlink link size ts)) {  # md5
265		if (defined $result->{$field}) {
266			$state->error("User tried to define @#1 for #2",
267			    $field, $fname);
268			$okay = 0;
269		}
270	}
271	if (defined $self->{wtempname}) {
272		$fname = $self->{wtempname};
273	}
274	if (-l $fname) {
275		if (!defined $base) {
276			$state->error("special file #1 can't be a symlink",
277			    $self->stringize);
278			$okay = 0;
279		}
280		my $value = readlink $fname;
281		my $chk = resolve_link($fname, $base);
282		$fname =~ s|^//|/|; # cosmetic
283		if (!defined $chk) {
284			$state->error("bogus symlink: #1 (too deep)", $fname);
285			$okay = 0;
286		} elsif (!-e $chk) {
287			push(@{$state->{bad_symlinks}{$chk}}, $fname);
288		}
289		if (defined $state->{wrkobjdir} &&
290		    $value =~ m/^\Q$state->{wrkobjdir}\E\//) {
291		    	$state->error(
292			    "bad symlink: #1 (points into WRKOBJDIR)",
293			    $fname);
294			$okay = 0;
295		}
296		$result->make_symlink($value);
297	} elsif (-f _) {
298		my ($dev, $ino, $size, $mtime) = (stat _)[0,1,7, 9];
299		# XXX when rebuilding packages, tied updates can produce
300		# spurious hardlinks. We also refer to the installed plist
301		# we're rebuilding to know if we must checksum.
302		if (defined $state->stash("$dev/$ino") && !defined $self->{d}) {
303			$result->make_hardlink($state->stash("$dev/$ino"));
304		} else {
305			$state->{stash}{"$dev/$ino"} = $name;
306			$result->add_digest($self->compute_digest($fname))
307			    unless $state->{bad};
308			$result->add_size($size);
309			unless ($state->{no_ts_in_plist}) {
310				$result->add_timestamp($mtime);
311			}
312		}
313	} elsif (-d _) {
314		$state->error("#1 should be a file and not a directory", $fname);
315		$okay = 0;
316	} else {
317		$state->error("#1 does not exist", $fname);
318		$okay = 0;
319	}
320	return $okay;
321}
322
323sub makesum_plist_with_base($self, $plist, $state, $base)
324{
325	if ($self->compute_checksum($self, $state, $base)) {
326		$self->add_object($plist);
327	}
328}
329
330sub verify_checksum_with_base($self, $state, $base)
331{
332	my $check = ref($self)->new($self->name);
333	if (!$self->compute_checksum($check, $state, $base)) {
334		return;
335	}
336
337	for my $field (qw(symlink link size)) {  # md5
338		if ((defined $check->{$field} && defined $self->{$field} &&
339		    $check->{$field} ne $self->{$field}) ||
340		    (defined $check->{$field} xor defined $self->{$field})) {
341		    	$state->error("#1 inconsistency for #2",
342			    $field, $self->fullname);
343		}
344	}
345	if ((defined $check->{d} && defined $self->{d} &&
346	    !$check->{d}->equals($self->{d})) ||
347	    (defined $check->{d} xor defined $self->{d})) {
348	    	$state->error("checksum inconsistency for #1",
349		    $self->fullname);
350	}
351}
352
353
354sub prepare_for_archival($self, $state)
355{
356	my $o = $state->{archive}->prepare_long($self);
357	if (!$o->verify_modes($self)) {
358		$state->error("modes don't match for #1", $self->fullname);
359	}
360	if (!$o->is_allowed) {
361		$state->error("can't package #1", $self->fullname);
362	}
363	return $o;
364}
365
366# $self->discover_directories($state)
367sub discover_directories($, $)
368{
369}
370
371# $self->check_version($state, $unsubst)
372sub check_version($, $, $)
373{
374}
375
376
377# Virtual PackingElements related to chunked gzips and LRU caching.
378# see save_history
379package OpenBSD::PackingElement::StreamMarker;
380our @ISA = qw(OpenBSD::PackingElement::Meta);
381sub new($class)
382{
383	bless {}, $class;
384}
385
386sub comment_create_package($self, $state)
387{
388	$self->SUPER::comment_create_package($state);
389	$state->say("Gzip: next chunk");
390}
391
392sub archive($self, $state)
393{
394	$state->new_gstream;
395}
396
397package OpenBSD::PackingElement::LRUFrontier;
398our @ISA = qw(OpenBSD::PackingElement::Meta);
399sub new($class)
400{
401	bless {}, $class;
402}
403
404sub comment_create_package($self, $state)
405{
406	$self->SUPER::comment_create_package($state);
407	$state->say("LRU: end of modified files");
408}
409
410package OpenBSD::PackingElement::RcScript;
411sub set_destdir($self, $state)
412{
413	if ($self->name =~ m/^\//) {
414		$state->{archive}->set_destdir($state->{base});
415	} else {
416		$self->SUPER::set_destdir($state);
417	}
418}
419
420package OpenBSD::PackingElement::SpecialFile;
421sub record_digest($self, $, $, $new, $)
422{
423	push(@$new, $self);
424}
425
426sub stub_digest($self, $ordered)
427{
428	push(@$ordered, $self);
429}
430
431sub archive	# forwarder
432{
433	&OpenBSD::PackingElement::FileBase::archive;
434}
435
436sub pretend_to_archive	# forwarder
437{
438	&OpenBSD::PackingElement::FileBase::pretend_to_archive;
439}
440
441sub set_destdir($, $)
442{
443}
444
445sub may_add($class, $subst, $plist, $opt)
446{
447	if (defined $opt) {
448		my $o = $class->add($plist);
449		$subst->copy($opt, $o->fullname) if defined $o->fullname;
450	}
451}
452
453sub comment_create_package($self, $state)
454{
455	$state->say("Adding #1", $self->name);
456}
457
458sub makesum_plist($self, $state, $plist)
459{
460	$self->makesum_plist_with_base($plist, $state, undef);
461}
462
463sub verify_checksum($self, $state)
464{
465	$self->verify_checksum_with_base($state, undef);
466}
467
468sub prepare_for_archival($self, $state)
469{
470	my $o = $state->{archive}->prepare_long($self);
471	$o->{uname} = 'root';
472	$o->{gname} = 'wheel';
473	$o->{uid} = 0;
474	$o->{gid} = 0;
475	$o->{mode} &= 0555; # zap all write and suid modes
476	return $o;
477}
478
479sub forbidden($) { 1 }
480
481sub register_for_archival($self, $ordered)
482{
483	push(@$ordered, $self);
484}
485
486# override for CONTENTS: we cannot checksum this.
487package OpenBSD::PackingElement::FCONTENTS;
488sub makesum_plist($, $, $)
489{
490}
491
492sub verify_checksum($, $)
493{
494}
495
496sub archive($self, $state)
497{
498	$self->SUPER::archive($state);
499}
500
501sub comment_create_package($self, $state)
502{
503	$self->SUPER::comment_create_package($state);
504}
505
506sub stub_digest($self, $ordered)
507{
508	push(@$ordered, $self);
509}
510
511package OpenBSD::PackingElement::Cwd;
512sub archive($, $)
513{
514}
515
516sub pretend_to_archive($self, $state)
517{
518	$self->comment_create_package($state);
519}
520
521sub comment_create_package($self, $state)
522{
523	$state->say("Cwd: #1", $self->name);
524}
525
526package OpenBSD::PackingElement::FileBase;
527
528sub record_digest($self, $original, $entries, $new, $tail)
529{
530	if (defined $self->{d}) {
531		my $k = $self->{d}->stringize;
532		push(@{$entries->{$k}}, $self);
533		push(@$original, $k);
534	} else {
535		push(@$tail, $self);
536	}
537}
538
539sub register_for_archival($self, $ordered)
540{
541	push(@$ordered, $self);
542}
543
544sub set_destdir($self, $state)
545{
546	$state->{archive}->set_destdir($state->{base}."/".$self->cwd);
547}
548
549sub archive($self, $state)
550{
551	$self->set_destdir($state);
552	my $o = $self->prepare_for_archival($state);
553
554	$o->write unless $state->{bad};
555}
556
557sub pretend_to_archive($self, $state)
558{
559	$self->set_destdir($state);
560	$self->prepare_for_archival($state);
561	$self->comment_create_package($state);
562}
563
564sub comment_create_package($self, $state)
565{
566	$state->say("Adding #1", $self->name);
567}
568
569sub print_file($item)
570{
571	say '@', $item->keyword, " ", $item->fullname;
572}
573
574sub makesum_plist($self, $state, $plist)
575{
576	$self->makesum_plist_with_base($plist, $state, $state->{base});
577}
578
579sub verify_checksum($self, $state)
580{
581	$self->verify_checksum_with_base($state, $state->{base});
582}
583
584package OpenBSD::PackingElement::Dir;
585sub discover_directories($self, $state)
586{
587	$state->{known_dirs}->{$self->fullname} = 1;
588}
589
590package OpenBSD::PackingElement::InfoFile;
591sub makesum_plist($self, $state, $plist)
592{
593	$self->SUPER::makesum_plist($state, $plist);
594	my $fname = $self->fullname;
595	for (my $i = 1; ; $i++) {
596		if (-e "$state->{base}/$fname-$i") {
597			my $e = OpenBSD::PackingElement::File->add($plist,
598			    $self->name."-".$i);
599			$e->compute_checksum($e, $state, $state->{base});
600		} else {
601			last;
602		}
603	}
604}
605
606package OpenBSD::PackingElement::Manpage;
607use File::Basename;
608
609sub grab_manpages($self, $state)
610{
611	my $filename;
612	if ($self->{wtempname}) {
613		$filename = $self->{wtempname};
614	} else {
615		$filename = $state->{base}.$self->fullname;
616	}
617	push(@{$state->{manpages}}, $filename);
618}
619
620sub format_source_page($self, $state, $plist)
621{
622	if ($state->{subst}->empty("USE_GROFF") || !$self->is_source) {
623		return 0;
624	}
625	my $dest = $self->source_to_dest;
626	my $fullname = $self->cwd."/".$dest;
627	my $d = dirname($fullname);
628	$state->{mandir} //= OpenBSD::Temp::permanent_dir(
629	    $ENV{TMPDIR} // '/tmp', "manpage") or
630	    	$state->error(OpenBSD::Temp->last_error) and
631		return 0;
632	my $tempname = $state->{mandir}.$fullname;
633	require File::Path;
634	File::Path::make_path($state->{mandir}.$d);
635	open my $fh, ">", $tempname;
636	if (!defined $fh) {
637	    $state->error("can't create #1: #2", $tempname, $!);
638	    return 0;
639    	}
640	chmod 0444, $fh;
641	if (-d $state->{base}.$d) {
642		undef $d;
643	}
644	if (!$self->format($state, $tempname, $fh)) {
645		return 0;
646	}
647	if (-z $tempname) {
648		$state->errsay("groff produced empty result for #1", $dest);
649		$state->errsay("\tkeeping source manpage");
650		return 0;
651	}
652	if (defined $d && !$state->{known_dirs}->{$d}) {
653		$state->{known_dirs}->{$d} = 1;
654		OpenBSD::PackingElement::Dir->add($plist, dirname($dest));
655	}
656	my $e = OpenBSD::PackingElement::Manpage->add($plist, $dest);
657	$e->{wtempname} = $tempname;
658	$e->compute_checksum($e, $state, $state->{base});
659	return 1;
660}
661
662sub makesum_plist($self, $state, $plist)
663{
664	if (!$self->format_source_page($state, $plist)) {
665		$self->SUPER::makesum_plist($state, $plist);
666	}
667}
668
669
670package OpenBSD::PackingElement::Depend;
671sub avert_duplicates_and_other_checks($self, $state)
672{
673	if (!$self->spec->is_valid) {
674		$state->error("invalid \@#1 #2 in packing-list",
675		    $self->keyword, $self->stringize);
676	}
677	$self->SUPER::avert_duplicates_and_other_checks($state);
678}
679
680sub forbidden($) { 1 }
681
682package OpenBSD::PackingElement::Conflict;
683sub avert_duplicates_and_other_checks($self, $state)
684{
685	$state->{has_conflict}++;
686	OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks($self, $state);
687}
688
689package OpenBSD::PackingElement::AskUpdate;
690sub avert_duplicates_and_other_checks	# forwarder
691{
692	&OpenBSD::PackingElement::Depend::avert_duplicates_and_other_checks;
693}
694
695package OpenBSD::PackingElement::Dependency;
696sub avert_duplicates_and_other_checks($self, $state)
697{
698	$self->SUPER::avert_duplicates_and_other_checks($state);
699
700	my @issues = OpenBSD::PackageName->from_string($self->{def})->has_issues;
701	if (@issues > 0) {
702		$state->error("\@#1 #2\n  #3, #4",
703		    $self->keyword, $self->stringize,
704		    $self->{def}, join(' ', @issues));
705	} elsif ($self->spec->is_valid) {
706		my @m = $self->spec->filter($self->{def});
707		if (@m == 0) {
708			$state->error(
709			    "\@#1 #2\n".
710			    "  pattern #3 doesn't match default #4\n",
711			    $self->keyword, $self->stringize,
712			    $self->{pattern}, $self->{def});
713		}
714	}
715}
716
717package OpenBSD::PackingElement::Name;
718sub avert_duplicates_and_other_checks($self, $state)
719{
720	my @issues = OpenBSD::PackageName->from_string($self->name)->has_issues;
721	if (@issues > 0) {
722		$state->error("bad package name #1: ", $self->name,
723		    join(' ', @issues));
724	}
725	$self->SUPER::avert_duplicates_and_other_checks($state);
726}
727
728sub forbidden($) { 1 }
729
730package OpenBSD::PackingElement::NoDefaultConflict;
731sub avert_duplicates_and_other_checks($self, $state)
732{
733	$state->{has_no_default_conflict}++;
734}
735
736package OpenBSD::PackingElement::NewAuth;
737sub avert_duplicates_and_other_checks($self, $state)
738{
739	my $userlist = $state->{userlist};
740	if (defined $userlist) {
741		my $entry = $userlist->{$self->{name}};
742		my $id = $self->id;
743		$id =~ s/^!//;
744		if (!defined $entry) {
745			$state->error("#1 #2: not registered in #3",
746			    $self->keyword, $self->{name}, $state->opt('u'));
747		} elsif ($entry != $id) {
748			$state->error(
749			    "#1 #2: id mismatch in #3 (#4 vs #5)",
750			    $self->keyword, $self->{name}, $state->opt('u'),
751			    $entry, $id);
752		}
753	}
754	$self->SUPER::avert_duplicates_and_other_checks($state);
755}
756
757package OpenBSD::PackingElement::NewUser;
758sub id($self)
759{
760	return $self->{uid};
761}
762
763package OpenBSD::PackingElement::NewGroup;
764sub id($self)
765{
766	return $self->{gid};
767}
768
769package OpenBSD::PackingElement::Lib;
770sub check_version($self, $state, $unsubst)
771{
772	my @l  = $self->parse($self->name);
773	if (defined $l[0]) {
774		if (!$unsubst =~ m/\$\{LIB$l[0]_VERSION\}/) {
775			$state->error(
776			    "Incorrectly versioned shared library: #1",
777			    $unsubst);
778		}
779	} else {
780		$state->error("Invalid shared library #1", $unsubst);
781	}
782	$state->{has_libraries} = 1;
783}
784
785package OpenBSD::PackingElement::DigitalSignature;
786sub is_forbidden($) { 1 }
787
788package OpenBSD::PackingElement::Signer;
789sub is_forbidden($) { 1 }
790
791package OpenBSD::PackingElement::ExtraInfo;
792sub is_forbidden($) { 1 }
793
794package OpenBSD::PackingElement::ManualInstallation;
795sub is_forbidden($) { 1 }
796
797package OpenBSD::PackingElement::Firmware;
798sub is_forbidden($) { 1 }
799
800package OpenBSD::PackingElement::Url;
801sub is_forbidden($) { 1 }
802
803package OpenBSD::PackingElement::Arch;
804sub is_forbidden($) { 1 }
805
806package OpenBSD::PackingElement::LocalBase;
807sub is_forbidden($) { 1 }
808
809package OpenBSD::PackingElement::Version;
810sub is_forbidden($) { 1 }
811
812# put together file and filename, in order to handle fragments simply
813package MyFile;
814sub new($class, $filename)
815{
816	open(my $fh, '<', $filename) or return undef;
817
818	bless { fh => $fh, name => $filename }, (ref($class) || $class);
819}
820
821sub readline($self)
822{
823	return readline $self->{fh};
824}
825
826sub name($self)
827{
828	return $self->{name};
829}
830
831sub close($self)
832{
833	close($self->{fh});
834}
835
836sub deduce_name($self, $frag, $not, $p, $state)
837{
838	my $o = $self->name;
839	my $noto = $o;
840	my $nofrag = "no-$frag";
841
842	$o =~ s/PFRAG\./PFRAG.$frag-/o or
843	    $o =~ s/PLIST/PFRAG.$frag/o;
844
845	$noto =~ s/PFRAG\./PFRAG.no-$frag-/o or
846	    $noto =~ s/PLIST/PFRAG.no-$frag/o;
847	unless (-e $o or -e $noto) {
848		$p->missing_fragments($state, $frag, $o, $noto);
849		return;
850	}
851	if ($not) {
852		return $noto if -e $noto;
853    	} else {
854		return $o if -e $o;
855	}
856	return;
857}
858
859# special solver class for PkgCreate
860package OpenBSD::Dependencies::CreateSolver;
861our @ISA = qw(OpenBSD::Dependencies::SolverBase);
862
863# we need to "hack" a special set
864sub new($class, $plist)
865{
866	bless { set => OpenBSD::PseudoSet->new($plist),
867	    old_dependencies => {}, bad => [] }, $class;
868}
869
870sub solve_all_depends($solver, $state)
871{
872	$solver->{tag_finder} = OpenBSD::lookup::tag->new($solver, $state);
873	while (1) {
874		my @todo = $solver->solve_depends($state);
875		if (@todo == 0) {
876			return;
877		}
878		if ($solver->solve_wantlibs($state, 0)) {
879			return;
880		}
881		$solver->{set}->add_new(@todo);
882	}
883}
884
885sub solve_wantlibs($solver, $state, $final)
886{
887	my $okay = 1;
888	my $lib_finder = OpenBSD::lookup::library->new($solver);
889	my $h = $solver->{set}{new}[0];
890	for my $lib (@{$h->{plist}{wantlib}}) {
891		$solver->{localbase} = $h->{plist}->localbase;
892		next if $lib_finder->lookup($solver,
893		    $solver->{to_register}{$h}, $state,
894		    $lib->spec);
895		$okay = 0;
896		$state->shlibs->report_problem($lib->spec) if $final;
897	}
898	if (!$okay && $final) {
899		$solver->dump($state);
900		$lib_finder->dump($state);
901	}
902	return $okay;
903}
904
905sub really_solve_dependency($self, $state, $dep, $package)
906{
907	$state->progress->message($dep->{pkgpath});
908
909	my $v;
910
911	# look in installed packages, but only for different paths
912	my $p1 = $dep->{pkgpath};
913	my $p2 = $state->{fullpkgpath};
914	$p1 =~ s/\,.*//;
915	$p2 =~ s/\,.*//;
916	$p2 =~ s,^debug/,,;
917	if ($p1 ne $p2) {
918		# look in installed packages
919		$v = $self->find_dep_in_installed($state, $dep);
920	}
921	if (!defined $v) {
922		$v = $self->find_dep_in_self($state, $dep);
923	}
924
925	# and in portstree otherwise
926	if (!defined $v) {
927		$v = $self->solve_from_ports($state, $dep, $package);
928	}
929	return $v;
930}
931
932sub diskcachename($self, $dep)
933{
934	if ($ENV{_DEPENDS_CACHE}) {
935		my $diskcache = $dep->{pkgpath};
936		$diskcache =~ s/\//--/g;
937		return $ENV{_DEPENDS_CACHE}."/pkgcreate-".$diskcache;
938	} else {
939		return undef;
940	}
941}
942
943sub to_cache($self, $plist, $final)
944{
945	# try to cache atomically.
946	# no error if it doesn't work
947	require OpenBSD::MkTemp;
948	my ($fh, $tmp) = OpenBSD::MkTemp::mkstemp(
949	    "$ENV{_DEPENDS_CACHE}/my.XXXXXXXXXXX") or return;
950	chmod 0644, $fh;
951	$plist->write($fh);
952	close($fh);
953	rename($tmp, $final);
954	unlink($tmp);
955}
956
957sub ask_tree($self, $state, $pkgpath, $portsdir, $data, @action)
958{
959	my $make = OpenBSD::Paths->make;
960	my $errors = OpenBSD::Temp->file;
961	if (!defined $errors) {
962		$state->fatal(OpenBSD::Temp->last_error);
963	}
964	my $pid = open(my $fh, "-|");
965	if (!defined $pid) {
966		$state->fatal("cannot fork: #1", $!);
967	}
968	if ($pid == 0) {
969		$ENV{FULLPATH} = 'Yes';
970		delete $ENV{FLAVOR};
971		delete $ENV{SUBPACKAGE};
972		$ENV{SUBDIR} = $pkgpath;
973		$ENV{ECHO_MSG} = ':';
974
975		if (!chdir $portsdir) {
976			$state->errsay("Can't chdir #1: #2", $portsdir, $!);
977			exit(2);
978		}
979		open STDERR, ">>", $errors;
980		# make sure the child starts with a single identity
981		$( = $); $< = $>;
982		# XXX we're already running as ${BUILD_USER}
983		# so we can't do this again
984		push(@action, 'PORTS_PRIVSEP=No');
985		$DB::inhibit_exit = 0;
986		exec $make ('make', @action);
987	}
988	my $plist = OpenBSD::PackingList->read($fh, $data);
989	while(<$fh>) {	# XXX avoid spurious errors from child
990	}
991	close($fh);
992	if ($? != 0) {
993		$state->errsay("child running '#2' failed: #1",
994		    $state->child_error,
995		    join(' ', 'make', @action));
996		if (open my $fh, '<', $errors) {
997			while(<$fh>) {
998				$state->errprint("#1", $_);
999			}
1000			close($fh);
1001		}
1002	}
1003	unlink($errors);
1004	return $plist;
1005}
1006
1007sub really_solve_from_ports($self, $state, $dep, $portsdir)
1008{
1009	my $diskcache = $self->diskcachename($dep);
1010	my $plist;
1011
1012	if (defined $diskcache && -f $diskcache) {
1013		$plist = OpenBSD::PackingList->fromfile($diskcache);
1014	} else {
1015		$plist = $self->ask_tree($state, $dep->{pkgpath}, $portsdir,
1016		    \&OpenBSD::PackingList::PrelinkStuffOnly,
1017		    'print-plist-libs-with-depends',
1018		    'wantlib_args=no-wantlib-args');
1019		if ($? != 0 || !defined $plist->pkgname) {
1020			return undef;
1021		}
1022		if (defined $diskcache) {
1023			$self->to_cache($plist, $diskcache);
1024		}
1025	}
1026	$state->shlibs->add_libs_from_plist($plist);
1027	$self->{tag_finder}->find_in_plist($plist, $dep->{pkgpath});
1028	$self->add_dep($plist);
1029	return $plist->pkgname;
1030}
1031
1032my $cache = {};
1033
1034sub solve_from_ports($self, $state, $dep, $package)
1035{
1036	my $portsdir = $state->defines('PORTSDIR');
1037	return undef unless defined $portsdir;
1038	my $pkgname;
1039	if (defined $cache->{$dep->{pkgpath}}) {
1040		$pkgname = $cache->{$dep->{pkgpath}};
1041	} else {
1042		$pkgname = $self->really_solve_from_ports($state, $dep,
1043		    $portsdir);
1044		$cache->{$dep->{pkgpath}} = $pkgname;
1045	}
1046	if (!defined $pkgname) {
1047		$state->error("Can't obtain dependency #1 from ports tree",
1048		    $dep->{pattern});
1049		return undef;
1050	}
1051	if ($dep->spec->filter($pkgname) == 0) {
1052		$state->error("Dependency #1 doesn't match FULLPKGNAME: #2",
1053		    $dep->{pattern}, $pkgname);
1054		return undef;
1055	}
1056
1057	return $pkgname;
1058}
1059
1060# we don't want old libs
1061sub find_old_lib($, $, $, $, $)
1062{
1063	return undef;
1064}
1065
1066package OpenBSD::PseudoHandle;
1067sub new($class, $plist)
1068{
1069	bless { plist => $plist}, $class;
1070}
1071
1072sub pkgname($self)
1073{
1074	return $self->{plist}->pkgname;
1075}
1076
1077sub dependency_info($self)
1078{
1079	return $self->{plist};
1080}
1081
1082package OpenBSD::PseudoSet;
1083sub new($class, @elements)
1084{
1085	my $o = bless {}, $class;
1086	$o->add_new(@elements);
1087}
1088
1089sub add_new($self, @elements)
1090{
1091	for my $i (@elements) {
1092		push(@{$self->{new}}, OpenBSD::PseudoHandle->new($i));
1093	}
1094	return $self;
1095}
1096
1097sub newer($self)
1098{
1099	return @{$self->{new}};
1100}
1101
1102
1103sub newer_names($self)
1104{
1105	return map {$_->pkgname} @{$self->{new}};
1106}
1107
1108sub older($)
1109{
1110	return ();
1111}
1112
1113sub older_names($)
1114{
1115	return ();
1116}
1117
1118sub kept($)
1119{
1120	return ();
1121}
1122
1123sub kept_names($)
1124{
1125	return ();
1126}
1127
1128sub print($self)
1129{
1130	return $self->{new}[0]->pkgname;
1131}
1132
1133package OpenBSD::PkgCreate;
1134our @ISA = qw(OpenBSD::AddCreateDelete);
1135
1136sub handle_fragment($self, $state, $old, $not, $frag, $location)
1137{
1138	my $def = $frag;
1139	if ($state->{subst}->has_fragment($state, $def, $frag, $location)) {
1140		return undef if defined $not;
1141	} else {
1142		return undef unless defined $not;
1143	}
1144	my $newname = $old->deduce_name($frag, $not, $self, $state);
1145	if (defined $newname) {
1146		$state->set_status("switching to $newname")
1147		    unless $state->{silent};
1148		my $f = $old->new($newname);
1149		if (!defined $f) {
1150			$self->cant_read_fragment($state, $newname);
1151		} else {
1152			return $f;
1153		}
1154	}
1155	return undef;
1156}
1157
1158sub FileClass($)
1159{
1160	return "MyFile";
1161}
1162
1163# hook for update-plist, which wants to record fragment positions
1164sub record_fragment($, $, $, $, $)
1165{
1166}
1167
1168# hook for update-plist, which wants to record original file info
1169sub annotate($, $, $, $)
1170{
1171}
1172
1173sub read_fragments($self, $state, $plist, $filename)
1174{
1175	my $stack = [];
1176	my $subst = $state->{subst};
1177	my $main = $self->FileClass->new($filename);
1178	return undef if !defined $main;
1179	push(@$stack, $main);
1180	my $fast = $subst->value("LIBS_ONLY");
1181
1182	return $plist->read($stack,
1183	    sub($stack, $cont) {
1184		while(my $file = pop @$stack) {
1185			while (my $l = $file->readline) {
1186				$state->progress->working(2048)
1187				    unless $state->{silent};
1188				# add a file name to uncommitted cvs tags so
1189				# that the plist is always the same
1190				if ($l =~m/^(\@comment\s+\$(?:Open)BSD\$)$/o) {
1191					$l = '@comment $'.'OpenBSD: '.basename($file->name).',v$';
1192				}
1193				if ($l =~ m/^(\!)?\%\%(.*)\%\%$/) {
1194					$self->record_fragment($plist, $1, $2,
1195					    $file);
1196					if (my $f2 = $self->handle_fragment($state, $file, $1, $2, $filename)) {
1197						push(@$stack, $file);
1198						$file = $f2;
1199					}
1200					next;
1201				}
1202				my $s = $subst->do($l);
1203				if ($fast) {
1204					next unless $s =~ m/^\@(?:cwd|lib|libset|define-tag|depend|wantlib)\b/o || $s =~ m/lib.*\.a$/o;
1205				}
1206	# XXX some things, like @comment no checksum, don't produce an object
1207				my $o = &$cont($s);
1208				if (defined $o) {
1209					$o->check_version($state, $s);
1210					$self->annotate($o, $l, $file);
1211				}
1212			}
1213		}
1214	    });
1215}
1216
1217sub add_description($state, $plist, $name, $opt_d)
1218{
1219	my $o = OpenBSD::PackingElement::FDESC->add($plist, $name);
1220	my $subst = $state->{subst};
1221	my $comment = $subst->value('COMMENT');
1222	if (defined $comment) {
1223		if (length $comment > 60) {
1224			$state->fatal("comment is too long\n#1\n#2\n",
1225			    $comment, ' 'x60 . "^" x (length($comment)-60));
1226		}
1227	} else {
1228		$state->usage("Comment required");
1229	}
1230	if (!defined $opt_d) {
1231		$state->usage("Description required");
1232	}
1233	return if defined $state->opt('q');
1234
1235	open(my $fh, '+>', $o->fullname) or die "Can't write to DESCR: $!";
1236	if (defined $comment) {
1237		print $fh $subst->do($comment), "\n";
1238	}
1239	if ($opt_d =~ /^\-(.*)$/o) {
1240		print $fh $1, "\n";
1241	} else {
1242		$subst->copy_fh($opt_d, $fh);
1243	}
1244	if (defined $comment) {
1245		if ($subst->empty('MAINTAINER')) {
1246			$state->errsay("no MAINTAINER");
1247		} else {
1248			print $fh "\n",
1249			    $subst->do('Maintainer: ${MAINTAINER}'), "\n";
1250		}
1251		if (!$subst->empty('HOMEPAGE')) {
1252			print $fh "\n", $subst->do('WWW: ${HOMEPAGE}'), "\n";
1253		}
1254	}
1255	seek($fh, 0, 0) or die "Can't rewind DESCR: $!";
1256    	my $errors = 0;
1257	while (<$fh>) {
1258		chomp;
1259		if ($state->safe($_) ne $_) {
1260			$state->errsay(
1261			    "DESCR contains weird characters: #1 on line #2",
1262			    $_, $.);
1263		$errors++;
1264		}
1265	}
1266	if ($errors) {
1267		$state->fatal("Can't continue");
1268	}
1269	close($fh);
1270}
1271
1272sub add_extra_info($self, $plist, $state)
1273{
1274	my $subst = $state->{subst};
1275	my $fullpkgpath = $state->{fullpkgpath};
1276	my $cdrom = $subst->value('PERMIT_PACKAGE_CDROM') ||
1277	    $subst->value('CDROM');;
1278	my $ftp = $subst->value('PERMIT_PACKAGE_FTP') ||
1279	    $subst->value('FTP');
1280	$ftp //= 'no';
1281	$ftp = 'yes' if $ftp =~ m/^yes$/io;
1282	$cdrom = 'yes' if defined $cdrom && $cdrom =~ m/^yes$/io;
1283
1284	OpenBSD::PackingElement::ExtraInfo->add($plist,
1285	    $fullpkgpath, $cdrom, $ftp);
1286}
1287
1288sub add_elements($self, $plist, $state)
1289{
1290	my $subst = $state->{subst};
1291	add_description($state, $plist, DESC, $state->opt('d'));
1292	OpenBSD::PackingElement::FDISPLAY->may_add($subst, $plist,
1293	    $state->opt('M'));
1294	OpenBSD::PackingElement::FUNDISPLAY->may_add($subst, $plist,
1295	    $state->opt('U'));
1296	for my $d (sort keys %{$state->{dependencies}}) {
1297		OpenBSD::PackingElement::Dependency->add($plist, $d);
1298	}
1299
1300	for my $w (sort keys %{$state->{wantlib}}) {
1301		OpenBSD::PackingElement::Wantlib->add($plist, $w);
1302	}
1303	for my $w (sort keys %{$state->{libset}}) {
1304		OpenBSD::PackingElement::Libset->add($plist, $w);
1305	}
1306
1307	if (defined $state->opt('A')) {
1308		OpenBSD::PackingElement::Arch->add($plist, $state->opt('A'));
1309	}
1310
1311	if (defined $state->opt('L')) {
1312		OpenBSD::PackingElement::LocalBase->add($plist, $state->opt('L'));
1313		$state->{groff} = $state->opt('L'). '/bin/groff';
1314	}
1315	$self->add_extra_info($plist, $state);
1316	if ($state->{system_version}) {
1317		OpenBSD::PackingElement::Version->add($plist,
1318		    $state->{system_version});
1319    	}
1320}
1321
1322sub cant_read_fragment($self, $state, $frag)
1323{
1324	$state->fatal("can't read packing-list #1", $frag);
1325}
1326
1327sub missing_fragments($self, $state, $frag, $o, $noto)
1328{
1329	$state->fatal("Missing fragments for #1: #2 and #3 don't exist",
1330		$frag, $o, $noto);
1331}
1332
1333sub read_all_fragments($self, $state, $plist)
1334{
1335	if (defined $state->{prefix}) {
1336		OpenBSD::PackingElement::Cwd->add($plist, $state->{prefix});
1337	} else {
1338		$state->usage("Prefix required");
1339	}
1340	for my $contentsfile (@{$state->{contents}}) {
1341		$self->read_fragments($state, $plist, $contentsfile) or
1342		    $self->cant_read_fragment($state, $contentsfile);
1343	}
1344
1345	$plist->register_forbidden($state);
1346	if (defined $state->{forbidden}) {
1347		for my $e (@{$state->{forbidden}}) {
1348			$state->errsay("Error: #1 can't be set explicitly", "\@".$e->keyword." ".$e->stringize);
1349		}
1350		$state->fatal("Can't continue");
1351	}
1352}
1353
1354sub create_plist($self, $state, $pkgname)
1355{
1356	my $plist = OpenBSD::PackingList->new;
1357
1358	if ($pkgname =~ m|([^/]+)$|o) {
1359		$pkgname = $1;
1360		$pkgname =~ s/\.tgz$//o;
1361	}
1362	$plist->set_pkgname($pkgname);
1363	unless ($state->{silent}) {
1364		$state->say("Creating package #1", $pkgname)
1365		    if defined $state->opt('v');
1366		$state->set_status("reading plist");
1367	}
1368	my $dir = OpenBSD::Temp->dir;
1369	if (!$dir) {
1370		$state->fatal(OpenBSD::Temp->last_error);
1371	}
1372	$plist->set_infodir($dir);
1373	# XXX optimization: we want -S to be fast even if we don't check
1374	# everything, e.g., we don't need the actual packing-list to
1375	# print a signature if that's all we do.
1376	if (!(defined $state->opt('S') && defined $state->opt('n'))) {
1377		$self->read_all_fragments($state, $plist);
1378	}
1379	$self->add_elements($plist, $state);
1380
1381	return $plist;
1382}
1383
1384sub make_plist_with_sum($self, $state, $plist)
1385{
1386	my $p2 = OpenBSD::PackingList->new;
1387	$state->progress->visit_with_count($plist, 'makesum_plist', $p2);
1388	$p2->set_infodir($plist->infodir);
1389	return $p2;
1390}
1391
1392sub read_existing_plist($self, $state, $contents)
1393{
1394	my $plist = OpenBSD::PackingList->new;
1395	if (-d $contents && -f $contents.'/'.CONTENTS) {
1396		$plist->set_infodir($contents);
1397		$contents .= '/'.CONTENTS;
1398	} else {
1399		$plist->set_infodir(dirname($contents));
1400	}
1401	$plist->fromfile($contents) or
1402	    $state->fatal("can't read packing-list #1", $contents);
1403	return $plist;
1404}
1405
1406sub create_package($self, $state, $plist, $ordered, $wname)
1407{
1408	$state->say("Creating gzip'd tar ball in '#1'", $wname)
1409	    if $state->opt('v');
1410	my $h = sub {	# SIGHANDLER
1411		unlink $wname;
1412		my $caught = shift;
1413		$SIG{$caught} = 'DEFAULT';
1414		kill $caught, $$;
1415	};
1416
1417	local $SIG{'INT'} = $h;
1418	local $SIG{'QUIT'} = $h;
1419	local $SIG{'HUP'} = $h;
1420	local $SIG{'KILL'} = $h;
1421	local $SIG{'TERM'} = $h;
1422	$state->{archive} = $state->create_archive($wname, $plist->infodir);
1423	$state->set_status("archiving");
1424	my $p = $state->progress->new_sizer($plist);
1425	for my $e (@$ordered) {
1426		$e->create_package($state);
1427		$p->advance($e);
1428	}
1429	$state->end_status;
1430	$state->{archive}->close;
1431	if ($state->{bad}) {
1432		unlink($wname);
1433		exit(1);
1434	}
1435}
1436
1437sub show_bad_symlinks($self, $state)
1438{
1439	for my $dest (sort keys %{$state->{bad_symlinks}}) {
1440		$state->errsay("Warning: symlink(s) point to non-existent #1",
1441		    $dest);
1442		for my $link (@{$state->{bad_symlinks}{$dest}}) {
1443			$state->errsay("\t#1", $link);
1444		}
1445	}
1446}
1447
1448sub check_dependencies($self, $plist, $state)
1449{
1450	my $solver = OpenBSD::Dependencies::CreateSolver->new($plist);
1451
1452	# look for libraries in the "real" tree
1453	$state->{destdir} = '/';
1454
1455	$solver->solve_all_depends($state);
1456	if (!$solver->solve_wantlibs($state, 1)) {
1457		$state->{bad}++;
1458	}
1459}
1460
1461sub finish_manpages($self, $state, $plist)
1462{
1463	$plist->grab_manpages($state);
1464	if (defined $state->{manpages}) {
1465		$state->run_makewhatis(['-t'], $state->{manpages});
1466	}
1467
1468	if (defined $state->{mandir}) {
1469		require File::Path;
1470		File::Path::remove_tree($state->{mandir});
1471	}
1472}
1473
1474# we maintain an LRU cache of files (by checksum) to speed-up
1475# pkg_add -u
1476sub save_history($self, $plist, $state, $dir)
1477{
1478	unless (-d $dir) {
1479		require File::Path;
1480
1481		File::Path::make_path($dir);
1482	}
1483
1484	my $name = $plist->fullpkgpath;
1485	$name =~ s,/,.,g;
1486	my $oldfname = "$dir/$name";
1487	my $fname = "$oldfname.lru";
1488
1489	# if we have history, we record the order of checksums
1490	my $known = {};
1491	if (open(my $f, '<', $fname)) {
1492		while (<$f>) {
1493			chomp;
1494			$known->{$_} //= $.;
1495		}
1496		close($f);
1497	} elsif (open(my $f2, '<', $oldfname)) {
1498		while (<$f2>) {
1499			chomp;
1500			$known->{$_} //= $.;
1501		}
1502		close($f2);
1503	}
1504
1505	my $todo = [];
1506	my $entries = {};
1507	my $list = [];
1508	my $tail = [];
1509	# scan the plist: find data we need to sort, index them by hash,
1510	# directly put some stuff at start of list, and put non indexed stuff
1511	# at end (e.g., symlinks and hardlinks)
1512	$plist->record_digest($todo, $entries, $list, $tail);
1513
1514	my $name2 = "$fname.new";
1515	open(my $f, ">", $name2) or
1516	    $state->fatal("Can't create #1: #2", $name2, $!);
1517
1518	my $found = {};
1519	# split the remaining list
1520	# - first, unknown stuff
1521	for my $h (@$todo) {
1522		if ($known->{$h}) {
1523			$found->{$h} = $known->{$h};
1524		} else {
1525			print $f "$h\n" if defined $f;
1526			push(@$list, (shift @{$entries->{$h}}));
1527		}
1528	}
1529	# dummy entry for verbose output
1530	push(@$list, OpenBSD::PackingElement::LRUFrontier->new);
1531	# - then known stuff, preserve the order
1532	for my $h (sort  {$found->{$a} <=> $found->{$b}} keys %$found) {
1533		print $f "$h\n" if defined $f;
1534		push(@$list, @{$entries->{$h}});
1535	}
1536	close($f);
1537	rename($name2, $fname) or
1538	    $state->fatal("Can't rename #1->#2: #3", $name2, $fname, $!);
1539	unlink($oldfname);
1540	# even with no former history, it's a good idea to save chunks
1541	# for instance: packages like texlive will not change all that
1542	# fast, so there's a good chance the end chunks will be ordered
1543	# correctly
1544	my $l = [@$tail];
1545	my $i = 0;
1546	my $end_marker = OpenBSD::PackingElement::StreamMarker->new;
1547	while (@$list > 0) {
1548		my $e = pop @$list;
1549		if ($i++ % 16 == 0) {
1550			unshift @$l, $end_marker;
1551		}
1552		unshift @$l, $e;
1553	}
1554	# remove extraneous marker if @$tail is empty.
1555	if ($l->[-1] eq $end_marker) {
1556		pop @$l;
1557	}
1558	return $l;
1559}
1560
1561sub validate_pkgname($self, $state, $pkgname)
1562{
1563	my $revision = $state->defines('REVISION_CHECK');
1564	my $epoch = $state->defines('EPOCH_CHECK');
1565	my $flavor_list = $state->defines('FLAVOR_LIST_CHECK');
1566	if ($revision eq '') {
1567		$revision = -1;
1568	}
1569	if ($epoch eq '') {
1570		$epoch = -1;
1571	}
1572	my $okay_flavors = {map {($_, 1)} split(/\s+/, $flavor_list) };
1573	my $v = OpenBSD::PackageName->from_string($pkgname);
1574
1575	# first check we got a non buggy pkgname, since otherwise
1576	# the parts we test won't even exist !
1577	if ($v->has_issues) {
1578		$state->errsay("Error FULLPKGNAME #1 #2", $pkgname,
1579		    $v->has_issues);
1580		$state->fatal("Can't continue");
1581	}
1582	my $errors = 0;
1583	if ($v->{version}->p != $revision) {
1584		$state->errsay("REVISION mismatch (REVISION=#1)", $revision);
1585		$errors++;
1586	}
1587	if ($v->{version}->v != $epoch) {
1588		$state->errsay("EPOCH mismatch (EPOCH=#1)", $epoch);
1589		$errors++;
1590	}
1591	for my $f (keys %{$v->{flavors}}) {
1592		if (!exists $okay_flavors->{$f}) {
1593			$state->errsay("bad FLAVOR #1 (admissible flavors #2)",
1594			    $f, $flavor_list);
1595			$errors++;
1596		}
1597	}
1598	if ($errors) {
1599		$state->fatal("Can't continue");
1600	}
1601}
1602
1603sub run_command($self, $state)
1604{
1605	if (defined $state->opt('Q')) {
1606		$state->{opt}{q} = 1;
1607	}
1608
1609	if (!defined $state->{contents}) {
1610		$state->usage("Packing-list required");
1611	}
1612
1613	my $plist;
1614	if ($state->{regen_package}) {
1615		if (!defined $state->{contents} || @{$state->{contents}} > 1) {
1616			$state->usage("Exactly one single packing-list is required");
1617		}
1618		$plist = $self->read_existing_plist($state,
1619		    $state->{contents}[0]);
1620	} else {
1621		$plist = $self->create_plist($state, $ARGV[0]);
1622	}
1623
1624
1625	if (defined $state->opt('S')) {
1626		print $plist->signature->string, "\n";
1627		# no need to check anything else if we're running -n
1628		exit 0 if defined $state->opt('n');
1629	}
1630	$plist->discover_directories($state);
1631	my $ordered = [];
1632	unless (defined $state->opt('q') && defined $state->opt('n')) {
1633		$state->set_status("checking dependencies");
1634		$self->check_dependencies($plist, $state);
1635		if ($state->{regression}{stub}) {
1636			$plist->stub_digest($ordered);
1637		} else {
1638			$state->set_status("checksumming");
1639			if ($state->{regen_package}) {
1640				$state->progress->visit_with_count($plist,
1641				    'verify_checksum');
1642			} else {
1643				$plist = $self->make_plist_with_sum($state,
1644				    $plist);
1645				my $h = $plist->get('always-update');
1646				if (defined $h) {
1647					$h->hash_plist($plist);
1648				}
1649			}
1650			if (defined(my $dir = $state->defines('HISTORY_DIR'))) {
1651				$ordered = $self->save_history($plist,
1652				    $state, $dir);
1653			} else {
1654				$plist->register_for_archival($ordered);
1655			}
1656			$self->show_bad_symlinks($state);
1657		}
1658		$state->end_status;
1659	}
1660
1661	if (!defined $plist->pkgname) {
1662		$state->fatal("can't write unnamed packing-list");
1663	}
1664	if (defined $state->defines('REVISION_CHECK')) {
1665		$self->validate_pkgname($state, $plist->pkgname);
1666	}
1667
1668	if (defined $state->opt('q')) {
1669		if (defined $state->opt('Q')) {
1670			$plist->print_file;
1671		} else {
1672			$plist->write(\*STDOUT);
1673		}
1674		return 0 if defined $state->opt('n');
1675	}
1676
1677	if ($plist->{deprecated}) {
1678		$state->fatal("found obsolete constructs");
1679	}
1680
1681	$plist->avert_duplicates_and_other_checks($state);
1682	if ($state->{has_no_default_conflict} && !$state->{has_conflict}) {
1683		$state->errsay("Warning: \@option no-default-conflict without \@conflict");
1684	}
1685	$state->{stash} = {};
1686
1687	if ($state->{bad} && !$state->{regression}{plist_checks}) {
1688		$state->fatal("can't continue");
1689	}
1690	$state->{bad} = 0;
1691
1692	my $wname;
1693	if ($state->{regen_package}) {
1694		$wname = $plist->pkgname.".tgz";
1695	} else {
1696		$plist->save or $state->fatal("can't write packing-list");
1697		$wname = $ARGV[0];
1698	}
1699
1700	if ($state->opt('n')) {
1701		$state->{archive} = OpenBSD::Ustar->new(undef, $state,
1702		    $plist->infodir);
1703		$plist->pretend_to_archive($state);
1704	} else {
1705		$self->create_package($state, $plist, $ordered, $wname);
1706	}
1707	if (!$state->defines("stub")) {
1708		$self->finish_manpages($state, $plist);
1709	}
1710}
1711
1712sub parse_and_run($self, $cmd)
1713{
1714	my $state = OpenBSD::PkgCreate::State->new($cmd);
1715	$state->handle_options;
1716
1717	if (@ARGV == 0) {
1718		$state->{regen_package} = 1;
1719	} elsif (@ARGV != 1) {
1720		$state->usage("Exactly one single package name is required: #1",
1721		    join(' ', @ARGV));
1722	}
1723
1724	$self->try_and_run_command($state);
1725	return $state->{bad} != 0;
1726}
1727
17281;
1729