ViewVC Help
View File | Revision Log | Show Annotations | View Changeset | Root Listing
root/ozone/mgar/gar/bin/mkpackage
Revision: 1
Committed: Sat Jun 20 14:58:51 2026 UTC (4 weeks, 3 days ago) by operz
File size: 44671 byte(s)
Log Message:
Initial import of OZSW mgar build tree

File Contents

# Content
1 #!/usr/bin/perl -w
2 #
3 # $Id: mkpackage 16787 2012-01-17 21:07:37Z dmichelsen $
4 #
5 # mkpackage - produce Solaris packages from a specification.
6 #
7
8 require 5.008004;
9
10 use strict;
11 use Cwd qw/cwd/;
12 use File::Basename;
13 use File::Spec::Functions;
14 use Getopt::Long qw/:config no_ignore_case gnu_getopt/;
15 use POSIX;
16 sub pod2usage { my %a = (ref $_[0] ? %{$_[0]} : ()); my $e = defined $a{-exitstatus} ? $a{-exitstatus} : (defined $_[0] ? $_[0] : 0); die "Use mkpackage --help for usage.\n" if $e; print "Use mkpackage --help for usage.\n"; exit 0; }
17 use Term::ANSIColor;
18 use vars qw/
19 $TOOLVERSION $REVISION $VERSION
20 $HAS_LWP_SUPPORT $UA $HAS_CURL_SUPPORT
21 %config %exit $SELF %SPEC_TYPE $SPEC_TYPE
22 $DIRECTIVE @SPECDIRS @ADMFILES %FLAGS %HASMERGE
23 $DIRECTIVE_START %VALID_DIRECTIVES %SCRIPTADM $ARCH/;
24
25 # Tool Version/Revision Information
26 $TOOLVERSION = "1.4";
27 ($REVISION) = q/$Revision: 16787 $/ =~ /(\d+)/;
28 $VERSION = $TOOLVERSION;
29 if ( defined $REVISION ) {
30 $VERSION = sprintf '%s (r%d)', $TOOLVERSION, $REVISION;
31 }
32
33 # Discover network support
34 ( $HAS_LWP_SUPPORT, $HAS_CURL_SUPPORT ) = ( 0, 0 );
35 eval {
36 require LWP::UserAgent;
37 import LWP::UserAgent;
38 };
39 $HAS_LWP_SUPPORT = $@ ? 0 : 1;
40
41 unless ($HAS_LWP_SUPPORT) {
42 my $curlbin = `which curl`;
43 chomp $curlbin;
44 $HAS_CURL_SUPPORT = $curlbin if $curlbin !~ /no curl/;
45 }
46
47 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
48 # Configuration
49 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
50
51 # Program Name
52 $SELF = basename $0;
53
54 # Exit Codes
55 %exit = (
56 ok => 0,
57 usage => 1,
58 file_not_found => 2,
59 file_not_readable => 3,
60 file_not_writable => 4,
61 dir_not_found => 5,
62 dir_create_failed => 6,
63 prog_not_executable => 7,
64 prog_wrong_version => 8,
65 prog_exec_error => 9,
66 spec_error => 10,
67 dumped_env => 11,
68 bad_ziplevel => 12,
69 unknown => 42,
70 );
71
72 # Architecture
73 ($ARCH) = `/bin/uname -p`;
74 chomp $ARCH;
75
76 # Content flags
77 %FLAGS = map { $_ => $_ } qw/none merge/;
78
79 # Spec Content Types
80 %SPEC_TYPE = (
81 CONTENT => '_content',
82 URL => 'url',
83 EXEC => 'exec',
84 );
85 {
86 my $tmp = join "|", grep { !/^_/ } values %SPEC_TYPE;
87 $SPEC_TYPE = qr/^($tmp)$/;
88 }
89
90 # Valid directives
91 @SPECDIRS = qw/
92 include var cvar
93 /;
94
95 # NOTE: prototype must be first in this list!
96 @ADMFILES = qw/
97 prototype checkinstall compver copyright depend pkginfo
98 preinstall postinstall preremove postremove request space
99 /;
100
101 # Admin files that are scripts
102 %SCRIPTADM = map { $_ => 1 } qw/
103 checkinstall compver preinstall postinstall preremove
104 postremove request
105 /;
106
107 %VALID_DIRECTIVES = map { $_ => 1 } ( @SPECDIRS, @ADMFILES );
108
109 $DIRECTIVE_START = '%';
110 $DIRECTIVE = qr/^$DIRECTIVE_START(\w+)(?:\:(\w+))?/;
111
112 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
113 # NO USER SERVICABLE PARTS BEYOND HERE
114 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
115
116 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
117 # Function : _log
118 # Purpose : Convenience print function
119 # Arguments: @_ - message portions, which will be joined by space, and
120 # concluded with a newline character.
121 #
122 sub _log {
123 my $fh = shift;
124 my $color = shift;
125 print $fh colored("mkp: " . join( " ", @_ ), $color) . "\n"
126 unless $config{quiet};
127 }
128
129 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
130 # Function : Important
131 # Purpose : Convenience print function
132 # Arguments: @_ - message portions, which will be joined by space, and
133 # concluded with a newline character.
134 #
135 sub Important { _log(\*STDOUT, "blue", @_) }
136
137 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
138 # Function : Info
139 # Purpose : Convenience print function
140 # Arguments: @_ - message portions, which will be joined by space, and
141 # concluded with a newline character.
142 #
143 sub Info { _log(\*STDOUT, "cyan", @_) }
144
145 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
146 # Function : Warn
147 # Purpose : Convenience print function
148 # Arguments: @_ - message portions, which will be joined by space, and
149 # concluded with a newline character.
150 #
151 sub Warn { _log(\*STDOUT, "yellow", "WARNING:", @_) }
152
153 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
154 # Function : Error
155 # Purpose : Convenience print function
156 # Arguments: @_ - message portions, which will be joined by space, and
157 # concluded with a newline character.
158 #
159 sub Error { _log(\*STDERR, "red", @_) }
160
161 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
162 # Function : Die
163 # Purpose : Convenience print and exit function
164 # Arguments: $code - exit code (see %exit)
165 # @_ - message portions, which will be joined by space, and
166 # concluded with a newline character.
167 # Effects : This function causes the calling program to exit.
168 #
169 sub Die {
170 my $code = $exit{unknown};
171 $code = shift if $_[0] =~ /^\d+$/;
172 Error("ERROR: ", @_);
173 exit($code);
174 }
175
176 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
177 # Function : usage_error
178 # Purpose : Convenience usage and exit function
179 # Arguments: $message - message to print to user before exiting.
180 # Effects : This function causes the calling program to exit.
181 #
182 sub usage_error {
183 pod2usage(
184 -exitstatus => $exit{usage},
185 -verbose => 0,
186 -msg => shift,
187 );
188 }
189
190 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
191 # Function : _exec
192 # Purpose : Print a message, execute a command, and optionally return the
193 # output to the caller. This is provided as a low level
194 # replacement for vexec, for use by functions where it is not
195 # feasible to call error instead (e.g. get_content).
196 # Arguments: $cmdline - command line to execute.
197 # @_ - message to die with if the command does not exit cleanly.
198 # Returns : If called in scalar context, returns nothing. If called in list
199 # context, returns the output of $cmdline as an array.
200 #
201 sub _exec {
202 my $cmdline = shift;
203
204 Important "exec( $cmdline )";
205
206 if (wantarray) {
207 my @content = `$cmdline`;
208 die [ $exit{prog_exec_error}, @_ ]
209 unless WIFEXITED($?) and WEXITSTATUS($?) == 0;
210
211 return @content;
212 }
213 else {
214 system($cmdline) and die [ $exit{prog_exec_error}, @_ ];
215 }
216 return 1;
217 }
218
219 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
220 # Function : vexec
221 # Purpose : Print a message, execute a command, and optionally return the
222 # output to the caller. If the command does not exit cleanly, the
223 # supplied message will be printed on STDERR, and the calling
224 # program will exit with a non-zero exit status.
225 # Arguments: $cmdline - command line to execute.
226 # @_ - message to die with if the command does not exit cleanly.
227 # Returns : If called in scalar context, returns nothing. If called in list
228 # context, returns the output of $cmdline as an array.
229 # Effects : This function causes the calling program to exit.
230 #
231 sub vexec {
232 if (wantarray) {
233 my @content;
234 eval { @content = _exec(@_) };
235 Die( @{$@} ) if $@;
236 return @content;
237 }
238 else {
239 eval { _exec(@_) };
240 Die( @{$@} ) if $@;
241 }
242 return 1;
243 }
244
245 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
246 # Function : env_replace
247 # Purpose : Replace %{variable} declarations in the target string with values
248 # from the process environment.
249 # Arguments: $string - string to replace variables in.
250 # Returns : A string with all variables of form %{variable} replaced by some
251 # text. If a %{variable} is found in the string, it will be
252 # replaced by $ENV{variable}, if it exists. If $ENV{variable} is
253 # not set, %{variable} will be replaced with an empty string, and a
254 # warning will be emitted. If a variable of form %{exec cmd} is
255 # encountered, the command (or command pipeline) will be executed,
256 # and the first line of the command output will be used to replace
257 # the variable declaration.
258 #
259 sub env_replace {
260 local $_ = shift;
261
262 while (/\%\{/) {
263 my ($var) = $_ =~ /\%\{([^\}]+)\}/;
264
265 my $val;
266 if ( index( $var, " " ) != -1 ) {
267
268 # Handle ${exec cmd} var replacement
269 my ( $type, $argv ) = split /\s+/, $var, 2;
270
271 if ( $type eq 'exec' ) {
272 ($val) =
273 vexec( $argv,
274 "Failed to execute shell replacement command '$var'" );
275
276 warn "WARNING: '\%{$var}' created no output" if $val eq '';
277 $val =~ s/^\s*|\s*$//g;
278 }
279 else {
280 Die( $exit{spec_error},
281 "whitespace in variable name '$var'" );
282 }
283 }
284 else {
285 $val = $ENV{$var} || '';
286 Error "WARNING: environment variable '$var' is not set"
287 if $val eq '';
288 }
289
290 Info "replacing \%{$var} with '$val'";
291 s/\%\{[^\}]+?\}/$val/;
292 }
293 return $_;
294 }
295
296 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
297 # Function : process_arguments
298 # Purpose : Process command line arguments to mkpackage, check for required
299 # arguments, set reasonable defaults. The results of argument
300 # processing are stored in the global %config hash.
301 # Effects : This function may cause the calling program to exit.
302 #
303 sub process_arguments {
304
305 # Options
306 my %args;
307 GetOptions(
308 'v=s' => \%{ $config{pkgvars} },
309 'dump|D=s' => \@{ $config{dumpvars} },
310 'dumpall|A' => \$config{dumpall},
311 'spec|s=s' => \$args{spec},
312 'destdir|d=s' => \$args{destdir},
313 'workdir|w=s' => \$args{workdir},
314 'spooldir|p=s' => \$args{spooldir},
315 'pkgbase|b=s' => \$args{pkgbase},
316 'pkgroot|r=s' => \$args{pkgroot},
317 'tmpdir|t=s' => \$args{tmpdir},
318 'transfer!' => \$config{transfer},
319 'overwrite!' => \$config{overwrite},
320 'compress!' => \$config{compress},
321 'ziplevel|z=i' => \$config{ziplevel},
322 'usebzip' => \$config{usebzip},
323 'usepigz' => \$config{usepigz},
324 'quiet|q' => \$config{quiet},
325 'help' => \$args{help},
326 'manual' => \$args{man},
327 'version|V' => sub {
328 print "$SELF v$VERSION\n";
329 exit $exit{usage};
330 },
331 )
332 or pod2usage();
333
334 # Help (--help) and/or Manual (--man)
335 pod2usage(1) if $args{help};
336 pod2usage( -verbose => 2 ) if $args{man};
337
338 # Dump (-D) and dump all (-A)
339 usage_error("Dump (-D) and Dump all (-A) are exclusive")
340 if $config{dumpall}
341 and @{ $config{dumpvars} };
342
343 # Spec Filename (--spec)
344 usage_error("Spec (--spec) is a required argument")
345 unless $args{spec};
346
347 Die( $exit{file_not_found}, "Cannot locate '$args{spec}'" )
348 unless -f $args{spec};
349 Die( $exit{file_not_readable}, "Cannot read '$args{spec}'" )
350 unless -r $args{spec};
351
352 $config{spec} = $args{spec};
353 $config{specname} = basename $config{spec}, ".gspec";
354 $config{protoname} = $config{specname} . ".prototype";
355
356 $config{spec} = "file://$config{spec}"
357 unless $config{spec} =~ m#^(\w+)://#;
358
359 # Current dir
360 $config{curdir} = cwd();
361
362 # Working dir (--workdir)
363 $config{workdir} = $args{workdir} || $config{curdir};
364 Die( $exit{dir_not_found}, "Cannot access --workdir '$config{workdir}'" )
365 unless -d $config{workdir};
366
367 # Destination directory (--destdir)
368 $config{destdir} = $args{destdir} || $config{workdir};
369 unless ( -d $config{destdir} ) {
370 vexec(
371 "mkdir -p $config{destdir}",
372 $exit{dir_create_failed},
373 "Cannot create destination dir '$config{destdir}'"
374 );
375 }
376
377 # Spool dir (--spooldir)
378 $config{spooldir} = $args{spooldir} || '/var/spool/pkg';
379 Die( $exit{dir_not_found},
380 "Cannot access --spooldir '$config{spooldir}'" )
381 unless -d $config{spooldir};
382
383 # Temporary dir (--tmpdir)
384 $config{tmpdir} = $args{tmpdir} || '/tmp';
385 Die( $exit{dir_not_found}, "Cannot access --tmpdir '$config{tmpdir}'" )
386 unless -d $config{tmpdir};
387
388 # Package base dir (--pkgbase)
389 $config{pkgbase} = $args{pkgbase} || '';
390 Die( $exit{dir_not_found}, "Cannot access --pkgbase '$config{pkgbase}'" )
391 if $config{pkgbase} and not -d $config{pkgbase};
392
393 # Package root dir (--pkgroot)
394 $config{pkgroot} = $args{pkgroot} || '';
395 Die( $exit{dir_not_found}, "Cannot access --pkgroot '$config{pkgroot}'" )
396 if $config{pkgroot} and not -d $config{pkgroot};
397
398 # Supply defaults for --no/x flag arguments
399 $config{compress} = 0 unless defined $config{compress};
400 $config{transfer} = 1 unless defined $config{transfer};
401 $config{overwrite} = 0 unless defined $config{overwrite};
402 $config{usebzip} = 0 unless defined $config{usebzip};
403 $config{usepigz} = 0 unless defined $config{usepigz};
404 $config{ziplevel} = 9 unless defined $config{ziplevel};
405 Die( $exit{bad_ziplevel}, "Invalid --ziplevel '$config{ziplevel}'" )
406 if $config{ziplevel} < 1 or $config{ziplevel} > 9;
407
408 # Export variables to the spec
409 $ENV{$_} = $config{$_} foreach qw/
410 specname destdir workdir spooldir pkgbase pkgroot tmpdir
411 /;
412 }
413
414 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
415 # Function : dumpenv
416 # Purpose : Dump ENV variables after parsing the spec.
417 # Arguments: $dumpvars - Array ref of desired variables. Empty dumps all.
418 # $spec - Spec structure returned by parse().
419 # Returns : This function causes the calling program to exit.
420 #
421 sub dumpenv {
422 my $dumpvars = shift;
423 my $spec = shift;
424
425 my @vars = @$dumpvars ? @$dumpvars : keys %ENV;
426 my $multi = @vars > 1;
427
428 foreach my $var (@vars) {
429 my $val = exists $ENV{$var} ? $ENV{$var} : '';
430 printf "$var=" if $multi;
431 printf "$val\n";
432 }
433
434 exit $exit{dumped_env};
435 }
436
437 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
438 # Function : parse
439 # Purpose : Parse spec content loaded using get_content.
440 # Arguments: $specuri - URI for spec to parse
441 # $uritype - URI Type (uri, exec, etc.) (default: url)
442 # Returns : Hash of array references. Each hash key is named for one of the
443 # ADMFILES directive names. The key value is an array ref, which
444 # contains one or more array refs. Each sub-array represents one
445 # line of in-line spec content, or a method for generating the
446 # admin file content. The sub array indices are:
447 #
448 # [0] - line type (SPEC_TYPE)
449 # [1] - full path to original file/url location
450 # [2] - line number from original file
451 # [3] - content, command line, or url
452 #
453 sub parse {
454 my $specuri = shift;
455 my $uritype = shift || $SPEC_TYPE{URL};
456
457 Important "processing $specuri";
458
459 # Bootstrap the main spec
460 my $content;
461 eval { $content = get_content( $uritype, $specuri ) };
462 Die(
463 ( $@ and ref($@) eq 'ARRAY' )
464 ? ( @{$@}, "in $specuri" )
465 : ( $exit{unknown}, "$@ in $specuri" )
466 )
467 if $@;
468
469 # Process the main spec. The array ref returned by get_content
470 # contains array references, one for each line of content in the
471 # specified file.
472
473 my ( $dname, $spec, $line, $flag );
474 for ( my $i = 0 ; $i <= $#$content ; $i++ ) {
475
476 my ( $source, $lineno, $line ) = @{ $content->[$i] };
477
478 # If this line starts with a directive..
479 if ( $line =~ /$DIRECTIVE/ ) {
480 $dname = lc $1;
481 $flag = $2 || $FLAGS{none};
482
483 Die( $exit{spec_error},
484 "invalid directive flag '$flag' at $source line $lineno" )
485 unless exists $FLAGS{$flag};
486
487 # Flag this directive for merge later
488 $HASMERGE{$dname}++ if $flag eq $FLAGS{merge};
489
490 Die( $exit{spec_error},
491 "invalid directive '$dname' at $source line $lineno" )
492 unless exists $VALID_DIRECTIVES{$dname};
493
494 # Split out the sub 'type' and arguments
495 my ( undef, $dtype, $argv ) = split /\s+/, $line, 3;
496
497 # Carry on, because content is in-line
498 next unless $dtype;
499 chomp $argv;
500
501 if ( $dname eq 'include' ) {
502
503 # dir:%include
504 Die( $exit{spec_error},
505 "\%include requires type and URI at $source line $lineno" )
506 unless $dtype
507 and $argv;
508
509 Die( $exit{spec_error},
510 "invalid include type '$dtype' at $source line $lineno" )
511 unless $dtype =~ $SPEC_TYPE;
512
513 # Retrieve the %included content
514 Important "include $argv";
515
516 my $inc;
517 eval { $inc = get_content( $dtype, $argv ) };
518 Die(
519 ( $@ and ref($@) eq 'ARRAY' )
520 ? ( @{$@}, "at $source line $lineno" )
521 : ( $exit{unknown}, "$@ at $source line $lineno" )
522 )
523 if $@;
524
525 Warn "empty include at $source line $lineno"
526 unless @$inc;
527
528 # Splice into the array we're looping through
529 splice @$content, $i, 1, @$inc;
530 $i--;
531 }
532 elsif ( $dname eq 'var' or $dname eq 'cvar' ) {
533
534 # dir:%var
535 Die( $exit{spec_error},
536 "\%$dname needs name and value at $source line $lineno" )
537 unless $dtype
538 and defined $argv;
539
540 # cvar means that if the named variable is already set in ENV,
541 # it will not be overwritten by subsequent %vars.
542 if ( $dname ne 'cvar' or not exists $ENV{$dtype} ) {
543 $config{$dtype} = $ENV{$dtype} = env_replace $argv;
544 Info "set ENV{$dtype} = '$ENV{$dtype}'";
545 }
546 else {
547 Info "cvar ENV{$dtype} is already set ($ENV{$dtype})"
548 if $dname eq 'cvar';
549 }
550 }
551 else {
552
553 # If the content is a script, overwrite the existing spec
554 # reference, otherwise spec lines are additive.
555 my $specline = [ $dtype, $argv, $source, $lineno, $flag ];
556 if ($SCRIPTADM{$dname}) {
557
558 if ($spec->{$dname}) {
559 Warn "$dname\@$source line $lineno";
560 Warn "overrides";
561 Warn "$dname\@$spec->{$dname}[0][2]" .
562 " line " . $spec->{$dname}[0][3];
563 }
564
565 $spec->{$dname} = [ $specline ];
566 }
567 else {
568 push @{ $spec->{$dname} }, $specline;
569 }
570 }
571 }
572 else {
573 if ($dname) {
574
575 # Attribute this in-line text to the current directive
576 push @{ $spec->{$dname} },
577 [ $SPEC_TYPE{CONTENT}, $line, $source, $lineno, $flag ];
578 }
579 elsif ( $dname eq 'include' or $dname eq 'var' ) {
580 Die( $exit{spec_error},
581 "inline content is not allowed for \%$dname" );
582 }
583 else {
584
585 # In-line content, but no idea where it goes!
586 Warn "ignoring in-line content at $source line $lineno";
587 }
588 }
589 }
590
591 return $spec;
592 }
593
594 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
595 # Function : get_content
596 # Purpose : Load content from files, network URIs, or from command line
597 # executable output. Returns tagged output indicating the source
598 # of each line.
599 # Arguments: $ctype - content type, must be in %SPEC_TYPE
600 # $source - source url for 'url' type, command line for 'exec'
601 # Returns : Array reference containing zero or more array references. Each
602 # sub-array contains the following information:
603 #
604 # [0] - path to the source*
605 # [1] - line number within the source file
606 # [2] - text
607 #
608 # (*) For 'url' paths with scheme file://, or with no scheme at
609 # all, this will be the absolute path to the source file. For
610 # 'url' paths other than scheme file://, and $ctype 'exec' this
611 # will be $source.
612 #
613 sub get_content {
614 my $ctype = shift;
615 my $source = env_replace(shift);
616 my @content;
617
618 # NOTE: Any errors in get_content must be passed back to the caller using
619 # die. There is not enough info in this routine (e.g. include source, line
620 # number, etc) to accurately tell the user where within nested spec
621 # includes something went wrong.
622
623 if ( $ctype eq $SPEC_TYPE{URL} ) {
624
625 # Fix relative file URIs
626 if ( $source =~ m#file://# ) {
627 $source =~ s#file://(?=[^/])#$config{curdir}/#;
628 $source =~ s#file://##;
629 }
630 elsif ( $source !~ m#^\w+://# ) {
631 $source =~ s#^(?=[^/])#$config{curdir}/#;
632 }
633
634 if ( $source !~ m#^\w+://# ) {
635
636 #
637 # Plain text file
638 #
639
640 die [ $exit{file_not_found}, "cannot access $source ($!)" ]
641 unless -f $source;
642
643 open FILE, $source
644 or die [ $exit{file_not_readable}, "cannot open $source ($!)" ];
645
646 push @content, <FILE>;
647 close FILE;
648 }
649 else {
650
651 #
652 # Network URI
653 #
654
655 if ($HAS_LWP_SUPPORT) {
656 $UA = new LWP::UserAgent unless defined $UA;
657
658 # Retrieve content
659 my $r = $UA->get($source);
660 die [ $exit{file_not_found},
661 "cannot access $source ("
662 . $r->code . ": "
663 . $r->message
664 . ")" ]
665 unless $r->is_success;
666
667 @content = map { "$_\n" } split( /\n/, $r->content );
668 }
669 elsif ($HAS_CURL_SUPPORT) {
670
671 # Use curl to grab the content - _exec dies on error
672 @content = _exec(
673 "$HAS_CURL_SUPPORT -s $source",
674 "failed to fetch $source with curl"
675 );
676 }
677 else {
678 die "no support detected for non-file URIs";
679 }
680 }
681 }
682 elsif ( $ctype eq $SPEC_TYPE{EXEC} ) {
683
684 # Get content - _exec dies on error
685 @content = _exec( $source, "failed to execute '$source'" );
686 }
687 else {
688 die "unknown content type '$ctype'";
689 }
690
691 # Return source tagged content
692 my $i = 0;
693 return [ map { [ $source, ++$i, $_ ] } @content ];
694 }
695
696 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
697 # Function : create_files
698 # Purpose : Create package administrative files using spec information.
699 # Depending on the value of config{overwrite}, this method may over
700 # write existing files.
701 # Arguments: $spec - spec data structure as returned by parse().
702 # Returns : Full path to the generated (or pre-existing) prototype file.
703 #
704 sub create_files {
705 my $spec = shift;
706 my $specname = $config{specname};
707 my $workdir = $config{workdir};
708 my $protopath;
709
710 # First things first, check for required items
711 foreach my $required qw(pkginfo prototype) {
712 Die( $exit{spec_error},
713 "Required package resource \%$required not specified" )
714 unless exists $spec->{$required};
715 }
716
717 # Next, generate admin file content
718 foreach my $admtype (@ADMFILES) {
719 next unless exists $spec->{$admtype};
720
721 Important "Processing $admtype";
722
723 my $admfile = catfile $workdir, "$specname.$admtype-$ARCH";
724 $admfile = catfile $workdir, "$specname.$admtype" unless -f $admfile;
725 my $admfile_name = basename $admfile;
726
727 # Allow other admin files to read the prototype!
728 $protopath = $ENV{prototype} = $admfile if $admtype eq 'prototype';
729
730 # Handle overwrite permission
731 if ( -f $admfile and not $config{overwrite} ) {
732 Warn "Using existing $admfile_name";
733 next unless $HASMERGE{$admtype};
734 }
735
736 if ($config{overwrite}) {
737 Warn "Overwriting $admtype $admfile_name";
738 }
739 elsif ($HASMERGE{$admtype}) {
740 Warn "Modifying $admtype $admfile_name";
741 } else {
742 Info "Generating $admfile_name";
743 }
744
745 # If we're merging content for this admin type
746
747 my @admcontent;
748 if ($HASMERGE{$admtype} and not $config{overwrite}) {
749 if (-f $admfile) {
750 Info "Merging $admtype content with $admfile_name";
751 open ADM, $admfile
752 or Die($exit{file_not_readable},
753 "Cannot open '$admfile' for read: $!");
754
755 local $/ = undef;
756 @admcontent = <ADM>;
757 close ADM;
758 }
759 }
760
761 foreach my $item ( @{ $spec->{$admtype} } ) {
762 my ( $ctype, $line, $source, $lineno, $flag ) = @$item;
763
764 if ( $ctype eq $SPEC_TYPE{CONTENT} ) {
765 push @admcontent, $line;
766 }
767 elsif (! -f $admfile or $config{overwrite} or $flag eq $FLAGS{merge}) {
768 eval {
769 my @content = @{ get_content @$item };
770 Warn "empty \%$admtype at $source line $lineno"
771 unless @content;
772
773 foreach my $i (@content) { push @admcontent, $i->[2] }
774 };
775
776 Die(
777 ( $@ and ref($@) eq 'ARRAY' )
778 ? ( @{$@}, "at $item->[2] line $item->[3]" )
779 : ( $exit{unknown}, "$@ at $item->[2] line $item->[3]" )
780 )
781 if $@;
782 }
783 }
784
785 # Do content replace within 'pkginfo' and 'copyright' includes
786 if ( $admtype eq 'pkginfo' or
787 $admtype eq 'copyright' or
788 $admtype eq 'prototype') {
789 for ( my $i = 0 ; $i <= $#admcontent ; $i++ ) {
790 $admcontent[$i] = env_replace( $admcontent[$i] );
791 }
792 }
793
794 # Write content to file
795 if (@admcontent) {
796
797 if ( $admtype eq 'prototype'
798 or $admtype eq 'depend'
799 or $admtype eq 'pkginfo'
800 or $admtype eq 'space' )
801 {
802 Info "Removing duplicate lines from $admfile_name";
803
804 # Remove duplicate lines, preserve order
805 my @uniqadm;
806 foreach my $adm (@admcontent) {
807 my $found;
808 foreach my $uni (@uniqadm) {
809 if ( $adm eq $uni ) { $found++; last }
810 }
811 push @uniqadm, $adm unless $found;
812 }
813 @admcontent = @uniqadm;
814 }
815
816 Info "Writing $admfile_name";
817
818 open OUT, ">$admfile"
819 or
820 Die( $exit{file_not_writable}, "unable to write $admfile: $!" );
821
822 print OUT $_ foreach (@admcontent);
823 close OUT;
824 }
825 else {
826 Error("HAS NO CONTENT!");
827 }
828 }
829
830 # Last of all, write admin file content to the prototype
831 Important "Writing admin entries to " . basename $protopath;
832
833 my %writeadm;
834 foreach my $admtype (@ADMFILES) {
835 next if $admtype eq 'prototype';
836 system(qq{grep "i $admtype" $protopath >/dev/null 2>&1});
837 my $es = $? >> 8;
838
839 $writeadm{$admtype}++ if $es;
840 }
841
842 # Write entries which are not already in the prototype...
843 if ( keys %writeadm ) {
844 open PROTO, ">>$protopath"
845 or Die( $exit{file_not_writable},
846 "Failed to open $protopath for append: $!" );
847
848 foreach my $admtype ( sort keys %writeadm ) {
849 my $admfile = "$specname.$admtype";
850 my $admpath = catfile $workdir, $admfile;
851 print PROTO "i $admtype=$admfile\n" if -f $admpath;
852 }
853 close PROTO;
854 }
855
856 return $protopath;
857 }
858
859 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
860 # Function : clean_spool
861 # Purpose : Remove any existing package spool directory for the package
862 # described by the current spec file.
863 #
864 sub clean_spool {
865 my $spooldir = $config{spooldir};
866 my $specname = $config{specname};
867
868 my $existing_pkgspool = catfile $spooldir, $specname;
869 vexec( "rm -rf $existing_pkgspool", "Failed to remove $existing_pkgspool" )
870 if -d $existing_pkgspool;
871 }
872
873 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
874 # Function : make_package
875 # Purpose : Invoke pkgmk to create a spool package using the specified
876 # prototype file.
877 # Arguments: $proto - full path to the package prototype file.
878 #
879 sub make_package {
880 my $proto = shift;
881
882 clean_spool;
883
884 # Build the variable list
885 my @vars;
886 push @vars, join( "=", $_, $config{pkgvars}{$_} )
887 foreach ( sort keys %{ $config{pkgvars} } );
888
889 my @pkgmk;
890 push @pkgmk, "pkgmk";
891 push @pkgmk, "-d $config{spooldir}";
892 push @pkgmk, "-r $config{pkgroot}" if $config{pkgroot};
893 push @pkgmk, "-b $config{pkgbase}" if $config{pkgbase};
894 push @pkgmk, "-o" if $config{overwrite};
895 push @pkgmk, "-f $proto";
896 push @pkgmk, join(" ", @vars);
897
898 vexec( join(" ", @pkgmk),
899 "Failed to create $config{specname} using $proto" );
900 }
901
902 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
903 # Function : transfer_package
904 # Purpose : Invoke pkgtrans to create a bitstream package using variables
905 # from the command line and from spec files.
906 #
907 sub transfer_package {
908 my $pkgname = $config{pkgname} || $config{specname};
909 my $pkgfile = $config{pkgfile} || "$pkgname.pkg";
910 my $tmppkg = catfile $config{tmpdir}, $pkgfile;
911
912 vexec(
913 "pkgtrans -s $config{spooldir} $tmppkg $pkgname",
914 "Failed to transfer package $pkgname to $tmppkg"
915 );
916
917 if ( $config{compress} ) {
918 my $compress =
919 $config{usebzip}
920 ? 'bzip2 -%d -f %s'
921 : ($config{usepigz} ? 'pigz -%d -f %s' : 'gzip -%d -f %s');
922
923 vexec( sprintf( $compress, $config{ziplevel}, $tmppkg ), "Failed to compress $tmppkg" );
924 $tmppkg .= $config{usebzip} ? ".bz2" : ".gz";
925 }
926
927 vexec("mv $tmppkg $config{destdir}")
928 if $config{tmpdir} ne $config{destdir};
929
930 clean_spool;
931 }
932
933 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
934 # MAIN EXECUTION
935 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
936
937 process_arguments;
938
939 my $spec = parse $config{spec};
940 dumpenv( [], $spec ) if $config{dumpall};
941 dumpenv( $config{dumpvars}, $spec ) if @{ $config{dumpvars} };
942
943 my $protopath = create_files $spec;
944 make_package $protopath;
945 transfer_package if $config{transfer};
946
947 exit $exit{ok};
948
949 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
950 # USER GUIDE
951 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
952 __END__
953
954 =head1 NAME
955
956 mkpackage - Create one or more Solaris packages from a 'spec' file.
957
958 =head1 SYNOPSIS
959
960 mkpackage --spec <path> [--destdir <path>] [--workdir <path>]
961 [--spooldir <path>] [--pkgroot <path>] [--tmpdir <path>]
962 [--[no]transfer] [--[no]overwrite] [--[no]compress]
963 [--ziplevel N] [--usebzip] [--usepigz] [-v var=value...]
964 [--dump <var>|-dumpall] [--quiet] [--help] [--manual]
965 [--version]
966
967 =head1 DESCRIPTION
968
969 mkpackage is a tool for building one or more Solaris packages from a
970 specification file. This specification file determines the contents of each
971 package and the final name for the package. Command line options to mkpackage
972 control whether the package is I<transferred> from the Solaris spool directory
973 into a bitstream format, and whether that bitstream is compressed. The output
974 filename and directory for bitstream packages may also be configured.
975
976 =head1 OPTIONS
977
978 =head2 --spec,-s
979
980 Package specification file. This is the full path to the package specification
981 file. This is a required argument. See the SPEC FILE FORMAT section of the
982 documentation for more details.
983
984 =head2 --destdir,-d
985
986 Package destination directory. Full path to place bitstream packages after the
987 transfer stage. This path is ignored when --notransfer is set. (Default:
988 current working directory)
989
990 =head2 --workdir,-w
991
992 Working directory. Directory where all administrative and temporary packaging
993 files will be created. (Default: current working directory)
994
995 =head2 --spooldir,-p
996
997 Package spool directory. This option allows the default pkgmk spool directory
998 to be changed. (Default: /var/spool/pkg)
999
1000 =head2 --pkgbase,-b
1001
1002 Package base directory. This path will be passed to the pkgmk -b option when
1003 the package is created. (Default: none).
1004
1005 =head2 --pkgroot,-r
1006
1007 Package root directory. This path will be passed to the pkgmk -r option when
1008 the package is created. (Default: none).
1009
1010 =head2 --tmpdir,-t
1011
1012 Temporary directory. Where to create temporary files during the package build
1013 process. (Default: /tmp).
1014
1015 =head2 --[no]transfer
1016
1017 Enable or disable package transfer. By default, mkpackage creates bitstream
1018 format packages from contents using pkgtrans. Specifying --notransfer will
1019 cause the package to be left in the spool directory (See --spooldir).
1020
1021 =head2 --[no]overwrite
1022
1023 Enable or disable generated file overwrite. When generating package
1024 administrative files, the default behavior is to preserve any files that may
1025 already exist. Specifying --overwrite will regenerate files, overrwriting
1026 those that already exist.
1027
1028 =head2 --[no]compress
1029
1030 Enable or disable compression of bitstream packages. By default, bitstream
1031 packages created with mkpackage will not be compressed. Specifying --compress
1032 will compress the bitstream with gzip or, if --usebzip is specified, with
1033 bzip2. Either command is executed with -9 for minimum archive size. Note that
1034 this option is ignored when --notransfer is specified, as in this case no
1035 bistream package will be created.
1036
1037 =head2 --ziplevel,-z
1038
1039 Set compression level. Option accepts a single integer from 1 to 9.
1040 The meaning is the same as for -# gzip option. (Default: 9)
1041
1042 =head2 --usebzip
1043
1044 Enable bzip2 compression. Unless --nocompress and/or --notransfer options are
1045 specified, mkpackage will compress bitstream packages using gzip. Specifying
1046 --usebzip will use bzip2 instead, producing smaller archives in most cases.
1047
1048 =head2 --usepigz
1049
1050 Use pigz, a parallel implementation of gzip.
1051
1052 =head2 -v var=value
1053
1054 Build time variables. Specify one or more variable replacements for pkgmk
1055 during the package build stage. This option can be specified multiple times.
1056
1057 =head2 --dump,-D
1058
1059 Dump name=value pair of one or more environment variables to STDOUT after the
1060 spec is parsed. This option can be specified more than once to dump the
1061 values of multiple variables. The output format is suitable for use with
1062 shell C<eval> (if used with --quiet) so variables can be utilized in makefiles
1063 and scripts.
1064
1065 =head2 --dumpall,-A
1066
1067 Dump name=value pairs for all environment variables to STDOUT after the spec
1068 is parsed. Use --quiet to only print out the variable value (or list of
1069 variables).
1070
1071 =head2 --quiet,-q
1072
1073 Suppress all informational messages.
1074
1075 =head2 --help
1076
1077 Display brief usage.
1078
1079 =head2 --manual
1080
1081 Display manual page.
1082
1083 =head2 --version
1084
1085 Display version information.
1086
1087 =head1 SPEC FILE FORMAT
1088
1089 =head2 Directives
1090
1091 Directives are used to create the administrative files necessary to package
1092 software. Each directive must be prefixed with the C<%> character. Certain
1093 types of directives may take differing numbers of arguments. The most common
1094 type of directive accepts a content scheme, which determines how the next
1095 argument will be handled. These directives are of the following form:
1096
1097 %directive scheme argument
1098
1099 Where I<scheme> is one of the following:
1100
1101 =over 4
1102
1103 =item url
1104
1105 Insert the result of a URL request. Argument must be a well formed URI which
1106 is supported by libwww-perl. See the documentation for UserAgent for more
1107 details. Variable replacement will be done in the URL before the request is
1108 sent. Any unexpanded variables in the URL will be replaced with an empty
1109 string. Consider the following directive:
1110
1111 %copyright url file:///%{PWD}/LICENSE.txt
1112
1113 This directive fetches the specified URL resource, and uses the content as the
1114 package copyright file.
1115
1116 =item exec
1117
1118 Insert the output of a command. One or more arguments may be specified, which
1119 will be executed as a single command. For instance:
1120
1121 %prototype exec cswproto -v basedir=%{DESTDIR} %{DESTDIR}=/
1122
1123 This directive executes the C<cswproto> program, passing in the specified
1124 arguments, and uses the resulting content as the package prototype. Multiple
1125 commands can be chained together using pipelines:
1126
1127 %depend exec find %{DESTDIR} -type f | depmaker --noscript
1128
1129 Pipelines work identically in a spec file as they would on the command line,
1130 including support for redirection of standard streams.
1131
1132 =back
1133
1134 Content will be inserted into the spec as though it was specified in-line at
1135 that point in the file. For C<%pkginfo> directives, once the url or exec
1136 content is retrieved, any C<%{variables}> in the content are replaced.
1137 Variable replacement is also done on all %include directives and on any
1138 in-line content. For non-script type admin directives (e.g. %prototype,
1139 %depend), duplicate lines are removed from the output, preserving the overall
1140 %order of the file.
1141
1142 Any directive which takes an url or exec argument can also be specified
1143 without an argument. All non-directive lines in the spec file listed after
1144 the no-argument directive will be added to the specified administrative file,
1145 up to the next valid directive. For instance:
1146
1147 %depend
1148 P SUNWlibm
1149 %copyright
1150 Copyright 2006 Foomatic, Inc.
1151 All rights reserved.
1152
1153 The lines after the C<%depend> directive will be made part of the package
1154 depend file, and the C<%copyright> lines will be made part of the package
1155 copyright. Directives with and without scheme arguments can also be used
1156 multiple times in the same spec file:
1157
1158 %depend
1159 P CSWcommon - base directory structure
1160 %depend exec find %{DESTDIR} -type f | depmaker
1161
1162 This will add the static depend, and also append any dynamic dependencies
1163 generated by the C<%depend> exec directive.
1164
1165 =head2 Valid Directives
1166
1167 =over 4
1168
1169 =item checkinstall
1170
1171 =item compver
1172
1173 =item copyright
1174
1175 =item depend
1176
1177 =item pkginfo
1178
1179 =item postinstall
1180
1181 =item postremove
1182
1183 =item preinstall
1184
1185 =item preremove
1186
1187 =item prototype
1188
1189 =item request
1190
1191 =item space
1192
1193 These items follow the 'directive scheme' pattern, and create content for the
1194 package file of the same name. Items in this group also accept inline content
1195 directly in the spec file.
1196
1197 =item include
1198
1199 An %include directive inserts additional spec file content at a specific point
1200 in the calling spec file. This directive follows the 'directive scheme'
1201 pattern, but does not accept in-line content.
1202
1203 =item var
1204
1205 Directive C<%var> defines a new variable, which is then available for
1206 use by any spec line which follows the var declaration. Variable
1207 specifications may override other variables set in spec files prior to the var
1208 declaration. The format of a var declaration is:
1209
1210 %var variable value
1211
1212 Everything to the left of the variable name is assigned to that variable name,
1213 and may be referenced after the declaration as %{variable}. Leading and
1214 trailing whitespace characters are removed from the value. No quotes are
1215 necessary for values with embedded whitespace.
1216
1217 =item cvar
1218
1219 A C<%cvar> defines a new variable, but unlike C<%var>, if the variable name is
1220 already set, the new value will I<not> overwrite the old value. The syntax of
1221 the two var directives is identical.
1222
1223 =back
1224
1225 See the Solaris Package Administrator's Guide for more details regarding the
1226 purpose and content of each of the above admin file types. If the working
1227 directory contains the target file for any generated content, by default the
1228 contents of that file will be used, and the directive will be skipped. Use
1229 the --overwrite argument to change this behavior, and overwrite existing files
1230 with generated content.
1231
1232 =head2 Variable Replacement
1233
1234 There are three ways to get data from the outside world into a spec file. The
1235 first is to use the %var directive to explicitly set variables. The second is
1236 to set variables in the environment prior to calling mkpackage. When
1237 replacing %{variables} found in spec files, the environment is consulted for a
1238 variable of the same name. Consider the following spec file snippet:
1239
1240 %pkginfo url http://%{PACKAGE_SERVER}/admin/pkginfo.standard
1241 %pkginfo
1242 PSTAMP=%{LOGNAME}@%{HOSTNAME}-%{exec gdate -s '+%s'}
1243 %prototype exec find %{SPKG_BASEDIR} -cnewer %{TIMESTAMP}
1244
1245 Standard variables such as C<$LOGNAME> and C<$HOSTNAME> would be replaced into
1246 the C<%{LOGNAME}> and C<%{HOSTNAME}> placeholders from the environment.
1247 Other variables could be set explicitly in the spec, or in a spec included by
1248 this spec, or could be set in the environment by the caller. Any spec file
1249 variables that are not replaced at the end of processing will be replaced with
1250 an empty string. If the replacement results in an empty string, a warning will
1251 be emitted.
1252
1253 The final way to insert information into a spec is to use the embedded shell
1254 command replacement C<%{exec ...}>, as shown above. Commands included in the
1255 exec replacement will be executed, and the resultant output will be limited to
1256 the first line of standard output produced by the command. Leading and
1257 trailing whitespace will be removed. This command may be a pipeline, but may
1258 not contain any brace characters ({, or }).
1259
1260 =head2 Standard Variables
1261
1262 A standard set of variables are set in the environment by mkpackage itself,
1263 for use by spec files:
1264
1265 %{specname} - File name of this spec, without the .gspec suffix.
1266 %{destdir} - Full package destination path, as specified to --destdir.
1267 %{workdir} - Working directory, as specified to --workdir.
1268 %{spooldir} - Package spool directory, as specified to --spooldir.
1269 %{pkgroot} - Package root directory, as specified to --pkgroot.
1270 %{tmpdir} - Temporary directory, as specified to --tmpdir.
1271 %{prototype} - Path to the prototype file without administrative entries
1272
1273 B<NOTE:> %{prototype} cannot be used with %prototype directives.
1274
1275 There are also a couple of options which are not configurable via the command
1276 line. These are configurable only through spec files.
1277
1278 =over 4
1279
1280 =item %{pkgname}
1281
1282 This allows spec files to adjust the PKG name. By default, pkgname will be
1283 set to the file name of the main C<--spec>, without the .gspec extension. For
1284 instance, if your spec file is named CSWpackage.gspec, C<%{pkgname}> will
1285 initially be C<CSWpackage>.
1286
1287 =item %{pkgfile}
1288
1289 The C<%{pkgfile}> variable controls the name of the bitstream package to
1290 generate when C<--transfer> is enabled, without the compression extension, if
1291 any. By default, pkgfile will be set to C<%{pkgname}.pkg>.
1292
1293 =back
1294
1295 =head1 KNOWN ISSUES
1296
1297 Long lines in spec files cannot be broken with line continuation characters.
1298 So far, this has not been a problem, because parameterized paths are relatively
1299 short, and hairy command lines can be put in spec libraries so users don't have
1300 to deal with them.
1301
1302 This tool does not detect circular includes in spec files, so it is possible to
1303 create a spec file that will loop until the system runs out of memory. This is
1304 easy to avoid.
1305
1306 =head1 AUTHOR & COPYRIGHT
1307
1308 Copyright 2006 Cory Omand <comand@blastwave.org>
1309 All rights reserved. Use is subject to license terms.
1310
1311 Redistribution and/or use, with or without modification, is
1312 permitted. This software is without warranty of any kind. The
1313 author(s) shall not be liable in the event that use of the
1314 software causes damage.
1315
1316 =cut
1317

Properties

Name Value
svn:executable *