#!/bin/sh
#! -*- perl -*-
eval 'exec perl -x -w $0 ${1+"$@"}'
  if 0;

# PCA - Patch Check Advanced
#       Analyze, download and install patches for Sun Solaris
#
# Author : Martin Paul <martin@par.univie.ac.at>
# Home   : http://www.par.univie.ac.at/solaris/pca/
# Version: 5.2 (2006/11/28)

use strict;

# Default configuration
my @defaults=(
  "xrefdir=/var/tmp", "nocache=", "patchdir=.",
  "user=", "passwd=", "patchadd=/usr/sbin/patchadd", "root=",
  "wget=/usr/sfw/bin/wget /usr/local/bin/wget /opt/csw/bin/wget",
  "debug=0", "operands=missing");

# Default paths
my $unzip= '/usr/bin/unzip';
my $showrev= '/usr/bin/showrev';
my $pkginfo= '/usr/bin/pkginfo';
my $pkgchk= '/usr/sbin/pkgchk';
my $uncompress= '/usr/bin/uncompress';
my $tar= '/usr/sbin/tar';
my $uname= '/usr/bin/uname';
my $pager= '/usr/bin/more';
my $file= '/usr/bin/file';
my $logger= '/usr/bin/logger';

# Modules
use Getopt::Long;
use Time::Local;
use Cwd;
use File::Path;
use Fcntl;
use File::Basename;
use File::Copy;

# Variable declarations
my (%o, %input, %p, %pkgs, %u, %c);
my (@plist, @slist, @rlist);
my $runningdl='';
my $lockset='';
my $sttyset=0;
my $patchxdir='';
my $dfori='';
my $currenttime=time();

# Force flush to stdout right after every print command without "\n"
$|= 1;

# Set signal handler
$SIG{TERM} = $SIG{INT} = $SIG{QUIT} = $SIG{HUP} = \&handler;

# Main
#
parse_args();
check_prerequisites();

$o{proxy} && proxy();

expand_operands();

if ($o{readme} && ("@slist" =~ /^(\d{6}-\d{2} *)+$/)) {
  foreach my $pp (@slist) {
    my ($id, $rev)= split (/-/, $pp);
    init_patch ($id);
    $p{$id}{prev}=$rev;
    push (@plist, $id);
  }
  do_patch_list();
  exit 0;
}

get_current_xref();
if (!$o{list} && !$o{download} && !$o{install} && !$o{readme}) { exit 0; }

get_uname();
get_installed_packages();
get_installed_patches();
get_current_patches();
create_patch_list();
do_patch_list();

exit 0;

# Functions

sub do_patch_list {
  (@plist) || return;

  # Counters
  $c{current}=0;
  $c{total}=$#plist+1;
  $c{dl}=$c{skipdl}=$c{faildl}=$c{inst}=$c{skipinst}=$c{failinst}=0;
  $c{reboot}=0; $c{reconfigure}=0;

  print_header();

  foreach my $id (@plist) {
    $c{current}++;

    # Add revision to patch id
    my $pp="";
    ($p{$id}{irev} ne "00") && ($pp="$id-$p{$id}{irev}");
    ($p{$id}{crev} ne "00") && ($pp="$id-$p{$id}{crev}");
    ($p{$id}{prev} ne "00") && ($pp="$id-$p{$id}{prev}");
    $pp || err ("Unknown patch-id $id");

    if ($o{list} || $o{download} || $o{install}) {
      print_patch ($id);
    }
    if ($o{download} || $o{install}) {
      printf " " x 23 . "Download %d/%d: ", $c{current}, $c{total};
      download_patch($pp);
    }
    if ($o{install}) {
      printf " " x 23 . "Install  %d/%d: ", $c{current}, $c{total};
      install_patch($pp);
    }
    if ($o{readme}) {
      my $rtmp=get_readme ($pp);
      ($rtmp) && (push (@rlist, $rtmp));
    }
    ($o{download} || $o{install}) && print "\n";
  }

  if ($o{download} || $o{install}) {
    printf "Download Summary: %d total, %d successful, ", $c{total}, $c{dl};
    printf "%d skipped, %d failed\n", $c{skipdl}, $c{faildl};
  }
  if ($o{install}) {
    printf "Install Summary : %d total, %d successful, ", $c{total}, $c{inst};
    printf "%d skipped, %d failed\n", $c{skipinst}, $c{failinst};

    if ($c{reconfigure}) {
      print "\nReconfiguration reboot required to complete patch process.\n";
    } elsif ($c{reboot}) {
      print "\nReboot required to complete patch process.\n";
    }
  }
  if ($o{readme} && (@rlist)) {
    system ("$pager @rlist");
    unlink (@rlist);
  }
  print_footer();
}

sub expand_operands {
  my @tlist;

  @tlist=@ARGV; @slist=();
  foreach my $s (@tlist) {
    ($s =~ /^\d{6}-\d{2}.zip/) && ($s =~ s/.zip//);
    ($s =~ /^\d{6}-\d{2}.tar.Z/) && ($s =~ s/.tar.Z//);
    ($s =~ /^\d{6}-\d{2}.tar/) && ($s =~ s/.tar//);
    push (@slist, $s);
  }

  @tlist=@slist; @slist=();
  foreach my $s (@tlist) {
    if (($s =~ /^\/.*\/$/) || (! -f $s)) { push (@slist, $s); next; }
    open (LIST, "<$s") || err ("Can't open $s ($!)");
    while (<LIST>) {
      chomp;
      (my $i) = split (/ /, $_);
      push (@slist, $i);
    }
    close (LIST);
  }

  dbg ("Expanded patch list: @slist");
}

sub create_patch_list {
  if ("@slist" =~ /^(\d{6}-\d{2} *)+$/) {
    foreach my $pp (@slist) {
      my ($id, $rev)= split (/-/, $pp);
      init_patch ($id);
      $p{$id}{prev}=$rev;
      push (@plist, $id);
    }
  } else {
    foreach my $id (sort keys %p) {
      add_patch_list ($id,0);
    }
  }
}

sub add_patch_list {
  my $id=$_[0];
  my $type=$_[1];

  # Ignore patches which have been listed already.
  ($p{$id}{listed}) && return (0);

  $type=match_patch_list($id,$type);
  $type || return (0);

  if ($p{$id}{requires} ne '') {
    REQ: foreach my $r (split (/;/, $p{$id}{requires})) {
      my ($r_id, $r_rev)= split (/-/, $r);

      # If a required patch has been obsoleted by another patch, we
      # continue with the patch that obsoleted it.
      while ($p{$r_id}{obsoletedby} ne '') {
        my ($oby_id, $oby_rev)= split (/-/, $p{$r_id}{obsoletedby});
        dbg ("$r_id-$r_rev required by $id: obsolete, replaced with $oby_id-$oby_rev");
        ($r_id, $r_rev)= ($oby_id, $oby_rev);
      }
      # Check if patch requires itself
      if ($r_id eq $id) {
        dbg ("$r_id-$r_rev required by $id: patch requires itself");
        next;
      }
      # Check if the required patch is in our database. Normally we should
      # stop with an error here, but maybe information in patchdiag.xref
      # is wrong and the patch will install without the missing required patch.
      if ($p{$r_id}{crev} eq "00") {
         dbg ("$r_id-$r_rev required by $id: unknown patch");
         next;
      }
      # Check circular patch dependencies (only one level). This won't
      # catch patch A req B, B req C, and C req A.
      if ($p{$r_id}{requires} ne '') {
        foreach my $s (split (/;/, $p{$r_id}{requires})) {
          (my $s_id, my $s_rev)= split (/-/, $s);
          if ($id eq $s_id) {
            dbg ("$r_id-$r_rev required by $id: Circular patch dependency");
            next REQ;
          }
        }
      }
      # Ignore patches already in our list.
      if ($p{$r_id}{listed}) {
        dbg ("$r_id-$r_rev required by $id: already listed");
        next;
      }
      # Ignore patches already installed.
      if ($p{$r_id}{irev} ge $r_rev) {
        dbg ("$r_id-$r_rev required by $id: already installed");
        next;
      }

      dbg ("$r_id-$r_rev required by $id");
      if (!add_patch_list($r_id,$type)) {
        dbg ("$r_id-$r_rev required by $id: does not match");
      }
    }
  }
  $p{$id}{listed}=1;
  push (@plist, $id);
  return (1);
}

sub match_patch_list {
  my $id=$_[0];
  my $type=$_[1];
  my $found;

  S: foreach my $s (@slist) {
    # Complete patch id with revision (123456-78)
    if ($s =~ /\d{6}-\d{2}/) {
      my ($s_id,$s_rev)= split(/-/,$s);
      init_patch($s_id);
      if ($id eq $s_id) {
        $p{$id}{prev}=$s_rev;
        return (1);
      }
    }
    # Incomplete patch id (123456)
    if ($s =~ /\d{6}/) {
      init_patch($id);
      if ($id eq $s) { return (2); }
      if ($type == 2) { return (2); }
    }
    # installed or all
    if (($s =~ /^i/) || ($s =~ /^a/)) {
      # Check for R/S flags and search pattern
      if (!check_rs($s,$id)) { next; }
      if (($o{pattern}) && ($p{$id}{synopsis} !~ /$o{pattern}/)) { next; }

      # Check if patch is installed.
      if ($p{$id}{irev} ne '00') { return (3); }
    }
    # unbundled
    if ($s =~ /^u/) {
      # Check if patch is Unbundled and has an empy packages list.
      if (!(($p{$id}{os} eq "Unbundled") && ($p{$id}{pkgs} eq ""))) { next; }

      # Ignore obsolete and bad patches
      if ($p{$id}{obs} || $p{$id}{bad}) { next; }

      # Ignore patches in the ignore list.
      if ($p{$id}{ignore} eq "00") { next; }
      if ($p{$id}{ignore} eq $p{$id}{crev}) { next; }

      # Check for R/S flags and search pattern
      if (!check_rs($s,$id)) { next; }
      if (($o{pattern}) && ($p{$id}{synopsis} !~ /$o{pattern}/)) { next; }

      return (4);
    }
    # missing or all
    if (($s =~ /^m/) || ($s =~ /^a/)) {
      # Ignore obsolete and bad patches
      if ($p{$id}{obs} || $p{$id}{bad}) { next; }

      # Ignore patches which are installed in the current or higher revision
      if ($p{$id}{irev} ge $p{$id}{crev}) { next; }

      # Ignore patches in the ignore list.
      if ($p{$id}{ignore} eq "00") { next; }
      if ($p{$id}{ignore} eq $p{$id}{crev}) { next; }

      # Ignore patches for foreign architectures.
      $found=0;
      foreach my $j (split (/\;/, $p{$id}{archs})) {
        if (($j eq $u{arch}) || ($j eq "all") || ($j eq "$u{arch}.$u{model}")) {
          $found=1; last;
        }
      }
      if (!$found) { next; }

      # Ignore patches for packages that are not installed.
      $found=0;
      foreach my $j (split (/\;/, $p{$id}{pkgs})) {
        my ($package, $version)= split (/:/, $j);
        if ($pkgs{$package} && ($pkgs{$package} eq $version)) {
          $found=1; last;
        }
      }
      if (!$found) { next; }

      if (!patch_apply_check($id)) { next; }

      # Check for R/S flags and search pattern
      if (!check_rs($s,$id) && ($type != 5)) { next; }
      if (($o{pattern}) && ($p{$id}{synopsis} !~ /$o{pattern}/) && ($type != 5)) { next; }

      return (5);
    }
    # Total set of patches
    if ($s =~ /^t/) {
      if ($p{$id}{crev} eq "00") { next; }

      # Check for R/S flags and search pattern
      if (!check_rs($s,$id)) { next; }
      if (($o{pattern}) && ($p{$id}{synopsis} !~ /$o{pattern}/)) { next; }

      return (6);
    }
    # Installed bad patches
    if ($s =~ /^b/) {
      if (!$p{$id}{ibad}) { next; }

      # Check if bad patch has been obsoleted by an installed patch
      my $oby_id= $id; my $oby_rev;
      while ($p{$oby_id}{obsoletedby} ne '') {
        ($oby_id, $oby_rev)= split (/-/, $p{$oby_id}{obsoletedby});
        if ($p{$oby_id}{irev} ge $oby_rev) { next S; }
      }
      # Check for R/S flags and search pattern
      if (!check_rs($s,$id)) { next; }
      if (($o{pattern}) && ($p{$id}{synopsis} !~ /$o{pattern}/)) { next; }

      return (7);
    }
  }
  return (0);
}

sub check_rs {
  my $s=$_[0]; my $id=$_[1];

  if ($s =~ /rs$/) {
    if (!($p{$id}{rec} || $p{$id}{recf} || $p{$id}{sec} || $p{$id}{secf})) { return(0); }
  } else {
    if (($s =~ /r$/) && (!$p{$id}{rec}) && (!$p{$id}{recf})) { return(0); }
    if (($s =~ /s$/) && (!$p{$id}{sec}) && (!$p{$id}{secf})) { return(0); }
  }
  return(1);
}

sub download_patch {
  my $pp=$_[0];

  lock_free($o{patchdir}, "download.$pp", 300) || err ("Another instance of pca is downloading $pp to $o{patchdir} right now");

  # Check if patch exists
  foreach my $ext ('.zip','.tar.Z','.tar') {
    if (-f "$o{patchdir}/$pp$ext") {
      if (-s "$o{patchdir}/$pp$ext") {
        print "skipped - file exists\n" unless $o{proxy}; $c{skipdl}++; return;
      }
      unlink "$o{patchdir}/$pp$ext";
    }
  }

  # Remember if we downloaded the patch for install only
  $o{download} || ($dfori=$pp);

  (-w $o{patchdir}) || err ("Can't write to patch download directory $o{patchdir} ($!)");

  lock_create($o{patchdir}, "download.$pp", 1) || err ("Another instance of pca is downloading $pp to $o{patchdir} right now");

  # Try to get patch from local patch server
  if ($o{localurl} && ($o{localurl} =~ /^file:/)) {
    my $path=$o{localurl}; $path =~ s/^file://;
    foreach my $ext ('.zip','.tar.Z','.tar') {
      $runningdl="$o{patchdir}/$pp$ext";
      (-r "$path/$pp$ext") && copy ("$path/$pp$ext", $runningdl);
      $runningdl="";
      if (-s "$o{patchdir}/$pp$ext") {
        print "done\n" unless $o{proxy}; $c{dl}++;
        lock_remove($o{patchdir}, "download.$pp");
        return;
      }
      unlink "$o{patchdir}/$pp$ext";
    }
  }
  $o{wget} || err ("Can't find wget executable");

  if ($o{localurl} && ($o{localurl} =~ /^http:|^https:|^ftp:/)) {
    foreach my $ext ('.zip','.tar.Z','.tar') {
      $runningdl="$o{patchdir}/$pp$ext";
      `$o{wget} $o{wgetq} "$o{localurl}$pp$ext" -O $runningdl`;
      $runningdl="";
      if ((!$?) && (-s "$o{patchdir}/$pp$ext")) {
        print "done\n" unless $o{proxy}; $c{dl}++;
        lock_remove($o{patchdir}, "download.$pp");
        return;
      }
      unlink "$o{patchdir}/$pp$ext";
    }
  }
  # Try download from public patch server
  foreach my $ext ('.zip','.tar.Z','.tar') {
    $runningdl="$o{patchdir}/$pp$ext";
    `$o{wget} $o{wgetq} "http://patches.sun.com/all_unsigned/$pp$ext" -O $runningdl`;
     $runningdl="";
    if ((!$?) && (-s "$o{patchdir}/$pp$ext")) {
      print "done\n" unless $o{proxy}; $c{dl}++;
      lock_remove($o{patchdir}, "download.$pp");
      return;
    }
    unlink "$o{patchdir}/$pp$ext";
  }
  # Try download from restricted patch server, if the user provided
  # Sun Online Account data
  if ($o{user} && $o{passwd}) {
    my $retry=0;
    while ($retry < 5) {
      $runningdl="$o{patchdir}/$pp.tmp";
      `$o{wget} $o{wgetq} --http-user='$o{user}' --http-passwd='$o{passwd}' "http://sunsolve.sun.com/private-cgi/pdownload.pl?target=$pp&method=h" -O $o{patchdir}/$pp.tmp`;
      $runningdl="";
      if ((!$?) && (-s "$o{patchdir}/$pp.tmp")) {
        my $file=`LC_MESSAGES=C; export LC_MESSAGES; $file $o{patchdir}/$pp.tmp`;
        if ($file =~ /tar archive/i) {
          rename ("$o{patchdir}/$pp.tmp", "$o{patchdir}/$pp.tar");
          print "done\n" unless $o{proxy}; $c{dl}++;
          lock_remove($o{patchdir}, "download.$pp");
          return;
        } elsif ($file =~ /compress/i) {
          rename ("$o{patchdir}/$pp.tmp", "$o{patchdir}/$pp.tar.Z");
          print "done\n" unless $o{proxy}; $c{dl}++;
          lock_remove($o{patchdir}, "download.$pp");
          return;
        } elsif ($file =~ /zip/i) {
          rename ("$o{patchdir}/$pp.tmp", "$o{patchdir}/$pp.zip");
          print "done\n" unless $o{proxy}; $c{dl}++;
          lock_remove($o{patchdir}, "download.$pp");
          return;
        } else {
          dbg ("Unknown file type: $file");
        }
      }
      unlink "$o{patchdir}/$pp.tmp";
      $retry++; sleep ($retry*2);
    }
  }
  print "failed\n" unless $o{proxy}; $c{faildl}++;
  lock_remove($o{patchdir}, "download.$pp");
}

sub install_patch {
  my $pp=$_[0];
  my ($id, $rev)= split (/-/, $pp);
  my $output;
  my $dfile='';

  $patchxdir= "$o{tmpdir}/pca." . time() . $$;
  mkdir $patchxdir,0755 || err ("Can't create temporary directory $patchxdir ($!)");

  if (-f "$o{patchdir}/$pp.zip") {
    `$unzip -n $o{patchdir}/$pp.zip -d $patchxdir 2>&1`;
    ($pp eq $dfori) && ($dfile= "$o{patchdir}/$pp.zip")
  } elsif (-f "$o{patchdir}/$pp.tar.Z") {
    `cd $patchxdir; $uncompress -c $o{patchdir}/$pp.tar.Z | $tar xf -`;
    ($pp eq $dfori) && ($dfile= "$o{patchdir}/$pp.tar.Z")
  } elsif (-f "$o{patchdir}/$pp.tar") {
    `cd $patchxdir; $tar xf $o{patchdir}/$pp.tar`;
    ($pp eq $dfori) && ($dfile= "$o{patchdir}/$pp.tar")
  } else {
    print "failed - missing patch file\n";
    rmdir $patchxdir; $patchxdir="";
    $c{failinst}++; return;
  }
  if (($?) || (! -d "$patchxdir/$pp")) {
    print "failed - uncompress failed\n";
    rmtree ($patchxdir); $patchxdir="";
    $c{failinst}++; return;
  }
  my $readme= "$patchxdir/$pp/README.$pp";

  if (($o{safe}) && !verify_files($id, $readme)) {
    rmtree ($patchxdir); $patchxdir="";
    $c{failinst}++; return;
  }

  # Do we need a reboot?
  my $reboot= 0;
  my $reconfigure= 0;
  if (-f $readme) {
    open(README,$readme) || err ("Can't open $readme ($!)");
    while(<README>) {
      if (/Reconfigure after installation/ ||
          /Reconfigure immediately after patch is installed/) {
        $reconfigure=1;
      } elsif (/Reboot after installation/ ||
               /Reboot the system .*after .*installation/ ||
               /Reboot immediately after patch is installed/) {
        $reboot=1;
      }
    }
    close README;
  }
  if ($o{noreboot} && ($reconfigure || $reboot)) {
    print "skipped - reboot required\n";
    rmtree ($patchxdir); $patchxdir="";
    $c{skipinst}++; return;
  }

  # If the patchadd command doesn't exist, try installpatch, which
  # comes with patches for Solaris <= 2.5.1.
  (-x $o{patchadd}) || ($o{patchadd}="$patchxdir/$pp/installpatch");
  (-x $o{patchadd}) || err ("Can't execute patchadd/installpatch");

  if ($o{pretend}) {
    print "skipped - pretend"; $c{skipinst}++;
  } else {
    lock_create($o{tmpdir}, "install", 1) || err ("Another instance of pca is installing patches right now");
    $output=`$o{patchadd} $o{root} $o{patchadd_options} $patchxdir/$pp 2>&1`;
    my $rc=$?;
    lock_remove($o{tmpdir}, "install");
    if ($rc) {
      print "\n$output\n";
      printf "failed - Exit code %d\n", $rc / 256;
      rmtree ($patchxdir); $patchxdir="";
      $c{failinst}++; return;
    }
    dbg ("\n$output");
    print "done"; $c{inst}++;
    $dfile && unlink ($dfile);
    log_msg("Installed patch $pp ($p{$id}{synopsis})");
  }
  if ($reconfigure) {
    print " - reconfigure";
    $c{reconfigure}++;
  } elsif ($reboot) {
    print " - reboot";
    $c{reboot}++;
  }
  print "\n";
  rmtree ($patchxdir); $patchxdir="";
}

sub proxy {
  my $f=$o{proxy};
  my $odir=getcwd();

  if ($f =~ /patchdiag.xref/) {
    $o{xrefown}=1;
    get_current_xref();
  }
  if (($f =~ /README/) && (! -f "$odir/$f")) {
    my $pp=$f; $pp =~ s/^.*(\d{6}-\d{2}).*$/$1/;
    my $rtmp=get_readme ($pp);
    if ($rtmp) {
      copy ($rtmp, "$odir/$f");
      unlink ($rtmp);
    }
  }
  if ($f =~ /\d{6}-\d{2}\.(zip|tar|tar\.Z)/) {
    my $pp=$f; $pp =~ s/^.*(\d{6}-\d{2}).*$/$1/;
    download_patch($pp);
  }

  if (-f "$odir/$f") {
    print "Location: $f\n\n";
  } else {
    err ("$f not found");
  }
  exit (0);
}

sub check_prerequisites {
  # Must be root to install patches
  if ($o{install} && ($< != 0) && !$o{pretend}) {
    err ("You must be root to install patches");
  }
  if ($o{safe} && ($< != 0)) {
    err ("You must be root to use safe mode");
  }

  # Set umask (esp. for patchxdir)
  umask (0022);

  # Check for wget executable
  my $found='';
  foreach my $i (split (/ /, $o{wget})) {
    if (-x $i) {
      $found= $i;
      dbg ("Using $found");
      last;
    }
  }
  $o{wget}=$found;

  # Get patchdiag.xref location
  $input{xref}="$o{xrefdir}/patchdiag.xref";

  # Check patch download directory
  (-d $o{patchdir}) || err ("Can't find patch directory $o{patchdir}");

  # Check for pager
  $ENV{PAGER} && ($pager=$ENV{PAGER});

  # Set tmpdir for patch extraction
  $o{tmpdir}="/tmp";
  ($ENV{TMPDIR}) && (-d $ENV{TMPDIR}) && ($o{tmpdir}= $ENV{TMPDIR});
  dbg ("tmpdir: $o{tmpdir}");

  # Check for valid prefix in $fromfiles and set input files/commands
  if ($o{fromfiles}) {
    if (-f "$o{fromfiles}/sysconfig/uname-a.out") {
      $input{pkginfo}= "<$o{fromfiles}/patch+pkg/pkginfo-l.out";
      $input{showrev}= "<$o{fromfiles}/patch+pkg/showrev-p.out";
      $input{uname}  = "<$o{fromfiles}/sysconfig/uname-a.out";
    } elsif (-f "$o{fromfiles}uname.out") {
      $input{pkginfo}= "<$o{fromfiles}pkginfo.out";
      $input{showrev}= "<$o{fromfiles}showrev.out";
      $input{uname}  = "<$o{fromfiles}uname.out";
    } elsif (-f "$o{fromfiles}/uname.out") {
      $input{pkginfo}= "<$o{fromfiles}/pkginfo.out";
      $input{showrev}= "<$o{fromfiles}/showrev.out";
      $input{uname}  = "<$o{fromfiles}/uname.out";
    } else {
      err ("Can't find pkginfo/showrev/uname output with prefix $o{fromfiles}");
    }
    dbg ("Using $o{fromfiles} as prefix to read .out files");
  } else {
    $input{pkginfo}= "$pkginfo -x $o{root} |";
    if (-x $showrev) {
      $input{showrev}= "$showrev -p $o{root} |";
    } elsif (-x $o{patchadd}) {
      $input{showrev}= "$o{patchadd} -p $o{root} |";
    } else {
      err ("Can't execute $showrev or $o{patchadd}");
    }
    $input{uname}  = "$uname -a |";
  }

  # Ask for Sun Online Account data interactively
  if ($o{download} || $o{install} || $o{readme} || $o{listhtml}) {
    if ($o{askauth}) {
      print "Sun Online Account User: ";
      chomp($o{user} = <STDIN>);
    }
    if ($o{askauth} || ($o{user} && !$o{passwd})) {
      system "stty -echo"; $sttyset=1;
      print "Sun Online Account Password: ";
      chomp($o{passwd} = <STDIN>);
      print "\n";
      system "stty echo"; $sttyset=0;
    }
  }
  $o{user} && dbg ("Sun Online Account user is set");
  $o{passwd} && dbg ("Sun Online Account passwd is set");
}

sub verify_files {
  my $id=$_[0]; my $readme=$_[1]; my @files=(); my %wl;

  # All
  $wl{all}="/etc/name_to_major /etc/driver_aliases /etc/driver_classes /etc/minor_perm /etc/security/exec_attr";
  # 7/SPARC
  $wl{106541}="/etc/devlink.tab /etc/rmmount.conf /etc/syslog.conf /etc/vold.conf";
  $wl{106857}="/usr/openwin/share/locale/C/props/basic_setting";
  $wl{106978}="/etc/nsswitch.conf";
  $wl{107589}="/etc/default/kbd";
  $wl{107684}="/etc/inet/services /etc/mail/main.cf /etc/mail/subsidiary.cf";
  $wl{107738}="/usr/openwin/lib/locale/compose.dir /usr/openwin/lib/locale/locale.alias /usr/openwin/lib/locale/locale.dir";
  $wl{108800}="/etc/inet/inetd.conf /etc/init.d/cachefs.daemon";
  # 8/SPARC
  $wl{108725}="/kernel/drv/st.conf";
  $wl{108968}="/etc/rmmount.conf /etc/vold.conf";
  $wl{108993}="/etc/asppp.cf /etc/nsswitch.conf /etc/pam.conf /etc/default/login";
  $wl{108999}="/etc/pam.conf";
  $wl{109077}="/etc/security/auth_attr /etc/security/prof_attr";
  $wl{109134}="/etc/security/auth_attr /etc/security/prof_attr";
  $wl{109695}="/etc/smartcard/opencard.properties";
  $wl{109766}="/usr/openwin/lib/locale/ja/X11/fonts/TT/fonts.alias";
  $wl{109887}="/etc/smartcard/ocf.classpath";
  $wl{110369}="/etc/iu.ap";
  $wl{110386}="/etc/security/auth_attr /etc/security/prof_attr";
  $wl{110615}="/etc/mail/main.cf /etc/mail/subsidiary.cf";
  $wl{110896}="/etc/inet/inetd.conf";
  $wl{112438}="/etc/devlink.tab";
  $wl{112663}="/usr/openwin/server/etc/OWconfig";
  $wl{114542}="/usr/openwin/lib/X11/fonts/TrueType/ttmap/ttmaps.dir /usr/openwin/lib/X11/fonts/encodings/encodings.dir";
  $wl{116973}="/etc/apache/mime.types";
  $wl{117518}="/usr/openwin/lib/X11/fonts/F3bitmaps/fonts.dir";
  # 9/SPARC
  $wl{112233}="/etc/iu.ap";
  $wl{112874}="/etc/name_to_sysnum /etc/security/crypt.conf /etc/security/policy.conf";
  $wl{112954}="/kernel/drv/uata.conf";
  $wl{113073}="/etc/inet/inetd.conf";
  $wl{113085}="/usr/openwin/lib/X11/fonts/TrueType/ttmap/ttmaps.dir /usr/openwin/lib/X11/fonts/encodings/encodings.dir";
  $wl{113096}="/usr/openwin/server/etc/OWconfig";
  $wl{113277}="/kernel/drv/st.conf /kernel/drv/sd.conf";
  $wl{113471}="/usr/bin/cputrack";
  $wl{113575}="/etc/mail/main.cf /etc/mail/subsidiary.cf";
  $wl{114332}="/etc/rc0.d/K05volmgt /etc/rc1.d/K05volmgt /etc/rc2.d/K05volmgt /etc/rc3.d/S81volmgt /etc/rcS.d/K05volmgt /etc/security/audit_class /etc/security/audit_event";
  $wl{114352}="/etc/inet/inetd.conf";
  $wl{123184}="/usr/openwin/lib/X11/fonts/TrueType/ttmap/ttmaps.dir /usr/openwin/lib/X11/fonts/encodings/encodings.dir";
  # 9/x86
  $wl{114137}="/etc/mail/main.cf /etc/mail/subsidiary.cf";
  $wl{114353}="/etc/inet/inetd.conf";
  # 10/SPARC
  $wl{116298}="/usr/bin/wscompile /usr/bin/wsdeploy";
  $wl{118822}="/etc/security/device_policy";
  $wl{118833}="/etc/logindevperm /etc/security/prof_attr /etc/vold.conf";
  $wl{118929}="/etc/iu.ap";
  $wl{119090}="/etc/ima.conf /kernel/drv/iscsi.conf";
  $wl{119130}="/kernel/drv/fp.conf /kernel/drv/qlc.conf";
  $wl{119313}="/etc/security/auth_attr";
  $wl{120346}="/etc/hba.conf";
  $wl{120410}="/etc/gtk-2.0/gtk.immodules /etc/sparcv9/gtk-2.0/gtk.immodules";
  $wl{120460}="/etc/gtk-2.0/gtk.immodules /etc/sparcv9/gtk-2.0/gtk.immodules";
  $wl{121430}="/etc/default/lu";
  $wl{122539}="/etc/security/auth_attr";
  $wl{124393}="/etc/security/auth_attr /etc/security/prof_attr";
  # 10/x86
  $wl{118844}="/boot/solaris/bootenv.rc /etc/security/device_policy";
  $wl{118855}="/etc/logindevperm /etc/security/prof_attr /etc/vold.conf /lib/libc.so.1 /etc/security/device_policy /etc/ipf/pfil.ap /boot/solaris/devicedb/master";
  $wl{119091}="/etc/ima.conf /kernel/drv/iscsi.conf";
  $wl{119131}="/kernel/drv/fp.conf /kernel/drv/qlc.conf";
  $wl{119314}="/etc/security/auth_attr";
  $wl{120273}="/etc/sma/snmp/snmpd.conf";
  $wl{120347}="/etc/hba.conf";
  $wl{120411}="/etc/gtk-2.0/gtk.immodules /etc/amd64/gtk-2.0/gtk.immodules";
  $wl{120461}="/etc/gtk-2.0/gtk.immodules /etc/amd64/gtk-2.0/gtk.immodules";
  $wl{120846}="/etc/security/audit_event";
  $wl{121431}="/etc/default/lu";
  $wl{122532}="/etc/security/auth_attr";
  $wl{124394}="/etc/security/auth_attr /etc/security/prof_attr";

  (-f $readme) || return (1);
  open (README, "<$readme") || err ("Can't open $readme ($!)");

  FILE: while (<README>) {
    next if ($_ !~ /Files included with this patch:/);
    LINE: while (<README>) {
      chomp;
      next if (/^$/);
      last FILE if (! /\//);
      s/\s+\(deleted\)//;
      s/^\s+//;
      s/^/\// unless /^\//;

      foreach my $i (split (/ /, $wl{all})) { ($_ eq $i) && next LINE; }
      if ($wl{$id}) {
        foreach my $i (split (/ /, $wl{$id})) { ($_ eq $i) && next LINE; }
      }
      push (@files, $_);
    }
  }
  close (README);
  dbg ("Number of files to check: %d", $#files+1);
  ($#files == -1) && return (1);

  # pkgchk has a limit of 1024 pathnames
  my @tfiles=@files; my $out='';
  while ($#tfiles != -1) {
    my $fc=$#tfiles;
    ($fc >= 1023) && ($fc=1023);
    $out .= `$pkgchk $o{root} -q -p \"@tfiles[0..$fc]\" 2>&1`;
    for (0..1023) { shift @tfiles; }
  }
  ($out) || return (1);

  if ($out =~ /file size |file cksum |pathname /) {
    print "failed file verification:\n\n$out";
    return (0);
  }
  return (1);
}

sub patch_apply_check {
  my $id=$_[0];

  if ($id =~ /113039|113040|113041|113042|113043/) {
    if (!$pkgs{"SUNWsan"}) { return (0); }
  }

  if ($id =~ /114045/) {
    if ((exists $p{114049}) && ($p{114049}{irev} gt '03')) { return (0); }
  }

  if (($id =~ /114046|119209/) && ($u{osrel} ne "5.8")) { return (0); }
  if (($id =~ /114049|114050/) && ($u{osrel} ne "5.9")) { return (0); }
  if (($id =~ /119211|119212/) && ($u{osrel} ne "5.9")) { return (0); }

  if ($id =~ /114790/) {
    if (!$pkgs{"SUNWdcar"}  || $pkgs{"SUNWdcar"}  ne "1.1.0,REV=2002.05.29.15.02") { return (0); }
    if (!$pkgs{"SUNWcrypr"} || $pkgs{"SUNWcrypr"} ne "1.1.0,REV=2002.05.29.15.00") { return (0); }
  }

  if (($id =~ /117765|117766/) && ($u{osrel} ne "5.8")) { return (0); }
  if (($id =~ /117767|117768/) && ($u{osrel} ne "5.9")) { return (0); }

  if ($id =~ /113332/) {
    if (($pkgs{"SUNWhea"}) || ($pkgs{"SUNWmdb"})) { return (1); }
    if (($u{model} eq 'sun4u') || ($u{model} eq 'sun4us')) { return (1); }
    return (0);
  }

  if ($id =~ /115010|116478/) {
    if (($pkgs{"SUNWhea"}) || ($pkgs{"SUNWmdb"})) { return (1); }
    if ($u{model} eq 'sun4u') { return (1); }
    return (0);
  }

  if ($id =~ /109077|109078/) {
    if ((!$pkgs{"SUNWdhcm"}) && (!$pkgs{"SUNWdhcsu"})) { return (0); }
    if ($pkgs{"SUNWj3rt"}) { return (1); }
    return (0);
  }

  if ($id =~ /118739|116706/) {
    if (!$pkgs{"SUNWtsr"} || $pkgs{"SUNWtsr"} ne "2.5.0,REV=2003.04.03.21.27") { return (0); }
  }
  if ($id =~ /118740|116707/) {
    if (!$pkgs{"SUNWtsr"} || $pkgs{"SUNWtsr"} ne "2.5.0,REV=2003.04.03.19.26") { return (0); }
  }
  if ($id =~ /118741/) {
    if (!$pkgs{"SUNWtsr"} || $pkgs{"SUNWtsr"} ne "2.5.0,REV=2003.11.11.23.55") { return (0); }
  }
  if ($id =~ /118742/) {
    if (!$pkgs{"SUNWtsr"} || $pkgs{"SUNWtsr"} ne "2.5.0,REV=2003.11.11.20.36") { return (0); }
  }

  if ($id =~ /110692/) {
    if ((exists $p{108806}) && ($p{108806}{irev} ge '01')) { return (0); }
    if ((exists $p{108806}) && ($p{108806}{crev} ge '01')) { return (0); }
  }

  if ($id =~ /111412/) {
    if (!$pkgs{"SUNWmdi"} || $pkgs{"SUNWmdi"} ne "11.8.0,REV=2001.01.19.01.02") { return (0); }
    if (!$pkgs{"SUNWsan"}) { return (0); }
  }
  if ($id =~ /111095|111096|111413/) {
    if (!$pkgs{"SUNWsan"}) { return (0); }
  }
  if ($id =~ /111097/) {
    if (!$pkgs{"SUNWsan"}) { return (0); }
    if (!$pkgs{"SUNWqlc"}) { return (0); }
  }

  if ($id =~ /111656/) {
    if (!((exists $p{109460}) && ($p{109460}{irev} eq '05'))) { return (0); }
  }
  if ($id =~ /111658/) {
    if (!((exists $p{107469}) && ($p{107469}{irev} eq '08'))) { return (0); }
  }
  if ($id =~ /111079/) {
    if (!((exists $p{105375}) && ($p{105375}{irev} eq '26'))) { return (0); }
  }

  if ($id =~ /107474/) {
    if ((exists $p{107292}) && ($p{107292}{irev} ge '02')) { return (1); }
    return (0);
  }

  if ($id =~ /106533/) {
    if ($u{platform} ne 'SUNW,UltraSPARC-IIi-cEngine') { return (0); }
  }
  if ($id =~ /106629/) {
    if ($u{platform} ne 'CYRS,Superserver-6400') { return (0); }
  }
  if ($id =~ /112780/) {
    if (!($u{model} eq 'sun4u')) { return (0); }
  }
  if ($id =~ /112327/) {
    if (($u{osrel} ne "5.6") && ($u{osrel} ne "5.7")) { return (0); }
  }

  if ($id =~ /11464[456789]|11465[0123]|11481[67]|11578[01]|11752[01]/) {
    if ($u{osrel} ne "5.8") { return (0); }
  }
  if ($id =~ /11468[6789]|11469[012345]|11481[89]|11578[23]|11752[67]/) {
    if ($u{osrel} ne "5.9") { return (0); }
  }

  if ($id =~ /111891/) {
    if (!$pkgs{"SUNWutr"} || $pkgs{"SUNWutr"} ne "1.3_12.c,REV=2001.07.16.20.52") { return (0); }
  }

  if (($id =~ /114255/) && ($u{arch} ne "sparc")) { return (0); }
  if (($id =~ /114256/) && ($u{arch} ne "i386")) { return (0); }

  if (($id =~ /115328/) && ($u{osrel} ne "5.8")) { return (0); }
  if (($id =~ /115342/) && ($u{osrel} ne "5.9")) { return (0); }
  if (($id =~ /115343/) && ($u{osrel} ne "5.9")) { return (0); }
  if (($id =~ /119346/) && ($u{osrel} ne "5.10")) { return (0); }

  if (($id =~ /115766/) && ($u{arch} ne "sparc")) { return (0); }
  if (($id =~ /120091/) && ($u{arch} ne "i386")) { return (0); }
  if (($id =~ /120879/) && ($u{arch} ne "sparc")) { return (0); }
  if (($id =~ /120880/) && ($u{arch} ne "i386")) { return (0); }
  if (($id =~ /120954/) && ($u{arch} ne "sparc")) { return (0); }
  if (($id =~ /120955/) && ($u{arch} ne "i386")) { return (0); }

  if (($id =~ /115835|115836/) && (!$pkgs{"SUNWgscr"})) { return (0); }

  if (($id =~ /119300/) && ($u{osrel} ne "5.8")) { return (0); }
  if (($id =~ /119301/) && ($u{osrel} ne "5.9")) { return (0); }
  if (($id =~ /119302/) && ($u{osrel} ne "5.10")) { return (0); }

  if (($id =~ /122658|122659/) && (!$pkgs{"SUNWzoneu"})) { return (0) }
  if (($id =~ /122752|122753/) && (!$pkgs{"SUNWsmaS"} && !$pkgs{"SUNWsmagt"} && !$pkgs{"SUNWsmcmd"} && !$pkgs{"SUNWsmmgr"})) { return (0) }

  return (1);
}

sub get_uname {
  # Get information about host
  open(UNAME, $input{uname}) || err ("Can't open $input{uname} ($!)");
  $_=<UNAME>;
  $_ || err ("Empty uname output");
  chomp;
  close UNAME;

  ($u{osname}, $u{hostname}, $u{osrel}, $u{osversion}, $u{model}, $u{arch}, $u{platform})= split (/ /, $_);
  ($u{osname} && $u{hostname} && $u{osrel} && $u{osversion} && $u{model} && $u{arch} && $u{platform}) || err ("Can't parse uname ouput:\n  $_");

  my ($major, $minor) = split (/\./, $u{osrel});
  ($minor <= 8) && ($o{root}) && err ("Option -R supported on Solaris >= 9 only");
  ($minor <= 9) && ($o{patchadd_options} =~ /-G/) && err ("Option -G supported on Solaris >= 10 only");
}

sub get_installed_packages {
  my $package;

  # Read pkginfo
  open(PKGINFO, $input{pkginfo}) || err ("Can't open $input{pkginfo} ($!)");
  if ($input{pkginfo} =~ /pkginfo-l.out/) {
    while(<PKGINFO>) {
      if (/\s+PKGINST:\s+(\S+)$/) { $package = $1; }
      if (/\s+VERSION:\s+(\S+)$/) { $pkgs{$package}=$1; }
    }
  } else {
    while(<PKGINFO>) {
      ($_ =~ /^(\S+) /) || err ("Can't parse pkginfo output:\n  $_");
      $package=$1;
      # Removing trailing .2/.3/... (multiple versions of same package)
      $package =~ s/\..*//;
      $_= <PKGINFO>;
      ($_ =~ / (\S+)$/) || err ("Can't parse pkginfo output:\n  $_");
      $pkgs{$package}=$1;
    }
  }
  close(PKGINFO);
}

sub get_installed_patches {
  # Read showrev -p output
  #
  open(SHOWREV, $input{showrev}) || err ("Can't open $input{showrev} ($!)");
  $/=""; my $showrev= <SHOWREV>; $/="\n";
  close SHOWREV;
  $showrev || ($showrev= "No patches are installed\n");

  my @showrev= split(/\n/, $showrev);

  foreach my $i (sort @showrev) {
    # Known formats of patch IDs:
    #   123456-78      : Regular Sun
    #   IDR123456-78   : Unsupported (pre-release) Sun
    #   123-45         : EMC
    #   CKPSP123456-78 : Checkpoint
    #   CPFWSP410002-01: Checkpoint
    #   KDE20060107-01 : KDE
    #   IDCE32-02      : DCE
    #   DP550001-05    : HP Data Protector
    #   DP550011-1     : HP Data Protector
    #   PSE400SOL023   : Citrix
    #   ME113SB222     : Citrix
    #   Q995801-01     : SUNWluxop
    if (
      ($i =~ /^Patch:\s+(\d{3,6})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+IDR(\d{6})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+CKPSP(\d{6})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+CPFWSP(\d{6})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+KDE(\d{8})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+IDCE(\d{2})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+DP(\d{6})-(\d{2}).*/) ||
      ($i =~ /^Patch:\s+DP(\d{6})-(\d{1}).*/) ||
      ($i =~ /^Patch:\s+PSE(\d{3})SOL(\d{3}).*/) ||
      ($i =~ /^Patch:\s+ME(\d{3})SB(\d{3}).*/) ||
      ($i =~ /^Patch:\s+Q(\d{6})-(\d{2}).*/)
    ) {
      my ($id, $rev)=($1,$2);
      init_patch($id);
      $p{$id}{irev}= $rev;
      if ($i =~ / Obsoletes: ([-0-9, ]*) /) {
        for my $j (split (/,* /, $1)) {
          my ($oid, $orev) = split (/-/, $j);
          ($id eq $oid) && next;
          init_patch($oid);
          $p{$oid}{iobsoletedby}="$id-$rev";
          #dbg ("$oid-$orev obsoleted by $id-$rev");
        }
      }
      if ($i =~ / Incompatibles: ([-0-9, ]*) /) {
        for my $j (split (/,* /, $1)) {
          my ($iid, $irev) = split (/-/, $j);
          init_patch($iid);
          #dbg ("$iid-$irev incompatible with $id-$rev");
        }
      }
      next;
    }
    next if ($i =~ "No patches are installed");
    next if ($i =~ "No patches installed");
    print ("WARNING: Can't parse showrev output:\n  $i");
  }
}

sub get_current_xref {
  # Download most recent patchdiag.xref, if requested

  return if ($o{nocheckxref});

  lock_free($o{xrefdir}, "xref", 60) || err ("Another instance of pca is downloading $input{xref} right now");

  # If there's an updated xref file, we try to download it, but
  # only if we can write to the directory where it is located.
  if ((-f $input{xref}) && (!$o{getxref})) {
    my $last=1158628500;
    my $current=(stat($input{xref}))[9];
    my $next=0;
    my $now=time();
    my $cnt=0; my @inc=(1, 1, 1, 1, 3);
    do {
      $next && ($last=$next);
      $next = $last + $inc[$cnt++%5]*86400;
    } while ($next < $now);
    dbg ("xref now    : " . localtime($now));
    dbg ("xref current: " . localtime($current));
    dbg ("xref last   : " . localtime($last));
    dbg ("xref next   : " . localtime($next));
    if ($current >= $last) {
      return;
    } elsif (! -w $o{xrefdir}) {
      print "Can't download xref file, as $o{xrefdir} is unwritable\n";
      return;
    }
  }
  print "Download xref-file to $input{xref}: " unless $o{noheader};

  (-w $o{xrefdir}) || err ("Can't write to xref download directory $o{xrefdir}");
  if ((-f $input{xref}) && (! -w $input{xref})) {
    if ($o{getxref}) { 
      err ("Can't write to $input{xref}\n");
    } else {
      print "Can't write to $input{xref}\n";
      return;
    }
  }

  lock_create($o{xrefdir}, "xref", 1) || err ("Another instance of pca is downloading $input{xref} right now");
  my $success=0;
  if ($o{localurl} && ($o{localurl} =~ /^file:/)) {
    dbg ("Getting patchdiag.xref from $o{localurl}");
    my $path=$o{localurl}; $path =~ s/^file://;
    if (-r "$path/patchdiag.xref") {
      if (-s $input{xref}) {
        my $mtime1=(stat("$path/patchdiag.xref"))[9];
        my $mtime2=(stat($input{xref}))[9];
        if ($mtime2 >= $mtime1) { $success=1; }
      }
      if (!$success) {
        copy ("$path/patchdiag.xref", $input{xref});
        my ($atime, $mtime)=(stat("$path/patchdiag.xref"))[8..9];
        utime $atime, $mtime, $input{xref};
        $success=1;
      }
    }
  }
  if (!$success && $o{localurl} && ($o{localurl} =~ /^http:|^https:|^ftp/)) {
    dbg ("Getting patchdiag.xref from $o{localurl}");
    $o{wget} || err ("Can't find wget executable");
    $runningdl="$input{xref}";
    `$o{wget} $o{wgetq} -N "$o{localurl}patchdiag.xref" -P $o{xrefdir}`;
    $runningdl="";
    if (!$? && (-s $input{xref})) { $success=1 }
  }
  if (!$success) {
    dbg ("Getting patchdiag.xref from patches.sun.com");
    $o{wget} || err ("Can't find wget executable");
    $runningdl="$input{xref}";
    `$o{wget} $o{wgetq} $o{nocache} -N "http://patches.sun.com/reports/patchdiag.xref" -P $o{xrefdir}`;
    $runningdl="";
    if (!$? && (-s $input{xref})) { $success=1 }
  }
  lock_remove($o{xrefdir}, "xref");
  
  if ($success) {
    print "done\n" unless $o{noheader};
    if ($o{xrefown} || ($o{xrefdir} =~ /\/home\//)) {
      chmod 0644, $input{xref};
    } else {
      chmod 0666, $input{xref};
    }
  } else {
    print "failed\n" unless $o{noheader};
  }
}

sub get_current_patches {
  # Read patchdiag.xref
  #
  open(XREF, "<$input{xref}") || err ("Can't open xref file $input{xref} ($!)");
  $_=<XREF>;
  $_ || err ("Empty file $input{xref}");
  if ($_ =~ /PATCHDIAG TOOL CROSS-REFERENCE FILE AS OF (.*) /) {
    print "Using $input{xref} from $1\n" unless $o{noheader};
  }
  $/=""; my $xref= <XREF>; $/="\n";
  close XREF;

  my @xref= split( /\n/, $xref );

  # Temporary
  push (@xref, '112908|27|Aug/25/06|R|S| |  |9|sparc;sparc.sun4u;sparc.sun4us;|SUNWcar:11.9.0,REV=2002.04.06.15.27;SUNWcar:11.9.0,REV=2002.04.09.12.25;SUNWcarx:11.9.0,REV=2002.04.06.15.27;SUNWcarx:11.9.0,REV=2002.04.09.12.25;SUNWcsr:11.9.0,REV=2002.04.06.15.27;SUNWcstl:11.9.0,REV=2002.04.06.15.27;SUNWcstlx:11.9.0,REV=2002.04.06.15.27;SUNWgss:11.9.0,REV=2002.04.06.15.27;SUNWgssk:11.9.0,REV=2002.04.06.15.27;SUNWgsskx:11.9.0,REV=2002.04.06.15.27;SUNWgssx:11.9.0,REV=2002.04.06.15.27;SUNWhea:11.9.0,REV=2002.04.06.15.27;SUNWkrbu:11.9.0,REV=2002.04.06.15.27;SUNWkrbux:11.9.0,REV=2002.04.06.15.27;|SunOS 5.9: krb5, gss patch');
  push (@xref, '115168|13|Aug/31/06|R|S| |  |9_x86|i386;114263-05|SUNWcstl:11.9.0,REV=2002.11.04.02.51;SUNWgssk:11.9.0,REV=2002.11.04.02.51;SUNWkrbu:11.9.0,REV=2002.11.04.02.51;|SunOS 5.9_x86: krb5, gss patch');

  # Build our patch information table from the xref file.
  # patchdiag.xref is sorted, so if multiple revisions of a patch are listed,
  # the one with the highest revision comes last.
  #
  foreach my $i (sort @xref) {
    # Ignore comment lines
    if ($i !~ /^\d/) { next; }

    my ($id, $crev, $reldate, $rFlag, $sFlag, $oFlag, $byFlag, $os,
      $archs, $pkgs, $synopsis )= split( /\|/, $i);

    init_patch($id);

    # If an installed patch revision is marked bad, note this.
    if (($p{$id}{irev} eq $crev) && ($byFlag =~ ".B")) {
      $p{$id}{ibad}= 1;
      dbg ("Bad patch installed: $id-$p{$id}{irev}");
    }

    # If a patch revision is obsoleted or bad, use either the highest
    # non-obsoleted revision, or the highest obsoleted revision if all
    # revisions are obsoleted or bad.
    #
    if ($p{$id}{crev} ne "00") {
      if (($oFlag eq "O") || ($byFlag =~ ".B")) {
        if (!$p{$id}{obs} && !$p{$id}{bad}) { next; }
      }
    }

    $p{$id}{crev}=$crev;
    if ($reldate ne '') { $p{$id}{reldate}=$reldate; }
    $p{$id}{rec}=0; if ($rFlag  eq 'R' ) { $p{$id}{rec}=1; }
    $p{$id}{sec}=0; if ($sFlag  eq 'S' ) { $p{$id}{sec}=1; }
    $p{$id}{obs}=0; if ($oFlag  eq 'O' ) { $p{$id}{obs}=1; }
    $p{$id}{bad}=0; if ($byFlag =~ ".B") { $p{$id}{bad}=1; }
    $p{$id}{y2k}=0; if ($byFlag =~ "Y.") { $p{$id}{y2k}=1; }
    $p{$id}{os}=$os;
    $p{$id}{synopsis}=$synopsis;

    # If a patch is obsoleted by another patch, note it.
    # There are (at least) two forms, one with a patch revision
    # and one without. We check for both.
    #
    if ($p{$id}{obs}) {
      if ($synopsis =~ /Obsoleted by[ :]*(\d{6})-(\d{2})/) {
        if ($id ne $1) {
          $p{$id}{obsoletedby}="$1-$2";
          #dbg ("$id-$crev obsoleted by $p{$id}{obsoletedby}");
        }
      }
      if ($synopsis =~ /OBSOLETED by (\d{6})/) {
        if ($id ne $1) {
          $p{$id}{obsoletedby}="$1-01";
          #dbg ("$id-$crev obsoleted by $p{$id}{obsoletedby}");
        }
      }
    }

    # Patches might be obsoleted by installed patches, which are not
    # (yet) listed in patchdiag.xref.
    #
    if (($p{$id}{iobsoletedby}) && (!$p{$id}{obs})) {
      $p{$id}{obs}=1;
      $p{$id}{obsoletedby}=$p{$id}{iobsoletedby};
    }

    # Patch requires are coded into the archs field - separate them.
    $p{$id}{archs}='';
    $p{$id}{requires}='';
    foreach my $r (split /\;/, $archs) {
      if ($r =~ /^\d{6}-\d{2}/) {
        $p{$id}{requires} .= "$r;";
        # We run init_patch here for required patches because they might
        # be missing in the xref file, and would be uninitialized later.
        my ($r_id, $r_rev)= split (/-/, $r);
        init_patch($r_id);
      } else {
        $p{$id}{archs} .= "$r;";
      }
    }
    # Patch incompatibilities are coded into the pkgs field
    $p{$id}{pkgs}='';
    foreach my $r (split /\;/, $pkgs) {
      if ($r =~ /^\d{6}-\d{2}/) {
        my ($r_id, $r_rev)= split (/-/, $r);
        init_patch($r_id);
        #dbg ("$r_id-$r_rev incompatible with $id-$crev");
      } else {
        $p{$id}{pkgs} .= "$r;";
      }
    }
  }
}

sub init_patch {
  my $id=$_[0];

  # Every patch should be initialized only once.
  return if ($p{$id}{init});

  $p{$id}{irev}= $p{$id}{crev}= $p{$id}{prev}= '00';
  $p{$id}{synopsis}= 'NOT FOUND IN CROSS REFERENCE FILE!';
  $p{$id}{rec}= $p{$id}{sec}= $p{$id}{obs}= $p{$id}{bad}= $p{$id}{y2k}= 0;
  $p{$id}{recf}= $p{$id}{secf}= 0;
  $p{$id}{os}= '';
  $p{$id}{pkgs}= '';
  $p{$id}{ignore}= '';
  $p{$id}{reldate}= 'Jan/01/70';
  $p{$id}{obsoletedby}= '';
  $p{$id}{iobsoletedby}= '';
  $p{$id}{archs}= '';
  $p{$id}{requires}= '';
  $p{$id}{listed}= 0;
  $p{$id}{ibad}= 0;
  $p{$id}{init}= 1;
}

sub print_patch {
  my $id=$_[0];
  my ($char, $h_char, $irev, $crev, $rec, $sec, $bad, $age, $synopsis);

  if ($p{$id}{irev} lt $p{$id}{crev}) { $char='<'; $h_char='&lt;'; }
  if ($p{$id}{irev} eq $p{$id}{crev}) { $char='='; $h_char='='; }
  if ($p{$id}{irev} gt $p{$id}{crev}) { $char='>'; $h_char='&gt;'; }

  $irev= $p{$id}{irev}; if ($irev eq "00") { $irev= '--' };
  $crev= $p{$id}{crev}; if ($crev eq "00") { $crev= '--' };

  $rec='-'; if ($p{$id}{recf}) { $rec='r'; }; if ($p{$id}{rec}) { $rec='R'; }
  $sec='-'; if ($p{$id}{secf}) { $sec='s'; }; if ($p{$id}{sec}) { $sec='S'; }
  $bad='-'; if ($p{$id}{ibad}) { $bad='B'; }

  $synopsis= $p{$id}{synopsis};

  $age=calculateage($p{$id}{reldate});
  if ($age > 999) { $age=999; }

  if (!$o{listhtml}) {
    printf "%6d %2s %1s %2s %1s%1s%1s %3d %s\n", $id, $irev, $char, $crev, $rec, $sec, $bad, $age, $synopsis;
  } else {
    # The patch download link will only work for patches in zip format,
    # there is no way to determine if it's in zip or tar.Z here.
    #
    $synopsis =~ s/\&/\&amp;/;
    printf "<tr>";
    if ($o{user} && $o{passwd}) {
      printf "<td><a href=\"http://sunsolve.sun.com/private-cgi/pdownload.pl?target=$id-$crev&method=h\">%6d</a>", $id;
    } else {
      printf "<td><a href=\"http://patches.sun.com/all_unsigned/$id-$crev.zip\">%6d</a>", $id;
    }
    printf "<td>%2s<td>%1s<td>%2s<td>%1s%1s%1s<td align=right>%3s", $irev, $h_char, $crev, $rec, $sec, $bad, $age;
    if ($o{user} && $o{passwd}) {
      printf "<td><a href=\"http://sunsolve.sun.com/private-cgi/getpatch.pl?documentId=$id\">%s</a></tr>\n", $synopsis;
    } else {
      printf "<td><a href=\"http://patches.sun.com/all_unsigned/$id-$crev.README\">%s</a></tr>\n", $synopsis;
    }
  }
}

sub print_header {
  if (!$o{listhtml} && !$o{noheader}) {
    print "Host: $u{hostname} ($u{osname} $u{osrel}/$u{osversion}/$u{arch}/$u{model})\n\n";
    print "Patch  IR   CR RSB Age Synopsis\n";
    print "------ -- - -- --- --- " . '-' x 55 . "\n";
  }
  if ($o{listhtml}) {
    print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"";
    print "\n  \"http://www.w3.org/TR/html4/loose.dtd\">\n";
    print "<html>\n<head>\n";
    print "<title>PCA report for $u{hostname}</title>\n";
    print "</head>\n<body>\n";
    print "<h2>Host: $u{hostname} ($u{osname} $u{osrel}/$u{osversion}/$u{arch}/$u{model})</h2>\n<table>\n";
    print "<tr><th>Patch</th>";
    print "<th><span title='Installed Revision'>IR</span></th><th></th>";
    print "<th><span title='Current Revision'>CR</span></th>";
    print "<th><span title='Recommended/Security/Bad Status'>RSB</span></th>";
    print "<th>Age</th>";
    print "<th>Synopsis</th></tr>\n";
  }
}

sub print_footer {
  if ($o{listhtml}) {
    print "</table>\n</body>\n</html>\n";
  }
}

sub get_readme {
  my $pp=$_[0];

  my $rfile="$o{tmpdir}/README.$pp" . time() . $$;
  $runningdl=$rfile;
  print STDERR "Download README for $pp: " unless $o{proxy};

  # If we have the zip file, extract README from there. This doesn't work
  # for tar/tar.Z files, as Sun's tar cannot extract files to stdout.
  if (-f "$o{patchdir}/$pp.zip") {
    dbg ("Getting README from $o{patchdir}/$pp.zip");
    `$unzip -p $o{patchdir}/$pp.zip $pp/README.$pp >$rfile 2>/dev/null`;
  }
  # Try to get README from local patch server
  if ((! -s $rfile) && $o{localurl} && ($o{localurl} =~ /^file:/)) {
    my $path=$o{localurl}; $path =~ s/^file://;
    dbg ("Getting README from $o{localurl}");
    (-r "$path/README.$pp") && copy ("$path/README.$pp", $rfile);
  }
  if ((! -s $rfile) && $o{localurl} && ($o{localurl} =~ /^http:|^https:|^ftp/)) {
    dbg ("Getting README from $o{localurl}");
    $o{wget} || err ("Can't find wget executable");
    `$o{wget} $o{wgetq} -O $rfile $o{localurl}README.$pp`;
  }
  # Try download from public patch server
  if (! -s $rfile) {
    dbg ("Getting README from patches.sun.com");
    $o{wget} || err ("Can't find wget executable");
    `$o{wget} $o{wgetq} -O $rfile http://patches.sun.com/all_unsigned/$pp.README`;
  }
  # Try download from restricted patch server, if the user provided
  # Sun Online Account data
  if ((! -s $rfile) && $o{user} && $o{passwd}) {
    dbg ("Getting README from sunsolve.sun.com");
    $o{wget} || err ("Can't find wget executable");
    my $retry=0;
    while ($retry < 5) {
      `$o{wget} $o{wgetq} -O $rfile --http-user='$o{user}' --http-passwd='$o{passwd}' "http://sunsolve.sun.com/private-cgi/pdownload.pl?target=$pp&method=r"`;
      if (!$? && (-s $rfile)) { last; }
      $retry++; sleep ($retry*2);
    }
  }
  $runningdl="";

  if (-s $rfile) {
    print STDERR "done\n" unless $o{proxy};
    return ($rfile);
  } else {
    print STDERR "failed\n" unless $o{proxy};
    unlink ($rfile);
    return ();
  }
}

sub dbg {
  $o{debug} || return;
  print "## "; printf @_; print "\n";
}

sub calculateage {
  my ($tmonth, $day, $year)=split(/\//, $_[0]);
  my %months=("Jan",0,"Feb",1,"Mar",2,"Apr",3,"May",4,"Jun",5,"Jul",6,"Aug",7,"Sep",8,"Oct",9,"Nov",10,"Dec",11);
  my $month=$months{$tmonth};

  return (int(($currenttime-timelocal(0,0,0,$day,$month,$year))/86400));
}

sub lock_create {
  my $lockd=$_[0]; my $tag=$_[1]; my $maxretry=$_[2];
  my $lockf="$lockd/.pcaLock.$tag";

  lock_free ($lockd, $tag, $maxretry) || return (0);

  unlink "$lockf";
  sysopen (LOCKF, $lockf, O_RDWR|O_CREAT|O_EXCL) || err ("Can't write $lockf ($!)");
  print LOCKF "$$\n";
  close LOCKF;
  chmod 0666, $lockf;
  $lockset=$lockf;
  return (1);
}

sub lock_free {
  my $lockd=$_[0]; my $tag=$_[1]; my $maxretry=$_[2];
  my $lockf="$lockd/.pcaLock.$tag";

  my $retry=0;
  while ($retry < $maxretry) {
    if (-s "$lockf") {
      open (LOCKF, "<$lockf");
      chomp(my $pid = <LOCKF>);
      close LOCKF;
      if (kill (0, $pid) || ($! eq "Not owner")) {
        dbg ("Locking $lockf failed");
        sleep (1);
        $retry++;
        next;
      }
    }
    return (1);
  }
  return (0);
}

sub lock_remove {
  my $lockd=$_[0];
  my $tag=$_[1];
  my $lockf="$lockd/.pcaLock.$tag";

  unlink "$lockf";
  $lockset='';
}

sub log_msg {
  ($o{syslog}) && system("$logger -t pca -p $o{syslog}.info \"@_\"");
}

sub err {
  if ($o{proxy}) {
    print "Content-type: text/plain\n";
    print "Status: 404 Not Found\n\n";
    print "Internal Error: @_\n";
  } else {
    print STDERR "\nERROR: @_\n";
  }
  cleanup();
  exit (1);
}

sub handler {
  err ("Caught a SIG@_");
}

sub cleanup {
  dbg ("Cleanup");
  if ($runningdl ne "") {
    dbg ("Removing $runningdl");
    unlink "$runningdl";
  }
  if (@rlist) {
    dbg ("Removing @rlist");
    unlink (@rlist);
  }
  $patchxdir && rmtree ($patchxdir);
  $lockset && unlink "$lockset";
  $sttyset && system "stty echo";
}

sub parse_args {
  # List of all valid options
  my @opts=(
    "list", "listhtml", "download", "install", "pretend", "readme", "getxref",
    "xrefdir", "nocheckxref", "xrefown", "nocache", "patchdir", "askauth",
    "user", "passwd", "localurl", "pattern", "noreboot", "syslog", "nobackup",
    "safe", "currentzone", "patchadd", "noheader", "fromfiles", "root", "wget",
    "debug", "help", "version", "operands");

  # Options for internal use only
  $o{wgetq}='-q'; $o{patchadd_options}=''; $o{proxy}='';

  # Get internal defaults
  foreach my $default (@defaults) {
    my ($name, $value) = split (/=/, $default);
    foreach my $opt (@opts) {
      if ($name eq $opt) { $o{$opt}=$value; last }
    }
  }

  # Get defaults from optional configuration file(s)
  my @conf=();
  push (@conf, dirname($0)."/pca.conf");
  push (@conf, dirname(dirname($0))."/etc/pca.conf");
  push (@conf, "/etc/pca.conf");
  $ENV{HOME} && push (@conf, $ENV{HOME}."/.pca");
  push (@conf, "pca.conf");

  foreach my $i (@conf) {
    dbg ("Config file: $i");
    open (CONF, "<$i") || next;
    while (<CONF>) {
      chomp;
      s/\s*#.*$//;
      s/^\s*//; s/\s*$//;
      next if /^$/;
      if (/(\w+)\s*=\s*(.*)/) {
        foreach my $opt (@opts) {
          if ($1 eq $opt) { $o{$opt}=$2; last }
        }
      }
      if (/(\d{6})\s+ignore/) { init_patch($1); ($p{$1}{ignore}= "00") }
      if (/(\d{6})-(\d{2})\s+ignore/) { init_patch($1); ($p{$1}{ignore}= $2) }
      if (/(\d{6})\s+\+rec/) { init_patch($1); ($p{$1}{recf}= 1) }
      if (/(\d{6})\s+\+sec/) { init_patch($1); ($p{$1}{secf}= 1) }
    }
  }

  # Get defaults from optional environment variables (PCA_*)
  foreach my $opt (@opts) {
    my $env=uc("PCA_$opt");
    $ENV{$env} && ($o{$opt}=$ENV{$env});
  }

  # Proxy mode ?
  if (basename($0) eq "pca-proxy.cgi") {
    $o{proxy}=1;
    if (($#ARGV != 0) ||
        (($ARGV[0] !~ /^patchdiag.xref$/) &&
        ($ARGV[0] !~ /^\d{6}-\d{2}\.(zip|tar|tar\.Z)$/) &&
        ($ARGV[0] !~ /^README\.\d{6}-\d{2}$/))) {
      err ("Illegal argument");
    }
    $o{proxy}=$ARGV[0];
    $o{localurl}=""; $o{noheader}=1;
    $o{xrefdir}=$o{patchdir}=getcwd();
    return;
  }

  # Get command line options
  Getopt::Long::config ("bundling", "no_ignore_case");
  GetOptions (\%o,
    "list|l", "listhtml|L", "download|d", "install|i", "pretend|I", "readme|r",
    "getxref|x", "xrefdir|X=s", "nocheckxref|y", "xrefown", "nocache",
    "patchdir|P=s", "askauth|a", "user=s", "passwd=s", "localurl=s",
    "pattern|p=s", "noreboot|n", "syslog=s", "nobackup|k", "safe|s", "currentzone|G",
    "patchadd=s", "noheader|H", "fromfiles|f=s", "root|R=s", "wget=s",
    "debug|V", "help|h", "version|v") || usage() && exit 1;

  if ($o{help}) { usage(); exit 0 }
  if ($o{version}) { version(); exit 0 }

  $o{listhtml} && ($o{list}=1);
  $o{pretend} && ($o{install}=1);
  $o{readme} && ($o{noheader}=1);
  $o{root} && ($o{root}="-R $o{root}");
  $o{nobackup} && ($o{patchadd_options}.="-d ");
  $o{currentzone} && ($o{patchadd_options}.="-G ");
  $o{nocache} && ($o{nocache}="--cache=off");
  $o{debug} && ($o{wgetq}='');
  if ($o{localurl} && $o{localurl} =~ /pca-proxy\.cgi$/) { $o{localurl} .= "?"; }
  ($o{patchdir} !~ /^\//) && ($o{patchdir}= getcwd());

  # Set defaults
  $o{operands} && !@ARGV && (@ARGV=(split (/\s+/, $o{operands})));
  ($o{download} || $o{install} || $o{readme} || $o{getxref}) || ($o{list}=1);

  foreach my $opt (@opts) {
    $o{$opt} && dbg ("Option $opt: $o{$opt}");
  }
}

sub usage {
  print<<EOT
Usage: $0 [OPTION] .. [OPERAND] ..

Operands:
  patch group:    missing, installed, all, total, unbundled, bad
                  Add r, s or rs at the end to list Recommended,
                  Security or Recommended/Security patches only.
  patch ID:       123456, 123456-78
  patch file:     123456-78.zip, 123456-78.tar.Z
  file name:      patchlist.txt

Options:

  -l, --list           List patches
  -L, --listhtml       List patches, produce HTML output
  -d, --download       Download patches
  -i, --install        Install patches
  -I, --pretend        Pretend to install patches
  -r, --readme         Display patch READMEs
  -x, --getxref        Download patch xref file
  -X, --xrefdir=DIR    Location of patch xref file
  -y, --nocheckxref    Do not check for updated patch xref file
      --xrefown        Give write permissions on xref file to user only
      --nocache        Tell proxy to not cache xref file
  -P, --patchdir=DIR   Patch download directory
  -a, --askauth        Ask for Sun Online Account data interactively
      --user=USER      Sun Online Account user name
      --passwd=PASS    Sun Online Account password
      --localurl=URL   Local patch server URL
  -p, --pattern=REGEX  List only patches whose synopsis matches REGEX
  -n, --noreboot       Install only patches which do not require a reboot
      --syslog=TYPE    Log successful patch installs to syslog facility TYPE
  -k, --nobackup       Make patchadd not back up files to be patched
  -s, --safe           Check locally modified files for safe patch installation
  -G, --currentzone    Make patchadd install patches in the current zone only
      --patchadd=FILE  Path to patchadd command
  -H, --noheader       Don't display descriptive headers
  -f, --fromfiles=DIR  Read uname/showrev/pkginfo output from files in DIR
  -R, --root=DIR       Alternative root directory
      --wget=FILE      Path to wget command
  -V, --debug          Print debug information
  -h, --help           Display this help
  -v, --version        Display version information
EOT
}

sub version {
  print "pca 5.2 (2006/11/28)\n";
}