usr.sbin/pkg_install/version/pkg_version.pl

   1 #! /usr/bin/perl
   2 #
   3 # Copyright 1998 Bruce A. Mah
   4 #
   5 # All rights reserved.
   6 #
   7 # Redistribution and use in source and binary forms, with or without
   8 # modification, are permitted provided that the following conditions
   9 # are met:
  10 # 1. Redistributions of source code must retain the above copyright
  11 #    notice, this list of conditions and the following disclaimer.
  12 # 2. Redistributions in binary form must reproduce the above copyright
  13 #    notice, this list of conditions and the following disclaimer in the
  14 #    documentation and/or other materials provided with the distribution.
  15 #
  16 # THIS SOFTWARE IS PROVIDED BY THE DEVELOPERS ``AS IS'' AND ANY EXPRESS OR
  17 # IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  18 # OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  19 # IN NO EVENT SHALL THE DEVELOPERS BE LIABLE FOR ANY DIRECT, INDIRECT,
  20 # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  21 # NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  22 # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  23 # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  24 # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  25 # THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  26 #
  27 # pkg_version.pl
  28 #
  29 # A package version-checking utility for FreeBSD.
  30 #
  31 # $FreeBSD: src/usr.sbin/pkg_install/version/pkg_version.pl,v 1.4.2.14 2002/06/03 15:34:59 bmah Exp $
  32 # $DragonFly: src/usr.sbin/pkg_install/version/Attic/pkg_version.pl,v 1.2 2003/06/17 04:29:59 dillon Exp $
  33 #
  34
  35 use Cwd;
  36 use Getopt::Std;
  37
  38 #
  39 # Configuration global variables
  40 #
  41 $AllCurrentPackagesCommand = '/usr/sbin/pkg_info -aI';
  42 $SelectedCurrentPackagesCommand = '/usr/sbin/pkg_info -I';
  43 $CatProgram = "cat ";
  44 $FetchProgram = "fetch -o - ";
  45 $OriginCommand = '/usr/sbin/pkg_info -qo';
  46 $GetPkgNameCommand = 'make -V PKGNAME';
  47
  48 #$IndexFile = "ftp://ftp.freebsd.org/pub/FreeBSD/branches/-current/ports/INDEX";
  49 $PortsDirectory = $ENV{PORTSDIR} || '/usr/ports';
  50 $IndexFile = "$PortsDirectory/INDEX";
  51 $ShowCommandsFlag = 0;
  52 $DebugFlag = 0;
  53 $VerboseFlag = 0;
  54 $CommentChar = "#";
  55 $LimitFlag = "";
  56 $PreventFlag = "";
  57
  58 #
  59 # CompareNumbers
  60 #
  61 # Try to figure out the relationship between two program version numbers.
  62 # Detecting equality is easy, but determining order is a little difficult.
  63 # This function returns -1, 0, or 1, in the same manner as <=> or cmp.
  64 #
  65 sub CompareNumbers {
  66     my ($v1, $v2) = @_;
  67
  68     # Short-cut in case of equality
  69     if ($v1 eq $v2) {
  70         return 0;
  71     }
  72
  73     # Loop over different components (the parts separated by dots).
  74     # If any component differs, we have the basis for an inequality.
  75     my @s1 = split(/\./, $v1);
  76     my @s2 = split(/\./, $v2);
  77     my ($c1, $c2);
  78     do {
  79         last unless @s1 || @s2;
  80         $c1 = shift @s1;
  81         $c2 = shift @s2;
  82     } while ($c1 eq $c2);
  83
  84     # Look at the first components of the arrays that are left.
  85     # These will determine the result of the comparison.
  86     # Note that if either version doesn't have any components left,
  87     # it's implicitly treated as a "0".
  88
  89     # Our next set of checks looks to see if either component has a
  90     # leading letter (there should be at most one leading letter per
  91     # component, so that "4.0b1" is allowed, but "4.0beta1" is not).
  92     if ($c1 =~ /^\D/) {
  93         if ($c2 =~ /^\D/) {
  94
  95             # Both have a leading letter, so do an alpha comparison
  96             # on the letters.  This isn't ideal, since we're assuming
  97             # that "1.0.b4" > "1.0.a2".  But it's about the best we can do,
  98             # without encoding some explicit policy.
  99             my ($letter1, $letter2);
 100             $letter1 = substr($c1, 0, 1);
 101             $letter2 = substr($c2, 0, 1);
 102
 103             if ($letter1 ne $letter2) {
 104                 return $letter1 cmp $letter2;
 105             }
 106             else {
 107                 # The letters matched equally.  Delete the leading
 108                 # letters and invoke ourselves on the remainining
 109                 # characters, which according to the Porters Handbook
 110                 # must be digits, so for example, "1.0.a9" < "1.0.a10".
 111                 substr($c1, 0, 1) = "";
 112                 substr($c2, 0, 1) = "";
 113                 return &CompareNumbers($c1, $c2);
 114             }
 115
 116         }
 117         else {
 118             # $c1 begins with a letter, but $c2 doesn't.  Let $c2
 119             # win the comparison, so that "1.0.b1" < "1.0.1".
 120             return -1;
 121         }
 122     }
 123     else {
 124         if ($c2 =~ /^\D/) {
 125             # $c2 begins with a letter but $c1 doesn't.  Let $c1
 126             # win the comparison, as above.
 127             return 1;
 128         }
 129         else {
 130             # Neither component begins with a leading letter.
 131             # See if either component has no characters left.  If so,
 132             # let the other component win.
 133             if ($c1 eq "") {
 134                 return -1;
 135             }
 136             if ($c2 eq "") {
 137                 return 1;
 138             }
 139
 140             # Check for numeric inequality.  We assume here that (for example)
 141             # "3.09" < "3.10", and that we aren't going to be asked to
 142             # decide between "3.010" and "3.10".
 143             if ($c1 != $c2) {
 144                 return $c1 <=> $c2;
 145             }
 146
 147             # String comparison, given numeric equality.  This
 148             # handles comparisons of the form "3.4j" < "3.4k".  This form
 149             # technically isn't allowed by the Porter's Handbook, but a
 150             # number of ports in the FreeBSD Ports Collection as of this
 151             # writing use it (graphics/jpeg and graphics/xv).  So we need
 152             # to support it.
 153             #
 154             # What we actually do is to strip off the leading digits and
 155             # invoke ourselves on the remainder.  This allows us to handle
 156             # comparisons of the form "1.1p1" < "1.1p2".  Again, not
 157             # technically allowed by the Porters Handbook, but lots of ports
 158             # use it.
 159             else {
 160                 $c1 =~ s/\d+//;
 161                 $c2 =~ s/\d+//;
 162                 if ($c1 eq $c2) {
 163                     return 0;
 164                 }
 165                 elsif ($c1 eq "") {
 166                     return -1;
 167                 }
 168                 elsif ($c2 eq "") {
 169                     return 1;
 170                 }
 171                 else {
 172                     return &CompareNumbers($c1, $c2);
 173                 }
 174             }
 175         }
 176     }
 177 }
 178
 179 #
 180 # CompareVersions
 181 #
 182 # Try to figure out the relationship between two program "full
 183 # versions", which is defined as the
 184 # ${PORTVERSION}[_${PORTREVISION}][,${PORTEPOCH}]
 185 # part of a package's name.
 186 #
 187 # Key points:  ${PORTEPOCH} supercedes ${PORTVERSION}
 188 # supercedes ${PORTREVISION}.  See the commit log for revision
 189 # 1.349 of ports/Mk/bsd.port.mk for more information.
 190 #
 191 sub CompareVersions {
 192     local($fv1, $fv2, $v1, $v2, $r1, $r2, $e1, $e2, $rc);
 193
 194     $fv1 = $_[0];
 195     $fv2 = $_[1];
 196
 197     # Shortcut check for equality before invoking the parsing
 198     # routines.
 199     if ($fv1 eq $fv2) {
 200         return 0;
 201     }
 202     else {
 203         ($v1, $r1, $e1) = &GetVersionComponents($fv1);
 204         ($v2, $r2, $e2) = &GetVersionComponents($fv2);
 205
 206         # Port revision and port epoch numbers default to zero if not
 207         # specified.
 208         if ($r1 eq "") {
 209             $r1 = "0";
 210         }
 211         if ($r2 eq "") {
 212             $r2 = "0";
 213         }
 214         if ($e1 eq "") {
 215             $e1 = "0";
 216         }
 217         if ($e2 eq "") {
 218             $e2 = "0";
 219         }
 220
 221         # Check epoch, port version, and port revision, in that
 222         # order.
 223         $rc = &CompareNumbers($e1, $e2);
 224         if ($rc == 0) {
 225             $rc = &CompareNumbers($v1, $v2);
 226             if ($rc == 0) {
 227                 $rc = &CompareNumbers($r1, $r2);
 228             }
 229         }
 230
 231         return $rc;
 232     }
 233 }
 234
 235 #
 236 # GetVersionComponents
 237 #
 238 # Parse out the version number, revision number, and epoch number
 239 # of a port's version string and return them as a three-element array.
 240 #
 241 # Syntax is:  ${PORTVERSION}[_${PORTREVISION}][,${PORTEPOCH}]
 242 #
 243 sub GetVersionComponents {
 244     local ($fullversion, $version, $revision, $epoch);
 245
 246     $fullversion = $_[0];
 247
 248     $fullversion =~ /([^_,]+)/;
 249     $version = $1;
 250
 251     if ($fullversion =~ /_([^_,]+)/) {
 252         $revision = $1;
 253     }
 254
 255     if ($fullversion =~ /,([^_,]+)/) {
 256         $epoch = $1;
 257     }
 258
 259     return($version, $revision, $epoch);
 260 }
 261
 262 #
 263 # GetNameAndVersion
 264 #
 265 # Get the name and version number of a package. Returns a two element
 266 # array, first element is name, second element is full version string.,
 267 #
 268 sub GetNameAndVersion {
 269     local($fullname, $name, $fullversion);
 270     $fullname = $_[0];
 271
 272     # If no hyphens then no version numbers
 273     return ($fullname, "", "", "", "") if $fullname !~ /-/;
 274
 275     # Match (and group) everything after hyphen(s). Because the
 276     # regexp is 'greedy', the first .* will try and match everything up
 277     # to (but not including) the last hyphen
 278     $fullname =~ /(.+)-(.+)/;
 279     $name = $1;
 280     $fullversion = $2;
 281
 282     return ($name, $fullversion);
 283 }
 284
 285 #
 286 # PrintHelp
 287 #
 288 # Print usage information
 289 #
 290 sub PrintHelp {
 291     print <<"EOF"
 292 Usage:  pkg_version [-c] [-d] [-h] [-l limchar] [-L limchar] [-s string]
 293                     [-v] [index]
 294         pkg_version [-d debug] -t v1 v2
 295 -c              Show commands to update installed packages
 296 -d              Enable debugging output
 297 -h              Help (this message)
 298 -l limchar      Limit output to status flags that match
 299 -L limchar      Limit output to status flags that DON\'T match
 300 -s string       Limit output to packages matching a string
 301 -v              Verbose output
 302 index           URL or filename of index file
 303                 (Default is $IndexFile)
 304
 305 -t v1 v2        Test two version strings
 306 EOF
 307 }
 308
 309 #
 310 # Parse command-line arguments, deal with them
 311 #
 312 if (!getopts('cdhl:L:s:tv') || ($opt_h)) {
 313     &PrintHelp();
 314     exit;
 315 }
 316 if ($opt_c) {
 317     $ShowCommandsFlag = $opt_c;
 318     $LimitFlag = "<?";  # note that if the user specifies -l, we
 319                         # deal with this *after* setting a default
 320                         # for $LimitFlag
 321 }
 322 if ($opt_d) {
 323     $DebugFlag = $opt_d;
 324 }
 325 if ($opt_l) {
 326     $LimitFlag = $opt_l;
 327 }
 328 if ($opt_L) {
 329     $PreventFlag = $opt_L;
 330 }
 331 if ($opt_t) {
 332     $TestFlag = 1;
 333 }
 334 if ($opt_s) {
 335     $StringFlag = $opt_s;
 336 }
 337 if ($opt_v) {
 338     $VerboseFlag = 1;
 339 }
 340 if ($#ARGV >= 0) {
 341     if ($TestFlag) {
 342         ($test1, $test2) = @ARGV;
 343     }
 344     else {
 345         $IndexFile = $ARGV[0];
 346     }
 347 }
 348
 349 # Handle test flag now
 350 if ($TestFlag) {
 351     my $cmp = CompareVersions($test1, $test2);
 352     if ($cmp < 0) {
 353         print "<\n";
 354     }
 355     elsif ($cmp == 0) {
 356         print "=\n";
 357     }
 358     else {
 359         print ">\n";
 360     }
 361     exit(0);
 362 }
 363
 364 # Determine what command to use to retrieve the index file.
 365 if ($IndexFile =~ m-^((http|ftp)://|file:/)-) {
 366     $IndexPackagesCommand = $FetchProgram . $IndexFile;
 367 }
 368 else {
 369     $IndexPackagesCommand = $CatProgram . $IndexFile;
 370 }
 371
 372 #
 373 # Get the current list of installed packages
 374 #
 375 if ($StringFlag) {
 376     if ($DebugFlag) {
 377        print STDERR "$SelectedCurrentPackagesCommand *$StringFlag*\n";
 378     }
 379     open CURRENT, "$SelectedCurrentPackagesCommand \\*$StringFlag\\*|";
 380 } else {
 381     if ($DebugFlag) {
 382        print STDERR "$AllCurrentPackagesCommand\n";
 383     }
 384     open CURRENT, "$AllCurrentPackagesCommand|";
 385 }
 386 while (<CURRENT>) {
 387     ($packageString, $rest) = split;
 388
 389     ($packageName, $packageFullversion) = &GetNameAndVersion($packageString);
 390     $currentPackages{$packageString}{'name'} = $packageName;
 391     $currentPackages{$packageString}{'fullversion'} = $packageFullversion;
 392 }
 393 close CURRENT;
 394
 395 #
 396 # Iterate over installed packages, get origin directory (if it
 397 # exists) and PORTVERSION
 398 #
 399 $dir = cwd();
 400 foreach $packageString (sort keys %currentPackages) {
 401
 402     open ORIGIN, "$OriginCommand $packageString|";
 403     $origin = <ORIGIN>;
 404     close ORIGIN;
 405
 406     # If there is an origin variable for this package, then store it.
 407     if ($origin ne "") {
 408         chomp $origin;
 409
 410         # Try to get the version out of the makefile.
 411         # The chdir needs to be successful or our make -V invocation
 412         # will fail.
 413         unless (chdir "$PortsDirectory/$origin" and -r "Makefile") {
 414             $currentPackages{$packageString}->{orphaned} = $origin;
 415             next;
 416         }
 417
 418         open PKGNAME, "$GetPkgNameCommand|";
 419         $pkgname = <PKGNAME>;
 420         close PKGNAME;
 421
 422         if ($pkgname ne "") {
 423             chomp $pkgname;
 424
 425             $pkgname =~ /(.+)-(.+)/;
 426             $portversion = $2;
 427
 428             $currentPackages{$packageString}{'origin'} = $origin;
 429             $currentPackages{$packageString}{'portversion'} = $portversion;
 430         }
 431     }
 432 }
 433 chdir "$dir";
 434
 435 #
 436 # Slurp in the index file
 437 #
 438 if ($DebugFlag) {
 439     print STDERR "$IndexPackagesCommand\n";
 440 }
 441
 442 open INDEX, "$IndexPackagesCommand|";
 443 while (<INDEX>) {
 444     ($packageString, $packagePath, $rest) = split(/\|/);
 445
 446     ($packageName, $packageFullversion) = &GetNameAndVersion($packageString);
 447     $indexPackages{$packageName}{'name'} = $packageName;
 448     $indexPackages{$packageName}{'path'} = $packagePath;
 449     if (defined $indexPackages{$packageName}{'fullversion'}) {
 450         $indexPackages{$packageName}{'fullversion'} .= "|" . $packageFullversion;
 451     }
 452     else {
 453         $indexPackages{$packageName}{'fullversion'} = $packageFullversion;
 454     }
 455     $indexPackages{$packageName}{'refcount'}++;
 456 }
 457 close INDEX;
 458
 459 #
 460 # If we're doing commands output, cripple the output so that users
 461 # can't just pipe the output to sh(1) and expect this to work.
 462 #
 463 if ($ShowCommandsFlag) {
 464     print<<EOF
 465 echo "The commands output of pkg_version cannot be executed without editing."
 466 echo "You MUST save this output to a file and then edit it, taking into"
 467 echo "account package dependencies and the fact that some packages cannot"
 468 echo "or should not be upgraded."
 469 exit 1
 470 EOF
 471 }
 472
 473 #
 474 # Produce reports
 475 #
 476 # Prior versions of pkg_version used commas (",") as delimiters
 477 # when there were multiple versions of a package installed.
 478 # The new package version number syntax uses commas as well,
 479 # so we've used vertical bars ("|") internally, and convert them
 480 # to commas before we output anything so the reports look the
 481 # same as they did before.
 482 #
 483 foreach $packageString (sort keys %currentPackages) {
 484     $~ = "STDOUT_VERBOSE"  if $VerboseFlag;
 485     $~ = "STDOUT_COMMANDS" if $ShowCommandsFlag;
 486
 487     $packageNameVer = $packageString;
 488     $packageName = $currentPackages{$packageString}{'name'};
 489
 490     $currentVersion = $currentPackages{$packageString}{'fullversion'};
 491
 492     if ($currentPackages{$packageString}->{orphaned}) {
 493
 494         next if $ShowCommandsFlag;
 495         $versionCode = "?";
 496         $Comment = "orphaned: $currentPackages{$packageString}->{orphaned}";
 497
 498     } elsif (defined $currentPackages{$packageString}{'portversion'}) {
 499
 500         $portVersion = $currentPackages{$packageString}{'portversion'};
 501
 502         $portPath = "$PortsDirectory/$currentPackages{$packageString}{'origin'}";
 503
 504         # Do the comparison
 505         $rc = &CompareVersions($currentVersion, $portVersion);
 506
 507         if ($rc == 0) {
 508             $versionCode = "=";
 509             $Comment = "up-to-date with port";
 510         }
 511         elsif ($rc < 0) {
 512             $versionCode = "<";
 513             $Comment = "needs updating (port has $portVersion)";
 514         }
 515         elsif ($rc > 0) {
 516             $versionCode = ">";
 517             $Comment = "succeeds port (port has $portVersion)";
 518         }
 519         else {
 520             $versionCode = "!";
 521             $Comment = "Comparison failed";
 522         }
 523     }
 524
 525     elsif (defined $indexPackages{$packageName}{'fullversion'}) {
 526
 527         $indexVersion = $indexPackages{$packageName}{'fullversion'};
 528         $indexRefcount = $indexPackages{$packageName}{'refcount'};
 529
 530         $portPath = $indexPackages{$packageName}{'path'};
 531
 532         if ($indexRefcount > 1) {
 533             $versionCode = "*";
 534             $Comment = "multiple versions (index has $indexVersion)";
 535             $Comment =~ s/\|/,/g;
 536         }
 537         else {
 538
 539             # Do the comparison
 540             $rc =
 541                 &CompareVersions($currentVersion, $indexVersion);
 542
 543             if ($rc == 0) {
 544                 $versionCode = "=";
 545                 $Comment = "up-to-date with index";
 546             }
 547             elsif ($rc < 0) {
 548                 $versionCode = "<";
 549                 $Comment = "needs updating (index has $indexVersion)"
 550             }
 551             elsif ($rc > 0) {
 552                 $versionCode = ">";
 553                 $Comment = "succeeds index (index has $indexVersion)";
 554             }
 555             else {
 556                 $versionCode = "!";
 557                 $Comment = "Comparison failed";
 558             }
 559         }
 560     }
 561     else {
 562         next if $ShowCommandsFlag;
 563         $versionCode = "?";
 564         $Comment = "unknown in index";
 565     }
 566
 567     # Having figured out what to print, now determine, based on the
 568     # $LimitFlag and $PreventFlag variables, if we should print or not.
 569     if ((not $LimitFlag) and (not $PreventFlag)) {
 570         write;
 571     } elsif ($PreventFlag) {
 572         if ($versionCode !~ m/[$PreventFlag]/o) {
 573             if (not $LimitFlag) {
 574                 write;
 575             } else {
 576                 write if $versionCode =~ m/[$LimitFlag]/o;
 577             }
 578         }
 579     } else {
 580         # Must mean that there is a LimitFlag
 581         write if $versionCode =~ m/[$LimitFlag]/o;
 582     }
 583 }
 584
 585 exit 0;
 586
 587 #
 588 # Formats
 589 #
 590 # $CommentChar is in the formats because you can't put a literal '#' in
 591 # a format specification
 592
 593 # General report (no output flags)
 594 format STDOUT =
 595 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  @<
 596 $packageName,              $versionCode
 597 .
 598   ;
 599
 600 # Verbose report (-v flag)
 601 format STDOUT_VERBOSE =
 602 @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<  @<  @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 603 $packageNameVer,           $versionCode, $Comment
 604 .
 605   ;
 606
 607 # Report that includes commands to update program (-c flag)
 608 format STDOUT_COMMANDS =
 609 @<
 610 $CommentChar
 611 @< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 612 $CommentChar, $packageName
 613 @< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 614 $CommentChar, $Comment
 615 @<
 616 $CommentChar
 617 cd @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 618 $portPath
 619 make clean && make && pkg_delete -f @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 620               $packageNameVer
 621 make install clean
 622
 623 .
 624   ;