# ! D:/Program Files/Perl/bin/Perl.exe -w


# Read a FlexLM LICENSE.DAT file and print stats & totals for all licenses.

# paul_m_thompson@yahoo.com
# This script will (hopefully) process a FlexLM license file and print
# a report on features.

# ** *********************************************************************
# ** 
# ** $Id: //Tools/SCM/FlexLM/FlexLmLicenseInfo.pl#1 $
# ** $Change: 2642 $
# ** $DateTime: 2006/03/23 17:26:37 $
# ** $Author: paul.m.thompson $
# ** 
# ** *********************************************************************



# ---------------------------------------------------------------------------
# pragmas

use strict ;
use diagnostics ;
use warnings ;

# ---------------------------------------------------------------------------
# modules used

# Get command line options
use Getopt::Long qw( :config bundling ) ;

use Data::Dump qw( dump ) ;

use Text::ParseWords ;

# ---------------------------------------------------------------------------

# prototypes of local functions.
sub Usage(;$) ;
sub ValuePart($\@) ;
sub trim(\$) ;

# ---------------------------------------------------------------------------

# Constants
use constant DEFAULT_LICENSE_FILE => 'License.dat' ;

# ---------------------------------------------------------------------------

# globals
our $PERL_ID = sprintf "Perl v%vd for '$^O'", $^V ;
our $PVCS_REVISION = sprintf("Rev %d", q$Revision: #1 $ =~ /\D+(\d+)/) . sprintf(" : Change %d", q$Change: 2642 $ =~ /\D+(\d+)/);

# Command line options
our %Options ;

# ---------------------------------------------------------------------------
# Special blocks
# ---------------------------------------------------------------------------
# BEGIN {}
# CHECK {}
# INIT {}
# END {}

# ---------------------------------------------------------------------------
# Main
# ---------------------------------------------------------------------------

# Set default options.
$Options{LicenseFile} = DEFAULT_LICENSE_FILE ;

# Fetch all command line options into the %Options hash.
# <none>   option does not take an argument
# =s :s    option takes a mandatory (=) or optional (:) string argument
# =i :i    option takes a mandatory (=) or optional (:) integer argument
# =f :f    option takes a mandatory (=) or optional (:) real number argument
# >new     option is a synonym for option `new'
GetOptions
(
   \%Options ,
   'LicenseFile=s' ,
   'Verbose' ,
   'Version' ,
   'Help|?' ,
);


# -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -

# diagnostics.
if ($Options{Verbose})
{
   print "\nAll options:\n" ;
   print "   $_ = '$Options{$_}'\n" foreach (keys %Options) ;
   print "\n" ;
}

# -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -


# Check for required options (hmmmm... "required options" ... is that an oxymoron or what?)
Usage if $Options{Help} ;
Usage("You must specify a xxx '--xxx=X'") unless $Options{LicenseFile} ;

# -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -

print "open dat file: $Options{LicenseFile}\n";
open DATFILE,$Options{LicenseFile} or die "Can't open FlexLM license file '$Options{LicenseFile}' : $!\n" ;
print "scan dat file\n";

my (%Servers,%VendorDaemons,%FeatureIncrements,%Packages,%Other) ;
my $ToBeContinued = '' ;


my $Line ;
my (%Features,%Vendors,%FeatureVersions,%ExpirationDates,%Serials,@Features) ;

push @Features,['Feature Name','Vendor','Version','Expiration Date','License Count','Serial Number'] ;

while (defined($Line = <DATFILE>))
{
   trim $Line ;
   if ($Line =~ s/\\$//)
   {
      # Read and append next line
      my $Nxt = <DATFILE> ;
      trim $Nxt ;
      $Line .= $Nxt ;
      # Keep going until we find a line that doesn't end with line continuation sequence
      redo unless eof(DATFILE) ;
   }

   # Skip blank lines or comment lines
   next if $Line =~ /^\s*$/ or $Line =~ /^\s*#/ ;

   # Trim leading / trailing whitespace.
   trim $Line ;


   my @Fields = parse_line('\s+',0,$Line) ;
# print "\n$Line\n";
# for (my $i=0;$i<=$#Fields;$i++) {print "\tfield $i = '$Fields[$i]'\n";}

   my $lcTag = lc($Fields[0]) ;
   my $Vendor ;


   if ($lcTag eq 'server')
   {
      # The format of the SERVER line is:
      # SERVER host hostid [port]
      # where:
      #
      # host		The system host name or IP address.  String returned by the  
      #			UNIX hostname or uname -n command.  On NT/2000/XP, ipconfig  
      #			/all; on Windows 95/98/ME, winipcfg /all return the host     
      #			name.                                                        
      #
      # hostid	Usually the string returned by the lmhostid command.  This is 
      #			changed only by your software supplier.                       
      #
      # port		TCP/IP port number to use.  A valid number is any unused port 
      #			number between 0 and 64000.  On UNIX, choose a port >1024,    
      #			since those <1024 are privileged port numbers.  If no TCP/IP  
      #			port number is specified, one of the default ports in the     
      #			range of 27000 and 27009 is used.                             
      #
      # The SERVER line specifies the host name and hostid of the license server 
      # and the TCP/IP port number of the license manager daemon (lmgrd).  
      # Normally a license file has one SERVER line.  Three SERVER lines mean that 
      # you are using a three-server redundant license server.  The absence of a 
      # SERVER line means that every FEATURE and INCREMENT line in the license 
      # file is uncounted.  
      #
      # The hostids from the SERVER lines are computed into the license key or 
      # signature on every FEATURE and INCREMENT line.  For this reason, make sure 
      # you keep SERVER lines together with any FEATURE/INCREMENT lines as they 
      # were sent from the vendor.  
      $Servers{lc($Fields[1])}{lc($Fields[2])}{'port=' . lc($Fields[3])}++ ;
   }
   elsif ($lcTag eq 'daemon' or $lcTag eq 'vendor')
   {
      # The VENDOR line specifies the daemon name and path.  lmgrd uses this line 
      # to start the vendor daemon, and the vendor daemon reads it to find its 
      # options file.  The format of the VENDOR line is shown below.  

      # VENDOR vendor [vendor_daemon_path] 
      #	[[options=]options_file_path] 
      #	[[port=]port]

      # VENDOR lines are known as DAEMON lines in the pre-v6.0 lmgrd and vendor 
      # daemon.  
# print "VENDOR/DAEMON: $_\n";
      $Vendor = $Fields[1] ;
      my $DaemonPath= $Fields[2] || '' ;
      $VendorDaemons{$Vendor}{path} = $DaemonPath unless !$DaemonPath or ($DaemonPath =~ /options.*=/i) or ($DaemonPath =~ /port.*=/i) ;
      my $Options = ValuePart('options',@Fields) ;
      my $Port= ValuePart('port',@Fields) ;
      $VendorDaemons{$Vendor}{options} = $Options if $Options ;
      $VendorDaemons{$Vendor}{port} = $Port if $Port;
   }
   elsif ($lcTag eq 'feature' or $lcTag eq 'increment')
   {
      # A FEATURE line describes the license required to use a product.  An 
      # INCREMENT line can be used in place of a FEATURE line, as well as to 
      # incrementally add licenses to a prior FEATURE or INCREMENT line in the 
      # license file.  
      #
      # Only the first FEATURE line for a given feature is processed by the vendor 
      # daemon.  If you want to have additional copies of the same feature (for 
      # example, to have multiple node-locked, counted features), then you must 
      # use multiple INCREMENT lines.  INCREMENT lines form license groups, or 
      # pools, based on the following fields: 
      #
      # **	feature name
      # **	version
      # **	DUP_GROUP
      # **	FLOAT_OK
      # **	HOST_BASED
      # **	HOSTID
      # **	PLATFORM
      # **	USER_BASED
      # **	VENDOR_STRING (if configured by the vendor as a pooling component)
      #
      # If two lines differ by any of these fields, a new group of licenses, 
      # called a license pool, is created in the vendor daemon, and this group is 
      # counted independently from other license pools with the same feature name.  
      # A FEATURE line does not give an additional number of licenses, whereas an 
      # INCREMENT line always gives an additional number of licenses.  
      #
      # The basic FEATURE/INCREMENT line format is:
      #	{FEATURE|INCREMENT} feature vendor feat_version exp_date \
      #		num_lic SIGN=sign [optional_attributes]
      #
      # The six fields after the FEATURE/INCREMENT line keyword are required and    
      # have a fixed order.  They are defined by the vendor and cannot be changed.  
      #                                                                             
      #
      # feature	Name given to the feature by the vendor.
      #
      # vendor	Name of the vendor daemon; also found in the
      #		VENDOR line. The specified daemon serves this feature.
      # 
      # feat_version	Version of this feature that is supported by this
      #		license.
      # 
      # exp_date	Expiration date of license in the format ddmmm- yyyy, e.g.,   
      #		07-may-2005.  Note: If exp_date is the string "permanent" or  
      #		the year is 0 (or 00, 000, 0000) then the license never       
      #		expires.                                                      
      #		                                                              
      # num_lic	Number of concurrent licenses for this feature.  If the       
      #		num_lic is set to the string uncounted or 0, the licenses for 
      #		this feature are uncounted and no lmgrd is required but a     
      #		hostid on the FEATURE line is required.  See Section 4.4,     
      #		Counted vs.  Uncounted Licenses.                              
      #		                                                              
      # SIGN=sign	SIGN= signature to authenticate this FEATURE line.

      
      # Table B-2 lists attributes that may appear in a FEATURE or INCREMENT line.    
      # They are supplied at the discretion of the vendor to provide particular       
      # licensing behavior.  If present in the FEATURE or INCREMENT line, they must   
      # remain there and cannot be altered by the end user.  These attributes have a  
      # keyword=value syntax where keyword is in uppercase.  In places where value is 
      # a string surrounded with double quotes ("..."), the string can contain any    
      # characters except a quote.                                                    

      # examples from our license.dat:

      #  Feature RPVBA iload_d 4.200 08-feb-2004 1 6B40374BC2BD \
      #     VENDOR_STRING=1002763497528962 ck=123
      #  FEATURE SW1900-05 Tasking 8.000 1-jan-0000 0 0BA8A76B55BD3488C1527 "078393" ANY
      #  INCREMENT armulate armlmd 1.2 permanent 2 52C6AA8765FF DUP_GROUP=UHD \
      #     ISSUER="ARM Limited" NOTICE="For support please contact " \
      #     SN=DS120-FFFFF-00000-00000
      #  INCREMENT rvd_arm armlmd 1.7 permanent 1 F708ABC6543f3350F7 DUP_GROUP=UHD \
      #     ISSUER="ARM Limited" NOTICE="For support please contact \
      #     support-sw@arm.com" SN=RS210-7YM4N-55755-WK8P4 SIGN="1575 2C6A \
      #     F5C2 8780 58C6 5C1E 1D65 111E 6EB5 110B 1445 8A5A EF46 BD88 \
      #     7EA1 058E 8C45 6C84 1504 A71A C2E4 7661 B15F C8EB ABB6 EED6 \
      #     0F4B 85E5 88A0 F61E" SIGN2="1845 F087 244D C702 1A5A FADF 5445 \
      #     A784 5F44 6265 5A75 AF74 52DF 50D6 0041 122F AE50 541F 14E4 \
      #     FB18 DFA0 8742 84CA 861D CCC7 2C4B 864B 4E5A 5D4D BD58"


   # print "FEATURE/INCR: $Line\n\t'",join "'\n\t'",@Fields,"'\n";
      # I think (!?!) node-locked licenses have a license count of 0
      if ($Fields[5])
      {
         die "Missing feature field" unless my $Feature = lc($Fields[1]) ;
         die "Missing vendor field" unless $Vendor = lc($Fields[2]) ;
         die "Missing feature version field" unless my $FeaVer = lc($Fields[3]) ;
         die "Missing expiration date" unless my $ExpDate= lc($Fields[4]) ;
         die "Missing license count" unless my $NumLic = lc($Fields[5]) ;
print "odd field 6 '$Fields[6]'\n" unless length($Fields[6])==12 && $Fields[6] =~ /[0-9A-F]{12}/i ;

         my $Sn = (grep /SN\s*=/i,@Fields)[0] || '' ;
         $Sn =~ s/^sn\s*=\s*//i if $Sn ;
         push @Features,[$Feature,$Vendor,$FeaVer,$ExpDate,$NumLic,$Sn] ;

         # my (%Features,%Vendors,%FeatureVersions,%ExpirationDates) ;
         $Features{$Feature}{$Vendor}{$FeaVer}{$ExpDate}{$Sn}          += $NumLic ;
         $Vendors{$Vendor}{$Feature}{$FeaVer}{$ExpDate}{$Sn}           += $NumLic ;
         $FeatureVersions{$FeaVer}{$Feature}{$Vendor}{$ExpDate}{$Sn}   += $NumLic ;
         $ExpirationDates{$ExpDate}{$Feature}{$Vendor}{$FeaVer}{$Sn}   += $NumLic ;


         # Save S/N keyed hash.  Sub-keys are :
         #     'Features'  : a semi-colon delimited string of all features for this S/N
         #     'Count'     : A count of the number of users for this S/N
         # NOTE: If any of the features indicate a different count value, that Feature 
         # is coded with a (!n) trailer, where 'n' is the count for that feature
         if (exists($Serials{$Sn}{Count}))
         {
            $Serials{$Sn}{Features} .= ($Serials{$Sn}{Count} == $NumLic) ? ";$Feature" : ";$Feature(!$NumLic)" ;
            $Serials{$Sn}{Version} .= ";$FeaVer" unless index($Serials{$Sn}{Version},$FeaVer) >= 0 ;
         }
         else
         {
            $Serials{$Sn}{Count} = $NumLic ;
            $Serials{$Sn}{Features} = $Feature ;
            $Serials{$Sn}{Version} = $FeaVer ;

         }

   print "feature=$Feature : vend=$Vendor : ver=$FeaVer : exp=$ExpDate : num=$NumLic : sn=$Sn\n";

      }
      else
      {
         print "Possible node locked license at line $. (License count = 0):\n\t$Line\n";
      }
   }
   elsif ($lcTag eq 'package' )
   {
# print "PACKAGE: $Line\n";
   }
   else
   {
# print "OTHER: $Line\n";
   }

}


print "\nBy Feature:\n";
foreach my $Fea (keys %Features)
{
   my $FeaStr = sprintf "%30s",$Fea ;
   foreach my $Vnd (keys %{$Features{$Fea}})
   {
      my $VndStr = sprintf "%10s",$Vnd ;
      foreach my $FV (keys %{$Features{$Fea}{$Vnd}})
      {
         my $FvStr = sprintf "%10s",$FV ;
         foreach my $ED (keys %{$Features{$Fea}{$Vnd}{$FV}})
         {
            my $ExpDt = sprintf "%15s",$ED ;
            foreach my $SN (keys %{$Features{$Fea}{$Vnd}{$FV}{$ED}})
            {
               my $Ser = sprintf "%32s",$SN ;
               my $Numl = sprintf "%4u",$Features{$Fea}{$Vnd}{$FV}{$ED}{$SN} ;
               print "$FeaStr,$VndStr,$FvStr,$ExpDt,$Ser,$Numl\n" ;
            }
         }
      }
   }
}


print "\n\nFeatures and count by S/N\n";
foreach my $SN (sort(keys %Serials))
{
   next if $SN =~ /^\s*$/ ;
   print sprintf "%24s %3u %6s %s\n",$SN,$Serials{$SN}{Count},$Serials{$SN}{Version},join(';',sort(split(/;/,$Serials{$SN}{Features}))) ;
}



print "\nservers:\n",dump(%Servers),"\n";
print "\nVendor daemons:\n",dump(%VendorDaemons),"\n";

print "close dat file\n";
close DATFILE ;



# ---------------------------------------------------------------------------

# Optional param will print "special" messages first.
sub Usage(;$)
{
   print "\n",shift(),"\n" if $#_ >= 0 ;

   print "\n$0 : $PVCS_REVISION ($PERL_ID) \n" ;
   print "\nThis program will Print a summary of licenses extracted from a FlexLM license file.\n" ,
   "--LicenseFile=s : Specify license file to scan.\n" ,
   "                  Default = ",DEFAULT_LICENSE_FILE,"\n" ,
   "--Verbose       : Print more info.\n" ,
   "--Version       : Print program version info and quit.\n" ,
   "\n"
   ;

   exit ;
}

# ---------------------------------------------------------------------------

# Trim leading and trailing WHITESPACE from arg & return # of chars trimmed.
# Like "chomp()" but trims leading space as well.
sub trim(\$)
{
   my $Str = $_[0] ;
   $$Str =~ s/^\s+// ;
   $$Str =~ s/\s+$// ;
   return length(${$_[0]})-length($$Str) ;
}

# ---------------------------------------------------------------------------

# Given an array of key=value or value-only items, search for an entry
# matching the specified key (non-case-sensitive) and return the value
# component.
sub ValuePart($\@)
{
   my $Look4 = shift ;
   my @Ary = @{shift()} ;
   if (my ($Match) = grep /^\s*$Look4\s*=/i,@Ary)
   {
      return (split /\s*=\s*/,$Match)[1] ;
   }
   return undef ;
}