#!/usr/bin/perl -w
#
# Copyright 2000-2017, 2019 VMware, Inc.  All rights reserved. -- VMware Confidential
#
# VMKStats PC-Sampling Statistics
#

# This script dumps the stats out of the kernel, placing six 
# files in a directory. The "callStacks", "samples", "status" 
# and "images" files are generated by executing vmkstatsdumper. 
# The "symbolTable" file is generated from the information about 
# what modules are loaded where. The module information is dumped 
# in file "images". The "viewCallstack" file is generated to view 
# the vmkstats.
#
# Optionally dumps a disassembly of the object files
#

# imports
use strict;
no strict "subs";
use Getopt::Long;
use Getopt::Std;
use Math::BigInt; # More reliable 64-bit math than 'use bigint', see PR 75451.
use integer; # So integer division doesn't turn into a real number.
use File::stat;
use FindBin;
use lib $FindBin::Bin;
use CallstackCommon;

# <phone home>
use File::Basename;
my $scriptdir = dirname(__FILE__)."/phonehome.py";
if (-e $scriptdir) {
    my $script = basename(__FILE__);
    system($scriptdir." ".$script);
}
# </phone home>

my %options;
my $dumpDir;
my $symbolTableDir;
my $verbose = 0;
my $longFunctionNames = 0;
my $collector = "Default";

#Use -C flag to demangle c++ function names
my $objdump = "/build/toolchain/lin32/binutils-2.20.1/x86_64-linux/bin/objdump -C";

my $remote = 0;
my $retainASLR = 0;

# image paths
my $imageDirDefault = "/usr/lib/vmware";
my %imageLocations;

# server build type
my $buildDir;
my $buildType;
my $buildRoot;
my $product;

###
### Functions
###

sub usage()
{
   print <<'EOC'; # note: single quotes and no space after <<

   Usage:

   vmkcallstack.pl   [-r | --remote]
                     [-o | --output]
                     [-l | --imageLocations]
                     [-e | --embedded | --visor]
                     [-c | --collector]
                     [-d | --disassemble]
                     [-s | --source]
                     [     --objdump]
                     [-f | --fileName]
                     [-v | --verbose]
                     [-b | --build]
                     [-a | --retainASLR]
                     [-h | --help | --usage]
                     [-t | -symbolTableDir]

   --output
   Output directory. By default a new directory will be created with name 
   vmkstats-current-date.

   --remote
   Flag to indicate that the script is being run on a remote machine. 
   So we should not run vmkstatsdumper. Instead, look for the dumped samples 
   in the given output directory. Option --output must also be set if this 
   option is set.

   --imageLocations
   A list of locations (separated by semicolons) of images from which symbol 
   information is to be extracted. Each location is a pair of an image name and
   a file path separated by a colon. If you want to specify one directory path for 
   all images, use "all" instead of the image name. Script will search for an
   image in different directories in the following order:
   -imageLocation for that image if specified
   -imageLocation for "all" if specified
   -If not running remotely, default local image directory i.e set to "usr/lib/vmware".
   -Build tree if VMTREE is set

   --visor
   Set this option if running on visor. 

   --collector
   Specify from which collector the samples and callstacks should be retrieved.
	Uses the "Default" collector if nothing is specified.

   --retainASLR
   Retain ASLR addresses for modules, symbols and samples. Will not work with 
   --disassemble

   --disassemble
   disassemble vmkernel. Will not work with --retainASLR

   --source
   include source code with disassembly.

   --fileName
   Append image file name to the function name.

   --build
   build type such as opt | obj | beta

   --symbolTableDir
   Use the symbol tables from the given directory.

   --objdump
   Use the given objdump utility.

EOC
    exit(5);
}

   
sub process_args()
{
    my $ok = GetOptions("-r"              => \$options{'remote'},
                        "--remote"        => \$options{'remote'},
                        "-o=s"            => \$options{'output'},
                        "--output=s"      => \$options{'output'},
                        "-l=s"            => \$options{'imageLocations'},
                        "--imageLocations=s"=> \$options{'imageLocations'},
                        "-e"              => \$options{'visor'},
                        "--embedded"      => \$options{'visor'},
                        "--visor"         => \$options{'visor'},
                        "-c=s"            => \$options{'collector'},
                        "--collector=s"   => \$options{'collector'},
                        "-d"              => \$options{'disassemble'},
                        "--disassemble"   => \$options{'disassemble'},
                        "-s"              => \$options{'source'},
                        "--source"        => \$options{'source'},
                        "--objdump=s"     => \$options{'objdump'},
                        "-f"              => \$options{'fileName'},
                        "--fileName"      => \$options{'fileName'},
                        "--verbose"       => \$options{'verbose'},
                        "-v"              => \$options{'verbose'},
                        "-b=s"            => \$options{'build'},
                        "--build=s"       => \$options{'build'},
                        "-a"              => \$options{'aslr'},
                        "--retainASLR"    => \$options{'aslr'},
                        "--help"          => \$options{'help'},
                        "-h"              => \$options{'help'},
                        "--usage"         => \$options{'help'},
                        "-t=s"            => \$options{'symbolTableDir'},
                        "--symbolTableDir=s" => \$options{'symbolTableDir'},
                        );
   if (!$ok) {
      print "Unable to process command line args.\n";
      usage();
   }

   if (defined($options{'help'})) {
      usage();
   }

   if (defined($options{'symbolTableDir'})) {
      $symbolTableDir = $options{'symbolTableDir'};
   }

   if (defined($options{'verbose'})) {
      $verbose = 1;
   }

   if (defined($options{'remote'})) {
      $remote = 1;
      if (defined($options{'output'})) {
          $dumpDir = $options{'output'};
      } else {
          die "output directory must be given with option remote";
      }
      if (! -e $dumpDir) {
        die "directory $dumpDir does not exist";
      }
   } elsif (defined($options{'output'})) {
      $dumpDir = $options{'output'};
   } else {
      my $dateStr = `date +"%d%b%y-%H:%M:%S"`;
      chomp($dateStr);
      $dumpDir = "./vmkstats-$dateStr";
   }

   if (defined($options{'collector'})) {
      $collector = $options{'collector'};
   } 

   if (defined($options{'fileName'})) {
       $longFunctionNames = 1;
   }

   if (defined($options{'objdump'})) {
      $objdump  = $options{'objdump'};
   }
   CallstackCommon::SetObjdumpCmd($objdump);

   if (defined($options{'build'})) {
      $buildType  = $options{'build'};
   } elsif (defined $ENV{VMBLD}) {
      $buildType = $ENV{VMBLD};
   }

   if (defined $ENV{BUILDROOT}) {
      $buildRoot = $ENV{BUILDROOT};
   } elsif (defined $ENV{VMTREE}) {
      $buildRoot = "$ENV{VMTREE}/build";
   }

   if (defined $ENV{VMPROD}) {
      $product = $ENV{VMPROD};
   } else {
      # Default to esx
      $product = "esx";
   }

   if (defined($options{'imageLocations'})) {
      my @imageLocations = split(/;+/, $options{'imageLocations'});
      for my $imageLocation (@imageLocations) {
          if ($imageLocation) {
              my ($image, $path);
              if ($imageLocation =~ /(.*?):(.*)/) {
                  $image = $1;
                  $path = $2;
                  $imageLocations{$image} = $path;
              } else {
                  die "bad image locations format: $options{'imageLocations'}"
              }
              if (!-e $path) {
                  die "$path does not exist";
              }
              if ($image ne "all") {
                  # Location is the actual object file or a .debug file.
                  # Since shared libraries might be versioned, we will
                  # only match up to the first hit of '.', so that
                  # lib<name>.so.<version> can get matched to
                  # lib<name>.so.debug
                  # There are other exceptions as well -- .debug
                  # files can be located at differing paths, and for some
                  # libraries (upitObjBE.so, for example), the .debug
                  # file has the 'lib' prefix and the shipping library
                  # does not.
                  my @imageName = split('\.', $image);
                  my $filename = basename($imageName[0]);
                  my $libName = $filename;
                  $libName =~ s/lib//;
                  my $pathEnd = basename($path);

                  if (($path !~ /$imageName[0](.*)(\.o|)\s*$/) &&
                      ($path !~ /$imageName[0](.*)(\.debug|)\s*$/) &&
                      ($pathEnd !~ /$filename(.*)(\.debug|)\s*$/) &&
                      ($pathEnd !~ /$libName(.*)(\.debug|)\s*$/)) {
                      die "bad image location $path for image $image";
                  }
              }
          }
      }
   } elsif (!$buildRoot) {
      print "\nWARNING: VMTREE/BUILDROOT environment variable is not set, so unsure where\n";
      print "to search for vmkernel object files.\n";
      if ($remote) {
         die "Object files location unknown.\n";
      } else {
         print "Will try to look for object files in $imageDirDefault, but it may not work\n";
         print "If it does not work, set VMTREE/BUILDROOT or use imageLocation\n";
      }
   }

   if ($buildRoot) {
      if (!defined $buildType) {
         print "Warning: VMBLD env is not set\n";
      } else {
         $buildDir = "$buildRoot/scons/package/devel/linux32/$buildType/$product";
         print "VMTREE/BUILDROOT env is set. Will read the object files from $buildDir\n";
      }
   }

   #
   # Set followDebugLink if we are not executing on Visor. Likely on Linux
   #     => Set LD_LIBRARY_PATH and use VMTREE/.../followDebugLink
   #
   if (! -x "/sbin/followDebugLink") {
      my $libPath = $ENV{LD_LIBRARY_PATH};
      print("Looks like we're not running on ESX, using followDebugLink " .
            "from build tree...\n");
      CallstackCommon::SetFollowDebugLinkCmd("LD_LIBRARY_PATH=$libPath" .
                       " $buildDir/apps/followDebugLink-linux/followDebugLink-linux");
   }

   if (defined($options{'aslr'})) {
      $retainASLR = 1;
      if (defined($options{'disassemble'})) {
         die "retainASLR and disassemble are mutually exclusive options\n";
      }
   }
}


sub dumpDisassemblyFile($)
{
   my $dumpDir = shift;
   my $sourceCodeToo = defined($options{source});
   my $objDumpOption = $sourceCodeToo ? "-dS" : "-d";
   my $tagid;
   my @tags;
   my $image;
   my %arch;
   my %loadAddr;
   my $vmklinuxVersion;

   # parse tags from the image file
   my $output = `cat $dumpDir/images | grep -i tags`;
   if ($output =~ /Tags-(.*)\s+/) {
      @tags = split(/:/, $1);
      print "Tags: @tags\n";
   } else {
      die "Could not parse tags from image file";
   }

   $vmklinuxVersion =
       CallstackCommon::GetVmklinuxVersionFromImageFile("$dumpDir/images");

   foreach $tagid (@tags) {
      my @imageList = `cat $dumpDir/images | grep $tagid:`;
      my $disass_file = "$dumpDir/objdump.$tagid";
      my $addr;

      print("Will drop disassembly into $disass_file.\n");
      unlink($disass_file);

      # Go through image List and remove duplicates
      # There may be two entries for an image; one for text section and 
      # one for data. Take the text section one.
      foreach $image (@imageList) {
         if ($image =~ /^$tagid:(.*):(.*):(.*):(.*)/) {
            $image = $1;
            $addr = Math::BigInt->new($2)->as_hex();
            if ($image eq "vmkernel") {
               $addr = 0;
            }
            if ($image eq "") {
               print "WARNING: image name not found, skipping entry in file.\n";
            } elsif (!defined($addr) || $addr eq "") {
               print "WARNING: Could not find load address for image $image.\n";
            } elsif (!defined $loadAddr{$image}) {
               $loadAddr{$image} = $addr;
               $arch{$image} = $4;
            } elsif (!Math::BigInt->bcmp($loadAddr{$image}, $addr)) {
               $loadAddr{$image} = $addr;
            }
         } 
      }

      # Disassemble in the order of sorted load addresses so that 
      # vmcallstackview can do binary search.
      foreach $image (sort {Math::BigInt->bcmp($loadAddr{$a}, $loadAddr{$b})} keys %loadAddr) {
         my $imageFile =
             CallstackCommon::FindImageFileForVMKModule($image, $arch{$image},
                                                        $vmklinuxVersion,
                                                        $buildDir,
                                                        $imageDirDefault,
                                                        \%imageLocations,
                                                        $buildType, $remote,
                                                        $verbose);
         if (($imageFile eq "") || (!-e $imageFile)) {
            print "No imageFile for $image. skipping\n";
            next;
         }
         print "Disassembling $imageFile [loadAddr=$loadAddr{$image}]...\n";
      
         # 
         # XXX: If we have more than one user cartel, a common objdump file 
         # will not work because address space of cartels will be 
         # overlapping.
         #   
         system("$objdump $objDumpOption --adjust-vma=$loadAddr{$image} $imageFile >> $disass_file");
         }
   }
   print "Disassembly done\n";
}

sub main()
{
   &process_args();
   my $symbolTableK = "$dumpDir/symbolTable.k";

   #create dump directory, if necessary
   if (-d $dumpDir) {
      print "Writing to existing directory $dumpDir\n";
   } else {
      mkdir($dumpDir) || die "Failed to mkdir($dumpDir): $!\n";
      print "Writing to new directory $dumpDir\n";
   }


   # execute vmkstatsDumper if required
   if (!$remote) {
      my $line;
      my $vmkernelStartAddr = 0;
      my $vmkernelImageFile;
      my $vmkStatsDumper = "/usr/lib/vmware/vmkstats/bin/vmkstatsdumper";
      if ((! -e $vmkStatsDumper) && defined($buildDir)) {
         $vmkStatsDumper = "$buildDir/apps/vmkstatsdumper/vmkstatsdumper";
      }
      if (! -e $vmkStatsDumper) {
         die"Cannot find $vmkStatsDumper\n";
         exit 1;
      }

      # suspend sampling while dumping data
      print "Pausing stats sampling while we gather data...\n";
      system("$vmkStatsDumper -e");
      if ( $? != 0 ) {
         print "\nError executing $vmkStatsDumper -e to pause vmkstats.\n";
         print "If it was a permissions violation on /dev/vmkcall, try\n";
         print "running this script as root.  See PR 203590.\n";
         exit(1);
      }

      # drain samples from per-pcpu buffers
      system("$vmkStatsDumper -d");
      if ( $? != 0 ) {
         print "Error executing $vmkStatsDumper -d to retrieve data\n";
         exit(1);
      }
      sleep(1);

      # Before we dump all vmkstatsdumper output, we get vmkernel start address
      # from the binary to handle ASLR.
      # To handle errors, we initialized vmkernelStartAddr to 0. 
      # vmkstatsdumper disregards a value of zero and uses ASLR'd load address.
      $vmkernelImageFile =
          CallstackCommon::FindImageFileForVMKModule("vmkernel", "x86_64", "KLNext",
                                                     $buildDir, 
                                                     $imageDirDefault,
                                                     \%imageLocations,
                                                     $buildType,
                                                     $remote, $verbose);

      $vmkernelStartAddr =
          CallstackCommon::GetImageStaticLoadAddr($vmkernelImageFile, $objdump);

      # dump status, callStacks and images
      my $vmkStatsDumperOptions = "-a -o $dumpDir -c $collector";
      if (!$retainASLR) {
         $vmkStatsDumperOptions = $vmkStatsDumperOptions." -k $vmkernelStartAddr";
      }
      if (-e $symbolTableK) {
         # Delete just in case vmkstatsdumper errors so it will be easily recognizable
         unlink($symbolTableK) or die "Could not unlink $symbolTableK: $!";
      }
      print "Executing $vmkStatsDumper $vmkStatsDumperOptions\n";
      system("$vmkStatsDumper  $vmkStatsDumperOptions");
      if ( $? != 0 ) {
         print "Error executing $vmkStatsDumper $vmkStatsDumperOptions to retreive data\n";
         exit(1);
      }
   }

   # vmkstatsdumper echos the build type from vsish node
   # /system/modules/vmkernel/general.  To check the build type, need
   # to allow the usual silly "DEBUG equals obj" logic.  Making check
   # case-insensitive just works for other build types.

   if (defined $buildType) {
   	my $altBuildType = $buildType;
   	if ($buildType eq "obj") {
       		$altBuildType = "debug";
   	}

   	my $build = `cat $dumpDir/images | grep Build-Version`;
   	if ($build !~ /$buildType/i && $build !~ /$altBuildType/i) {
      		die ("Specified build type $buildType doesn't match observed type of $build\n");
   	}
   }

   # dump symbols for each loaded module
   my @tags;
   if (defined $symbolTableDir) {
      system("cp $symbolTableDir/symbolTable* $dumpDir");
   } else {

      # parse tags from the image file
      my $tagid;
      my $output = `cat $dumpDir/images | grep -i tags`;
      if ($output =~ /Tags-(.*)\s+/) {
         @tags = split(/:/, $1);
         print "Tags: @tags\n";
      } else {
         die "Could not parse tags from image file";
      } 
      # Do not create symbolTable.k, it is already created by vmkstatsdumper
      if (!$remote && ! -e $symbolTableK) {
         @tags = grep {$_ ne 'k'} @tags;
      }

      print "Extracting symbol information from loaded modules...\n";
      foreach  $tagid (@tags) {
         my $findIDT = 0;
         my $symbol_table_file = "$dumpDir/symbolTable.$tagid";
         my @imageVec =
             CallstackCommon::ParseVMKImageFile("$dumpDir/images",
                                                $buildDir, 
                                                $imageDirDefault,
                                                \%imageLocations,
                                                $buildType, $remote,
                                                $verbose, $tagid);

         if ($tagid eq "k") {
            $findIDT = 1;
         }
         CallstackCommon::CreateVMKSymtab($longFunctionNames,
                                          $symbol_table_file, \@imageVec,
                                          $objdump, $buildDir,
													  	$imageDirDefault,
                                          $buildType, $remote,
                                          $verbose, $findIDT);
   
         if ($verbose) {
             print "Done creating symbol table file $symbol_table_file\n";
         }
      }
   }

   # dump paths
   my $viewer_script_file= "$dumpDir/viewCallstack";
   CallstackCommon::CreateViewerScript($viewer_script_file, "@tags");

   # dump objdump for disassembly view
   if (defined($options{disassemble})) {
      dumpDisassemblyFile($dumpDir);
   }

   print "Results archived into directory $dumpDir\n";
   print "Run ./viewCallstack from there to view results\n";
}

main();
