comparison: openpkg/dev.pl
openpkg/dev.pl
- changeset 711
- e5faec28ec63
equal
deleted
inserted
replaced
| -1:000000000000 | 0:9256ecc14ff9 |
|---|---|
| 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 ## | |
| 23 | |
| 24 require 5; | |
| 25 | |
| 26 # OpenPKG instance prefix and RPM | |
| 27 my $openpkg_prefix = $ENV{'OPENPKG_PREFIX'}; | |
| 28 delete $ENV{'OPENPKG_PREFIX'}; | |
| 29 | |
| 30 # program identification | |
| 31 my $prog_name = "dev"; | |
| 32 my $prog_vers = "20100111"; | |
| 33 | |
| 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); | |
| 39 | |
| 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 } | |
| 86 | |
| 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 } | |
| 94 | |
| 95 # parse command line options | |
| 96 my $opts = {}; | |
| 97 @ARGV = getopts("h", $opts, @ARGV); | |
| 98 | |
| 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 } | |
| 118 | |
| 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 }; | |
| 138 | |
| 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); | |
| 163 | |
| 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 } | |
| 171 | |
| 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 } | |
| 187 | |
| 188 # command: interactive shell | |
| 189 sub cmd_shell ($@) { | |
| 190 my ($gopts, @argv) = @_; | |
| 191 my $rc = 0; | |
| 192 | |
| 193 # command line argument processing | |
| 194 my $lopts = {}; | |
| 195 @argv = getopts("s", $lopts, @argv); | |
| 196 | |
| 197 # determine release | |
| 198 my $release = `$openpkg_prefix/bin/openpkg release -F '%t'`; | |
| 199 $release =~ s/\n$//s; | |
| 200 | |
| 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); | |
| 282 | |
| 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 } | |
| 292 | |
| 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"); | |
| 299 | |
| 300 return $rc; | |
| 301 } | |
| 302 | |
| 303 # command: unpack source RPM | |
| 304 sub cmd_unpack ($@) { | |
| 305 my ($gopts, @argv) = @_; | |
| 306 my $rc = 0; | |
| 307 | |
| 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 } | |
| 339 | |
| 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 } | |
| 393 | |
| 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 } | |
| 401 | |
| 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 ); | |
| 420 | |
| 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 } | |
| 437 | |
| 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 } | |
| 457 | |
| 458 return $rc; | |
| 459 } | |
| 460 | |
| 461 # command: edit package specification | |
| 462 sub cmd_edit ($@) { | |
| 463 my ($gopts, @argv) = @_; | |
| 464 my $rc = 0; | |
| 465 | |
| 466 # run editor | |
| 467 my $editor = ($ENV{"EDITOR"} || "vi"); | |
| 468 my $specfile = ($argv[0] || specfile()); | |
| 469 run("$editor $specfile"); | |
| 470 | |
| 471 return $rc; | |
| 472 } | |
| 473 | |
| 474 # command: build package | |
| 475 sub cmd_build ($@) { | |
| 476 my ($gopts, @argv) = @_; | |
| 477 my $rc = 0; | |
| 478 | |
| 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 } | |
| 488 | |
| 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 } | |
| 506 | |
| 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 } | |
| 533 | |
| 534 return $rc; | |
| 535 } | |
| 536 | |
| 537 # command: peek into package | |
| 538 sub cmd_peek ($@) { | |
| 539 my ($gopts, @argv) = @_; | |
| 540 my $rc = 0; | |
| 541 | |
| 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; | |
| 549 | |
| 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`); | |
| 557 | |
| 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 } | |
| 580 | |
| 581 return $rc; | |
| 582 } | |
| 583 | |
| 584 # command: show modifications via VCS | |
| 585 sub cmd_diff ($@) { | |
| 586 my ($gopts, @argv) = @_; | |
| 587 my $rc = 0; | |
| 588 | |
| 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 } | |
| 627 | |
| 628 # command: install package | |
| 629 sub cmd_install ($@) { | |
| 630 my ($gopts, @argv) = @_; | |
| 631 my $rc = 0; | |
| 632 | |
| 633 # command line argument processing | |
| 634 my $lopts = {}; | |
| 635 @argv = getopts("fnos", $lopts, @argv); | |
| 636 | |
| 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"); | |
| 651 | |
| 652 return $rc; | |
| 653 } | |
| 654 | |
| 655 # command: erase package | |
| 656 sub cmd_erase ($@) { | |
| 657 my ($gopts, @argv) = @_; | |
| 658 my $rc = 0; | |
| 659 | |
| 660 # command line argument processing | |
| 661 my $lopts = {}; | |
| 662 @argv = getopts("fnas", $lopts, @argv); | |
| 663 | |
| 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"); | |
| 675 | |
| 676 return $rc; | |
| 677 } | |
| 678 | |
| 679 # command: lint package | |
| 680 sub cmd_lint ($@) { | |
| 681 my ($gopts, @argv) = @_; | |
| 682 my $rc = 0; | |
| 683 | |
| 684 # command line argument processing | |
| 685 my $lopts = {}; | |
| 686 @argv = getopts("vb", $lopts, @argv); | |
| 687 | |
| 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); | |
| 705 | |
| 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"}); | |
| 708 | |
| 709 return $rc; | |
| 710 } | |
| 711 | |
| 712 # command: release package | |
| 713 sub cmd_release ($@) { | |
| 714 my ($gopts, @argv) = @_; | |
| 715 my $rc = 0; | |
| 716 | |
| 717 # command line argument processing | |
| 718 my $lopts = {}; | |
| 719 @argv = getopts("nm:f", $lopts, @argv); | |
| 720 | |
| 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 } | |
| 728 | |
| 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 } | |
| 737 | |
| 738 # | |
| 739 # determine package information | |
| 740 # | |
| 741 | |
| 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"; | |
| 746 | |
| 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]; | |
| 756 | |
| 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]; | |
| 766 | |
| 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"; | |
| 779 | |
| 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 } | |
| 861 | |
| 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 } | |
| 877 | |
| 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 } | |
| 902 | |
| 903 return $rc; | |
| 904 } | |
| 905 |
