Enumerate tokenGroups using Perl

How to use Perl to read the tokenGroups attribute, which contains a list of SID's of all the groups that a user belongs to throughout the Active Directory forest.

This script uses the same search code (shown in the previous post) to find a user by their AD username. Once found, it reads the user's tokenGroups attribute, which is a binary list of SIDs, and converts those SIDs into group names.  To see the PowerShell version of this script, see: List Forest-wide Active Directory Group Memberships using PowerShell.

# tokenGroups enumerator
# Brian Seltzer - Jan 15 2010

use Win32::OLE;

$user="myusername";

$dse=Win32::OLE->GetObject("LDAP://RootDSE");
$root=$dse->Get("RootDomainNamingContext");
$adpath="GC://$root";
$base="<".$adpath.">";
$connection = Win32::OLE->new("ADODB.Connection");
$connection->{Provider} = "ADsDSOObject";
$connection->Open("ADSI Provider");
$command=Win32::OLE->new("ADODB.Command");
$command->{ActiveConnection}=$connection;
$command->{Properties}->{'Page Size'}=1000;
$rs = Win32::OLE->new("ADODB.RecordSet");

$command->{CommandText}="$base;(&(objectCategory=User)((cn=$user)(samaccountname=$user)));distinguishedName;subtree";

$rs=$command->Execute;
until ($rs->EOF){
 $dn=$rs->Fields(0)->{Value};
 $rs->MoveNext;
}

$obj=Win32::OLE->GetObject("LDAP://$dn");
@proplist=("tokengroups");
$obj->GetInfoEx(\@proplist,0);
$tokens=$obj->Get("tokenGroups");
foreach $token (@{$tokens}){
 @sidArray=unpack("C*",$token);
 $sid="";
 for ($i=0;$i<=27;$i++){
  $sid=$sid.sprintf ("%02x",$sidArray[$i]);
 }
 $sid =~ tr /a-z/A-Z/;
 if($obj=Win32::OLE->GetObject("LDAP://<SID=$sid>")){
  @proplist=("canonicalName");
  $obj->GetInfoEx(\@proplist,0);
  $can=$obj->Get("canonicalName");
  @nameparts=split /\//,$can;
  ($domain,$junk)=split /\./,uc($nameparts[0]);
  $cn=uc($nameparts[$#nameparts]);
  $groups{$cn}="$domain\\$cn";
  $x++;
 }
}

foreach $group (sort keys %groups){
 print "$groups{$group}\n";
}

print "\n$x Groups\n";