openpkg/dev.pl@a2c6460cfb16
openpkg/dev.pl
Mon, 28 Jan 2013 17:37:18 +0100
- author
- Michael Schloh von Bennewitz <michael@schloh.com>
- date
- Mon, 28 Jan 2013 17:37:18 +0100
- changeset 758
- a2c6460cfb16
- permissions
- -rw-r--r--
Correct socket error reporting improvement with IPv6 portable code,
after helpful recommendation by Saúl Ibarra Corretgé on OSips devlist.
1 ##
2 ## openpkg dev -- OpenPKG Package Development Tool
3 ## Copyright (c) 2008-2012 OpenPKG GmbH <http://openpkg.com/>
4 ##
5 ## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
6 ## All rights reserved. Licenses which grant limited permission to use,
7 ## copy, modify and distribute this software are available from the
8 ## OpenPKG GmbH.
9 ##
10 ## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
11 ## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
12 ## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
13 ## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
14 ## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
15 ## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
16 ## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
17 ## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
18 ## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
19 ## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
20 ## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
21 ## SUCH DAMAGE.
22 ##
24 require 5;
26 # OpenPKG instance prefix and RPM
27 my $openpkg_prefix = $ENV{'OPENPKG_PREFIX'};
28 delete $ENV{'OPENPKG_PREFIX'};
30 # program identification
31 my $prog_name = "dev";
32 my $prog_vers = "20100111";
34 # home-brewn getopt(3) style option parser
35 sub getopts ($$@) {
36 my ($opt_spec, $opts, @argv_orig) = @_;
37 my (%optf) = map { m/(\w)/; $1 => $_ } $opt_spec =~ m/(\w:|\w)/g;
38 my (@argv, $optarg);
40 foreach (@argv_orig) {
41 if (@argv) {
42 push @argv, $_;
43 } elsif (defined $optarg) {
44 if (exists $opts->{$optarg}) {
45 $opts->{$optarg} .= " $_";
46 } else {
47 $opts->{$optarg} = $_;
48 }
49 $optarg = undef;
50 } elsif (!/^[-]/) {
51 push @argv, $_;
52 } else {
53 while (/^\-(\w)(.*)/) {
54 if (exists $optf{$1}) {
55 if (length($optf{$1}) > 1) {
56 if ($2 ne '') {
57 if (exists $opts->{$1}) {
58 $opts->{$1} .= " $2";
59 } else {
60 $opts->{$1} = $2;
61 }
62 } else {
63 $optarg = $1;
64 }
65 last;
66 } else {
67 $opts->{$1} = 1;
68 }
69 } else {
70 warn "openpkg:$prog_name:WARNING: unknown option $_\n";
71 }
72 $_ = "-$2";
73 }
74 }
75 }
76 if (defined $optarg) {
77 warn "openpkg:$prog_name:WARNING: option $optarg requires an argument\n";
78 }
79 foreach my $opt (keys %optf) {
80 if (not exists $opts->{$opt}) {
81 $opts->{$opt} = (length($optf{$opt}) > 1 ? "" : 0);
82 }
83 }
84 return @argv;
85 }
87 # determine reasonable temporary directory
88 my $tmpdir = ($ENV{"TMPDIR"} || "/tmp");
89 $tmpdir .= "/openpkg-$prog_name-$$";
90 my $rc = system("umask 022; $openpkg_prefix/lib/openpkg/shtool mkdir -f -p -m 755 $tmpdir || exit $?");
91 if ($rc != 0) {
92 die "failed to create temporary directory: $tmpdir";
93 }
95 # parse command line options
96 my $opts = {};
97 @ARGV = getopts("h", $opts, @ARGV);
99 # usage sanity check and usage help
100 sub usage {
101 my ($rc) = @_;
102 my $usage =
103 "openpkg:$prog_name:USAGE: openpkg dev <command> [<options>]\n";
104 if ($rc == 0) {
105 print STDOUT $usage;
106 }
107 else {
108 print STDERR $usage;
109 }
110 exit($rc);
111 }
112 if ($opts->{"h"}) {
113 usage(0);
114 }
115 if (@ARGV == 0) {
116 usage(1);
117 }
119 # command map
120 my $map = {
121 "unpack " => { -alias => qr/^(up|ex)$/, -key => "x" },
122 "edit\n" => { -alias => qr/^(ed|vi)$/, -key => "v" },
123 "build -s track\n" => { -alias => qr/^(bt|tr)$/, -key => "t" },
124 "build -s fetch\n" => { -alias => qr/^(bf|fe)$/, -key => "f" },
125 "build\n" => { -alias => qr/^(ba|bu)$/, -key => "b" },
126 "build -s prep\n" => { -alias => qr/^bp$/, -key => "1" },
127 "build -s compile\n" => { -alias => qr/^bc$/, -key => "2" },
128 "build -s install\n" => { -alias => qr/^bi$/, -key => "3" },
129 "build -s binary\n" => { -alias => qr/^bb$/, -key => "4" },
130 "build -s source\n" => { -alias => qr/^bs$/, -key => "s" },
131 "peek\n" => { -alias => qr/^pe$/, -key => "p" },
132 "diff\n" => { -alias => qr/^di$/, -key => "d" },
133 "install\n" => { -alias => qr/^in(?:st)?$/, -key => "i" },
134 "erase\n" => { -alias => qr/^er$/, -key => "e" },
135 "lint\n" => { -alias => qr/^li$/, -key => "l" },
136 "release " => { -alias => qr/^rel?$/, -key => "r" },
137 };
139 # dispatch command
140 my $cmd = shift(@ARGV);
141 foreach my $c (keys %{$map}) {
142 my $a = $map->{$c}->{-alias};
143 if ($cmd =~ $a) {
144 $c =~ s/\n$//;
145 my @args = split(/\s+/, $c);
146 $cmd = shift(@args);
147 unshift(@ARGV, @args);
148 print STDOUT "\033[34m\$ opd $cmd " . join(" ", map {
149 my $x = $_;
150 $x =~ s/"/\\"/g;
151 $x =~ s/^(.*[ \t].*)$/"$1"/;
152 $x
153 } @ARGV) . "\033[0m\n";
154 }
155 }
156 my $func = "cmd_$cmd";
157 if (not defined(&$func)) {
158 print STDERR "openpkg:$prog_name:ERROR: invalid command \"$cmd\"\n";
159 usage(1);
160 }
161 my $rc = &$func($opts, @ARGV);
162 exit($rc);
164 # execute a shell command
165 sub run {
166 my ($cmd) = @_;
167 print STDOUT "\033[34m\$ $cmd\033[0m\n";
168 my $rc = system($cmd);
169 return $rc;
170 }
172 # determine path to package specification
173 sub specfile {
174 my $specfile = (glob("*.spec"))[0];
175 if (not defined $specfile) {
176 $specfile = (glob("src/*.spec"))[0];
177 if (not defined $specfile) {
178 $specfile = (glob("*/*.spec"))[0];
179 if (not defined $specfile) {
180 print STDERR "openpkg:$prog_name:ERROR: unable to determine package specification file\n";
181 exit(1);
182 }
183 }
184 }
185 return $specfile;
186 }
188 # command: interactive shell
189 sub cmd_shell ($@) {
190 my ($gopts, @argv) = @_;
191 my $rc = 0;
193 # command line argument processing
194 my $lopts = {};
195 @argv = getopts("s", $lopts, @argv);
197 # determine release
198 my $release = `$openpkg_prefix/bin/openpkg release -F '%t'`;
199 $release =~ s/\n$//s;
201 # create dot files
202 my $screenrc = "$tmpdir/dot.screenrc";
203 my $bashsh = "$tmpdir/bash.sh";
204 my $bashrc = "$tmpdir/dot.bashrc";
205 my $inputrc = "$tmpdir/dot.inputrc";
206 unlink("$screenrc");
207 unlink("$bashsh");
208 unlink("$bashrc");
209 unlink("$inputrc");
210 my $title = "openpkg dev";
211 $title .= '%? %{= rW} %n %{-}%?';
212 $title .= ' %=%-w%{= rW}%50>%n %t%{-}%+w';
213 my $screenrc_data = "";
214 $screenrc_data .= "source \"$ENV{HOME}/.screenrc\"\n" if (-f "$ENV{HOME}/.screenrc");
215 $screenrc_data .=
216 "escape ^Aa\n" .
217 "startup_message off\n" .
218 "vbell off\n" .
219 "defscrollback 10000\n" .
220 "defmonitor off\n" .
221 "msgminwait 1\n" .
222 "msgwait 1\n" .
223 "hardstatus alwayslastline \" $title \"\n" .
224 "shell $bashsh\n";
225 my $bashsh_data =
226 "##\n" .
227 "##\ bash.sh -- \"openpkg dev shell\" GNU bash wrapper script\n" .
228 "##\n" .
229 "\n" .
230 "OPENPKG_PREFIX=\"$openpkg_prefix\"\n" .
231 "export OPENPKG_PREFIX\n" .
232 "INPUTRC=\"$inputrc\"\n" .
233 "export INPUTRC\n" .
234 "SHELL=\"$openpkg_prefix/lib/openpkg/bash\"\n" .
235 "export SHELL\n" .
236 "eval `$openpkg_prefix/bin/openpkg rpm --eval 'T=\"\%{_tmppath}\"; S=\"\%{_specdir}\"; D=\"\%{_sourcedir}\"'`\n" .
237 "export T S D\n" .
238 "\$SHELL --rcfile $bashrc";
239 my $bashrc_data =
240 "##\n" .
241 "## dot.bashrc -- \"openpkg dev shell\" GNU bash configuration\n" .
242 "##\n" .
243 "\n" .
244 "# load user's standard bash run-command script\n" .
245 "if [ -f ~/.bashrc ]; then\n" .
246 " . ~/.bashrc\n" .
247 "fi\n" .
248 "\n" .
249 "# configure a special command-line prompt\n" .
250 "if [ \".\$TERM\" = .screen ]; then\n" .
251 " PS1=\"\\\\u@\\\\h:\\\\w [P=\\\\e[1m\\\${OPENPKG_PREFIX}\\\\e[0m]\\n\\\\\\\$ \\\\ek\\\\W\\\\e\\\\\\\\\"\n" .
252 "else\n" .
253 " PS1=\"\\\\u@\\\\h:\\\\w [P=\\\\e[1m\\\${OPENPKG_PREFIX}\\\\e[0m]\\n\\\\\\\$ \"\n" .
254 "fi\n" .
255 "alias openpkg=\"\\\${OPENPKG_PREFIX}/bin/openpkg\"\n" .
256 "alias opd=\"\\\${OPENPKG_PREFIX}/bin/openpkg dev\"\n" .
257 "\n";
258 my $inputrc_data =
259 "##\n" .
260 "## dot.inputrc -- \"openpkg dev shell\" GNU readline configuration\n" .
261 "##\n" .
262 "\n";
263 foreach my $c (keys %{$map}) {
264 my $k = $map->{$c}->{-key};
265 $c =~ s/\n/\\n/sg;
266 $inputrc_data .= "\"\\e$k\": \"opd $c\"\n";
267 }
268 $inputrc_data .= "\n";
269 open(SCREENRC, ">$screenrc");
270 print(SCREENRC $screenrc_data);
271 close(SCREENRC);
272 open(BASHSH, ">$bashsh");
273 print(BASHSH $bashsh_data);
274 close(BASHSH);
275 system("chmod a+x $bashsh");
276 open(BASHRC, ">$bashrc");
277 print(BASHRC $bashrc_data);
278 close(BASHRC);
279 open(INPUTRC, ">$inputrc");
280 print(INPUTRC $inputrc_data);
281 close(INPUTRC);
283 # run interactive shell
284 print STDOUT "\033[34m++ entering OpenPKG $release development shell\033[0m\n";
285 my $rc;
286 if ($lopts->{"s"}) {
287 $rc = system("screen -c $screenrc -S 'openpkg-dev-shell' -d -R");
288 }
289 else {
290 $rc = system("$bashsh");
291 }
293 # cleanup
294 unlink("$tmpdir/dot.screenrc");
295 unlink("$tmpdir/bash.sh");
296 unlink("$tmpdir/dot.bashrc");
297 unlink("$tmpdir/dot.inputrc");
298 unlink("$tmpdir");
300 return $rc;
301 }
303 # command: unpack source RPM
304 sub cmd_unpack ($@) {
305 my ($gopts, @argv) = @_;
306 my $rc = 0;
308 # command line argument processing
309 my $lopts = {};
310 @argv = getopts("l:b:sd", $lopts, @argv);
311 if ($lopts->{"l"} eq "") {
312 $lopts->{"l"} = "structured";
313 }
314 if ($lopts->{"l"} !~ m/^(global|local|simple|structured|distributed)$/) {
315 die sprintf("invalid layout type \"%s\"", $lopts->{"l"});
316 }
317 if (@argv != 1) {
318 die sprintf("exactly one SRPM has to be given");
319 }
320 my $srpm = $argv[0];
321 if (not -f $srpm) {
322 die sprintf("SRPM \"%s\" has to be a regular file", $srpm);
323 }
324 my $name = `$openpkg_prefix/bin/openpkg rpm -qp --qf '\%{NAME}' $srpm 2>/dev/null || true`;
325 $name =~ s/\r?\n$//s;
326 if ($name eq '') {
327 die sprintf("unable to determine package name from SRPM \"%s\"", $srpm);
328 }
329 if ($lopts->{"b"} eq "") {
330 $lopts->{"b"} = $srpm;
331 if ($lopts->{"b"} =~ m/\.src\.rpm$/) {
332 $lopts->{"b"} =~ s/\.src\.rpm$//;
333 }
334 else {
335 my $subdir = `$openpkg_prefix/bin/openpkg rpm -qp --qf '\%{NAME}-\%{VERSION}-\%{RELEASE}' $srpm 2>/dev/null || true`;
336 $lopts->{"b"} = $subdir;
337 }
338 }
340 # determine result directory
341 my $basedir = $lopts->{"b"};
342 my ($macrosfile, $specdir, $sourcedir);
343 if ($lopts->{"l"} eq "global") {
344 $macrosdir = "$openpkg_prefix/etc/openpkg";
345 $macrosfile = "$openpkg_prefix/etc/openpkg/rpmmacros";
346 $specdir = "$openpkg_prefix/RPM/SRC/$name";
347 $sourcedir = "$openpkg_prefix/RPM/SRC/$name";
348 $builddir = "$openpkg_prefix/RPM/TMP";
349 $tmpdir = "$openpkg_prefix/RPM/TMP";
350 $binrpmdir = "$openpkg_prefix/RPM/PKG";
351 $srcrpmdir = "$openpkg_prefix/RPM/PKG";
352 }
353 elsif ($lopts->{"l"} eq "local") {
354 $macrosdir = "$basedir/.openpkg";
355 $macrosfile = "$basedir/.openpkg/rpmmacros";
356 $specdir = "$basedir";
357 $sourcedir = "$basedir";
358 $builddir = "$basedir";
359 $tmpdir = "$basedir";
360 $binrpmdir = "$basedir";
361 $srcrpmdir = "$basedir";
362 }
363 elsif ($lopts->{"l"} eq "simple") {
364 $macrosdir = "$basedir/.openpkg";
365 $macrosfile = "$basedir/.openpkg/rpmmacros";
366 $specdir = "$basedir";
367 $sourcedir = "$basedir";
368 $builddir = "$tmpdir";
369 $tmpdir = "$tmpdir";
370 $binrpmdir = "$basedir/..";
371 $srcrpmdir = "$basedir/..";
372 }
373 elsif ($lopts->{"l"} eq "structured") {
374 $macrosdir = "$basedir/.openpkg";
375 $macrosfile = "$basedir/.openpkg/rpmmacros";
376 $specdir = "$basedir/src";
377 $sourcedir = "$basedir/dst";
378 $builddir = "$basedir/tmp";
379 $tmpdir = "$basedir/tmp";
380 $binrpmdir = "$basedir/pkg/bin";
381 $srcrpmdir = "$basedir/pkg/src";
382 }
383 elsif ($lopts->{"l"} eq "distributed") {
384 $macrosdir = "$basedir/.openpkg";
385 $macrosfile = "$basedir/.openpkg/rpmmacros";
386 $specdir = "$basedir/src/$name";
387 $sourcedir = "$basedir/dst/$name";
388 $builddir = "$basedir/tmp";
389 $tmpdir = "$basedir/tmp";
390 $binrpmdir = "$basedir/pkg/bin";
391 $srcrpmdir = "$basedir/pkg/src";
392 }
394 # create still missing directories
395 foreach my $dir ($macrosdir, $specdir, $sourcedir, $builddir, $tmpdir, $binrpmdir, $srcrpmdir) {
396 if (not -d $dir) {
397 print STDOUT "openpkg:$prog_name: creating directory \"$dir\"\n";
398 system("$openpkg_prefix/lib/openpkg/shtool mkdir -f -p -m 755 $dir");
399 }
400 }
402 # unpack SRPM
403 print STDOUT "openpkg:$prog_name: unpacking source: \"$srpm\"\n";
404 print STDOUT "openpkg:$prog_name: unpacking target: \"$specdir\"\n";
405 print STDOUT "openpkg:$prog_name: unpacking target: \"$sourcedir\"\n";
406 my $abs_specdir = $specdir;
407 my $abs_sourcedir = $sourcedir;
408 my $pwd = `pwd`; $pwd =~ s/\r?\n$//s;
409 $abs_specdir = "$pwd/$abs_specdir" if ($abs_specdir !~ m/^\//);
410 $abs_sourcedir = "$pwd/$abs_sourcedir" if ($abs_sourcedir !~ m/^\//);
411 my $rc = system(
412 "$openpkg_prefix/bin/openpkg" .
413 " --keep-privileges" .
414 " rpm" .
415 " -i" .
416 " --define '_specdir $abs_specdir'" .
417 " --define '_sourcedir $abs_sourcedir'" .
418 " $srpm"
419 );
421 # fix location of files
422 if (not -f "$specdir/$name.spec") {
423 die sprintf("failed to install package \"%s\": file \"%s\" not found\n", $srpm, "$specdir/$name.spec");
424 }
425 open(SPEC, "<$specdir/$name.spec");
426 my $spec = ""; { local $/; $spec = <SPEC>; }
427 close(SPEC);
428 my $src = {};
429 $spec =~ s/^(?:Source|Patch)\d+:\s+(\S+)/$src->{$1} = 1, ''/mgei;
430 foreach my $file (keys %{$src}) {
431 if ($file !~ m/^(https?|ftp):\/\//) {
432 if (not -f "$specdir/$file" and -f "$sourcedir/$file") {
433 system("mv $sourcedir/$file $specdir/$file");
434 }
435 }
436 }
438 # create .openpkg/rpmmacros file
439 if (not -f $macrosfile) {
440 print STDOUT "openpkg:$prog_name: creating file: \"$macrosfile\"\n";
441 my $rpmmacros =
442 "##\n" .
443 "## .openpkg/rpmmacros -- local OpenPKG RPM macro definitions\n" .
444 "##\n" .
445 "\n" .
446 "\%openpkg_layout" .
447 " macrosfile=\%{macrosfile}" .
448 " layout=" . $lopts->{"l"} .
449 " shared=" . ($lopts->{"s"} ? "yes" : "no") .
450 " debug=" . ($lopts->{"d"} ? "yes" : "no") .
451 "\n" .
452 "\n";
453 open(MACROS, ">$macrosfile");
454 print(MACROS $rpmmacros);
455 close(MACROS);
456 }
458 return $rc;
459 }
461 # command: edit package specification
462 sub cmd_edit ($@) {
463 my ($gopts, @argv) = @_;
464 my $rc = 0;
466 # run editor
467 my $editor = ($ENV{"EDITOR"} || "vi");
468 my $specfile = ($argv[0] || specfile());
469 run("$editor $specfile");
471 return $rc;
472 }
474 # command: build package
475 sub cmd_build ($@) {
476 my ($gopts, @argv) = @_;
477 my $rc = 0;
479 # command line argument processing
480 my $lopts = {};
481 @argv = getopts("s:D:w:", $lopts, @argv);
482 if ($lopts->{"s"} eq '') {
483 $lopts->{"s"} = "all";
484 }
485 if ($lopts->{"s"} !~ m/^(track|fetch|prep|compile|install|binary|source|all)$/) {
486 die "invalid step";
487 }
489 # assembly defines
490 my $defs = "";
491 if ($lopts->{"D"}) {
492 foreach my $def (split(/\s+/, $lopts->{"D"})) {
493 if ($def =~ m/^([^=]+)=(.+)$/) {
494 $defs .= "--define '$1 $2' ";
495 }
496 else {
497 $defs .= "--define '$def yes' ";
498 }
499 }
500 }
501 if ($lopts->{"w"}) {
502 foreach my $def (split(/\s+/, $lopts->{"w"})) {
503 $defs .= "--with $def ";
504 }
505 }
507 # run build command
508 my $specfile = ($argv[0] || specfile());
509 if ($lopts->{"s"} eq 'track') {
510 run("$openpkg_prefix/bin/openpkg rpm -bt $defs$specfile");
511 }
512 elsif ($lopts->{"s"} eq 'fetch') {
513 run("$openpkg_prefix/bin/openpkg rpm -bf $defs$specfile");
514 }
515 elsif ($lopts->{"s"} eq 'prep') {
516 run("$openpkg_prefix/bin/openpkg rpm -bp $defs$specfile");
517 }
518 elsif ($lopts->{"s"} eq 'compile') {
519 run("$openpkg_prefix/bin/openpkg rpm -bc --short-circuit $defs$specfile");
520 }
521 elsif ($lopts->{"s"} eq 'install') {
522 run("$openpkg_prefix/bin/openpkg rpm -bi --short-circuit $defs$specfile");
523 }
524 elsif ($lopts->{"s"} eq 'binary') {
525 run("$openpkg_prefix/bin/openpkg rpm -bb --short-circuit $defs$specfile");
526 }
527 elsif ($lopts->{"s"} eq 'source') {
528 run("$openpkg_prefix/bin/openpkg rpm -bs $defs$specfile");
529 }
530 elsif ($lopts->{"s"} eq 'all') {
531 run("$openpkg_prefix/bin/openpkg rpm -ba $defs$specfile");
532 }
534 return $rc;
535 }
537 # command: peek into package
538 sub cmd_peek ($@) {
539 my ($gopts, @argv) = @_;
540 my $rc = 0;
542 # run query command
543 my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{_rpmfilename}'`;
544 $template =~ s/\n$//s;
545 my $specfile = specfile();
546 my $rpm = `$openpkg_prefix/bin/openpkg rpm -q --specfile '$specfile' --qf 'XXX$template'`;
547 $rpm =~ s/^XXX//s;
548 $rpm =~ s/\n$//s;
550 # determine files
551 print STDOUT "\033[34m++ determining configuration files\033[0m\n";
552 my @cfgfiles = split(/\n/, `$openpkg_prefix/bin/openpkg rpm -qplc $rpm`);
553 print STDOUT "\033[34m++ determining documentation files\033[0m\n";
554 my @docfiles = split(/\n/, `$openpkg_prefix/bin/openpkg rpm -qpld $rpm`);
555 print STDOUT "\033[34m++ determining all file information\033[0m\n";
556 my @allfiles = split(/\n/, `$openpkg_prefix/bin/openpkg rpm -qplv $rpm`);
558 # create package file listing
559 foreach my $line (@allfiles) {
560 $prefix = "";
561 foreach my $docfile (@docfiles) {
562 if ($line =~ m/\s+$docfile\b/s) {
563 $prefix .= "D";
564 last;
565 }
566 }
567 foreach my $cfgfile (@cfgfiles) {
568 if ($line =~ m/\s+$cfgfile\b/s) {
569 $prefix .= "C";
570 last;
571 }
572 }
573 $prefix .= "--";
574 $prefix = substr($prefix, 0, 2);
575 if ($line =~ m/^d/) {
576 $line =~ s/(\s+\/\S+)/\033[34m$1\033[0m/s;
577 }
578 print "$prefix $line\n";
579 }
581 return $rc;
582 }
584 # command: show modifications via VCS
585 sub cmd_diff ($@) {
586 my ($gopts, @argv) = @_;
587 my $rc = 0;
589 my $vcs = "";
590 my $cmd = "";
591 if (-d "CVS") {
592 $vcs = "CVS";
593 $cmd = "cvs diff -u3";
594 }
595 elsif (-d ".svn") {
596 $vcs = "Subversion";
597 $cmd = "svn diff";
598 }
599 elsif (-d "_MTN" or -d ".mtn" or
600 -d "../_MTN" or -d "../.mtn" or
601 -d "../../_MTN" or -d "../../.mtn" or
602 -d "../../../_MTN" or -d "../../../.mtn") {
603 $vcs = "Monotone";
604 $cmd = "mtn diff .";
605 }
606 elsif (-d ".git" or
607 -d "../.git" or
608 -d "../../.git" or
609 -d "../../../.git") {
610 $vcs = "Git";
611 $cmd = "git diff . ";
612 }
613 elsif (-d ".hg" or
614 -d "../.hg" or
615 -d "../../.hg" or
616 -d "../../../.hg") {
617 $vcs = "Mercurial";
618 $cmd = "hg diff ."
619 }
620 else {
621 $vcs = "OSSP svs";
622 $cmd = "svs diff";
623 }
624 print STDOUT "\033[34m++ modifications as known to underlying $vcs VCS\033[0m\n";
625 run($cmd);
626 }
628 # command: install package
629 sub cmd_install ($@) {
630 my ($gopts, @argv) = @_;
631 my $rc = 0;
633 # command line argument processing
634 my $lopts = {};
635 @argv = getopts("fnos", $lopts, @argv);
637 # run install command
638 my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{_rpmfilename}'`;
639 $template =~ s/\n$//s;
640 my $specfile = specfile();
641 my $rpm = `$openpkg_prefix/bin/openpkg rpm -q --specfile '$specfile' --qf 'XXX$template'`;
642 $rpm =~ s/^XXX//s;
643 $rpm =~ s/\n$//s;
644 chdir("/");
645 run(($lopts->{"s"} ? "sudo " : "") .
646 "$openpkg_prefix/bin/openpkg rpm -Uvh"
647 . ($lopts->{"f"} ? " --force" : "")
648 . ($lopts->{"n"} ? " --nodeps" : "")
649 . ($lopts->{"o"} ? " --oldpackage" : "")
650 . " $rpm");
652 return $rc;
653 }
655 # command: erase package
656 sub cmd_erase ($@) {
657 my ($gopts, @argv) = @_;
658 my $rc = 0;
660 # command line argument processing
661 my $lopts = {};
662 @argv = getopts("fnas", $lopts, @argv);
664 # run erase command
665 my $specfile = specfile();
666 my $name = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '%{NAME}'`;
667 $name =~ s/\n$//s;
668 chdir("/");
669 run(($lopts->{"s"} ? "sudo " : "") .
670 "$openpkg_prefix/bin/openpkg rpm -e"
671 . ($lopts->{"f"} ? " --force" : "")
672 . ($lopts->{"n"} ? " --nodeps" : "")
673 . ($lopts->{"a"} ? " --allmatches" : "")
674 . " $name");
676 return $rc;
677 }
679 # command: lint package
680 sub cmd_lint ($@) {
681 my ($gopts, @argv) = @_;
682 my $rc = 0;
684 # command line argument processing
685 my $lopts = {};
686 @argv = getopts("vb", $lopts, @argv);
688 # run source linting commands
689 my $specfile = specfile();
690 my $fslfile = $specfile;
691 $fslfile =~ s/([^\/]+)\.spec$/fsl.$1/s;
692 my $rcfile = $specfile;
693 $rcfile =~ s/([^\/]+)\.spec$/rc.$1/s;
694 my $name = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '%{NAME}'`;
695 $name =~ s/\n$//s;
696 my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{_rpmfilename}'`;
697 $template =~ s/\n$//s;
698 my $rpm = `$openpkg_prefix/bin/openpkg rpm -q --specfile '$specfile' --qf 'XXX$template'`;
699 $rpm =~ s/^XXX//s;
700 $rpm =~ s/\n$//s;
701 my $rc = 0;
702 $rc += run("$openpkg_prefix/bin/openpkg lint-spec" . ($lopts->{"v"} ? " --verbose" : "") . " $specfile");
703 $rc += run("$openpkg_prefix/bin/openpkg lint-fsl" . ($lopts->{"v"} ? " --verbose" : "") . " $fslfile") if (-f $fslfile);
704 $rc += run("$openpkg_prefix/bin/openpkg lint-rc" . ($lopts->{"v"} ? " --verbose" : "") . " $rcfile") if (-f $rcfile);
706 # optionally run binary linting command
707 run("$openpkg_prefix/bin/openpkg lint-rpm" . ($lopts->{"v"} ? " --verbose" : "") . " $rpm") if (-f $rpm and not $lopts->{"b"});
709 return $rc;
710 }
712 # command: release package
713 sub cmd_release ($@) {
714 my ($gopts, @argv) = @_;
715 my $rc = 0;
717 # command line argument processing
718 my $lopts = {};
719 @argv = getopts("nm:f", $lopts, @argv);
721 # implicit linting
722 if (not $lopts->{"f"}) {
723 my $rc = cmd_lint($gopts);
724 if ($rc != 0 and !$lopts->{"f"}) {
725 return $rc;
726 }
727 }
729 # sanity check environment
730 my $cmd = $ENV{"OPENPKG_DEV_RELEASE"}
731 || `$openpkg_prefix/bin/openpkg rpm --eval '%{openpkg_dev_release}' 2>/dev/null || true` || "";
732 $cmd =~ s/\n$//s;
733 if ($cmd eq "") {
734 print STDERR "openpkg:$prog_name:ERROR: no \$OPENPKG_DEV_RELEASE command defined\n";
735 exit(1);
736 }
738 #
739 # determine package information
740 #
742 print STDOUT "\033[34m++ determining package information\033[0m\n";
743 my $info = {};
744 $info->{"openpkg-prefix"} = $openpkg_prefix;
745 $info->{"option-force"} = $lopts->{"f"} ? "yes" : "no";
747 print STDOUT "-- determining package name/version/release\n";
748 my $specfile = specfile();
749 my $result = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '::%{NAME}::%{VERSION}::%{RELEASE}'`;
750 $result =~ s/\n$//s;
751 $result =~ s/^:://s;
752 my @result = split(/::/, $result);
753 $info->{"package-name"} = $result[0];
754 $info->{"package-version"} = $result[1];
755 $info->{"package-release"} = $result[2];
757 print STDOUT "-- determining package source and distribution location\n";
758 my $defines = "--define '\%name " . $info->{"package-name"} . "'";
759 $defines .= " --define '\%version " . $info->{"package-version"} . "'";
760 $defines .= " --define '\%release " . $info->{"package-release"} . "'";
761 my $result = `$openpkg_prefix/bin/openpkg rpm $defines --eval '%{_specdir}::%{_sourcedir}'`;
762 $result =~ s/\n$//s;
763 @result = split(/::/, $result);
764 $info->{"spec-dir"} = $result[0];
765 $info->{"source-dir"} = $result[1];
767 print STDOUT "-- determining package source and binary RPM files\n";
768 my $template = `$openpkg_prefix/bin/openpkg rpm --eval '%{_rpmdir}/%{l_binrpmfilename}::%{_srcrpmdir}/%{l_srcrpmfilename}'`;
769 $template =~ s/\n$//s;
770 $result = `$openpkg_prefix/bin/openpkg rpm -q --specfile $specfile --qf '::$template'`;
771 $result =~ s/\n$//s;
772 $result =~ s/^:://s;
773 @result = split(/::/, $result);
774 $info->{"binary-rpm-file"} = $result[0];
775 $info->{"source-rpm-file"} = $result[1];
776 $info->{"package-version-old"} = "";
777 $info->{"package-release-old"} = "";
778 $info->{"vcs"} = "none";
780 print STDOUT "-- determining previous package version/release\n";
781 my $vcs = "";
782 my $diff = "";
783 my $content_old = "";
784 my $specdir = $info->{"spec-dir"};
785 my $specfile = $info->{"package-name"} . ".spec";
786 if (-f "$specdir/$specfile") {
787 open(FP, "<$specdir/$specfile");
788 $content_new .= $_ while (<FP>);
789 close(FP);
790 if ($content_new =~ m/\n\%No(?:Source|Patch)\s+/s) {
791 $info->{"source-rpm-file"} =~ s/\.src\.rpm$/.nosrc.rpm/s;
792 }
793 if (-d "$specdir/CVS") {
794 # package is version controlled via CVS
795 $vcs = "cvs";
796 $diff = `(cd $specdir && cvs diff -u3 $specfile) 2>/dev/null || true`;
797 }
798 elsif (-d "$specdir/.svn") {
799 # package is version controlled via Subverson (SVN)
800 $vcs = "svn";
801 $diff = `(cd $specdir && svn diff $specfile) 2>/dev/null || true`;
802 }
803 elsif (-d "$specdir/_MTN" or -d "$specdir/.mtn" or
804 -d "$specdir/../_MTN" or -d "$specdir/../.mtn" or
805 -d "$specdir/../../_MTN" or -d "$specdir/../../.mtn" or
806 -d "$specdir/../../../_MTN" or -d "$specdir/../../../.mtn") {
807 # package is version controlled via Monotone (MTN)
808 $vcs = "mtn";
809 $diff = `(cd $specdir && mtn diff $specfile) 2>/dev/null || true`;
810 $content_old = `(cd $specdir && mtn automate get_file_of -r h: $specfile) 2>/dev/null || true`;
811 }
812 elsif (-d "$specdir/.git" or
813 -d "$specdir/../.git" or
814 -d "$specdir/../../.git" or
815 -d "$specdir/../../../.git") {
816 # package is version controlled via Git
817 $vcs = "git";
818 $diff = `(cd $specdir && git diff $specfile) 2>/dev/null || true`;
819 }
820 elsif (-d "$specdir/.hg" or
821 -d "$specdir/../.hg" or
822 -d "$specdir/../../.hg" or
823 -d "$specdir/../../../.hg") {
824 # package is version controlled via Mercurial (Hg)
825 $vcs = "hg";
826 $diff = `(cd $specdir && hg diff $specfile) 2>/dev/null || true`;
827 }
828 elsif (-f "$specdir/$specfile.orig") {
829 # package is patched via OSSP svs
830 $vcs = "svs";
831 $diff = `(cd $specdir && svs diff $specfile) 2>/dev/null || true`;
832 }
833 if ($vcs ne '') {
834 $info->{"vcs"} = $vcs;
835 }
836 if ($content_old ne '') {
837 my $define = {};
838 $content_old =~ s/\n\%define[ \t]+([^ \t\n]+)[ \t]+([^ \t\n]+)/$define->{$1} = $2, ''/sge;
839 $content_old =~ s/\n([^ \t\n]+):[ \t]+([^ \t\n]+)/$define->{lc($1)} = $2, ''/sge;
840 sub resolve {
841 my ($define, $name) = @_;
842 my $value = $define->{$name};
843 $value = "" if (not defined $value);
844 $value =~ s/\%\{(.+?)\}/resolve($define, $1)/sge;
845 return $value;
846 }
847 $info->{"package-version-old"} = resolve($define, "version");
848 $info->{"package-release-old"} = resolve($define, "release");
849 }
850 if (( $info->{"package-version-old"} eq ''
851 or $info->{"package-release-old"} eq '')
852 and $diff ne '' ) {
853 if ($info->{"package-version-old"} eq '' and $diff =~ m/\n-Version:\s+(\S+)/s) {
854 $info->{"package-version-old"} = $1;
855 }
856 if ($info->{"package-release-old"} eq '' and $diff =~ m/\n-Release:\s+(\S+)/s) {
857 $info->{"package-release-old"} = $1;
858 }
859 }
860 }
862 print STDOUT "-- determining commit message\n";
863 $info->{"commit-message"} = ($lopts->{"m"} || "");
864 if ($info->{"commit-message"} eq "") {
865 if ($info->{"package-version-old"} ne $info->{"package-version"}) {
866 # new version
867 $info->{"commit-message"} = "upgrading package: " .
868 $info->{"package-name"} . " " .
869 $info->{"package-version-old"} . " -> " .
870 $info->{"package-version"};
871 }
872 elsif (!$lopts->{"f"}) {
873 print STDERR "openpkg:$prog_name:ERROR: package version not changed -- you have to manually provide a commit message\n";
874 exit(1);
875 }
876 }
878 # run external command
879 print STDOUT "\033[34m++ executing openpkg development release program\033[0m\n";
880 $cmd .= " %{openpkg-prefix}";
881 $cmd .= " %{spec-dir} %{source-dir} %{binary-rpm-file} %{source-rpm-file}";
882 $cmd .= " %{package-name} %{package-version} %{package-release} %{package-version-old} %{package-release-old}";
883 $cmd .= " %{commit-message} %{vcs}";
884 $cmd .= " %{option-force}";
885 $cmd =~ s/(\%\{([a-z][a-z-]+)\})/&subst($info, $1, $2)/sge;
886 sub subst {
887 my ($info, $text, $name) = @_;
888 if (exists($info->{$name})) {
889 $text = $info->{$name};
890 $text =~ s/'/\\'/sg;
891 $text = "'$text'";
892 }
893 }
894 if ($lopts->{"n"}) {
895 print STDOUT "-- DRY RUN:\n";
896 print STDOUT "-- $cmd\n";
897 $rc = 0;
898 }
899 else {
900 $rc = system($cmd);
901 }
903 return $rc;
904 }
