windows-server-2003/tools/postbuildscripts/raiseall.pl

#!perl -w
package raiseall;

use strict;
use Win32::File qw(GetAttributes SetAttributes);
use File::Basename qw(basename);
use Carp;

use lib $ENV{ "RazzleToolPath" };
use lib $ENV{ "RazzleToolPath" }. "\\PostBuildScripts";
use PbuildEnv;
use ParseArgs;
use Logmsg;
use cksku;
use cklang;
use BuildName;
use GetIniSetting;

# Set the script name for logging
$ENV{ "SCRIPT_NAME" } = "raiseall.pl";

# Platform = Architecutre + Debug_Type (e.g. x86fre)
my( $Language, $Build_Number, $Architecture, $Debug_Type, $Time_Stamp,
    $Platform, $Quality, $Op, $fOverride_Safe, $fSafe, $fReplaceAtNumberedLink );

my @ConglomeratorSkus = ('symbolcd', 'ddk', 'hal', 'ifs', 'pdk', 'mantis', 'opk', 'mui', 'wsrm');

my %Ordered_Qualities = ( pre => 1,
                          bvt => 2,
                          tst => 3,
                          sav => 4,
                          idw => 5,
                          ids => 6,
                          idc => 7 );

#########################################################################
#                                                                       #
# Server/Client split sku associations                                  #
#                                                                       #
my @ServerSkus = ( 'ads', 'bin', 'bla', 'dtc', 'sbs', 'srv', 'sym', 'resources', @ConglomeratorSkus );
my @ClientSkus = ( 'bin', 'sym', 'winpe', 'upgadv', 'resources', @ConglomeratorSkus );
#my @ClientSkus = ( 'bin', 'per', 'pro', 'sym', 'winpe', 'upgadv', 'resources', @ConglomeratorSkus );
#                                                                       #
#                                                                       #
#########################################################################

sub globex($);

sub Main {
   
   my $local_release_path = GetReleasePath();
  
   if ( !defined $local_release_path ) {
      errmsg( "Unable to determine release path on current machine, exiting." );
      return;
   }
                        
   # Search for builds availabe to release
   my $build_criteria = "$local_release_path\\$Language\\$Build_Number.$Platform.$ENV{_BuildBranch}.$Time_Stamp";
   my @available_builds = grep { $_ if ( -d $_ ) } globex $build_criteria;

   #
   # Check for conglomerator skus
   #
   #push @available_builds, grep { $_ if ( -d $_ ) } globex "$local_release_path\\$Language\\$Build_Number.$ENV{_BuildBranch}.$Time_Stamp";
   push @available_builds, grep { $_ if ( -d $_ ) } globex "$local_release_path\\$Language\\$Build_Number.$ENV{_BuildBranch}";

   #
   # Check for language neutral skus
   #
   push @available_builds, grep { $_ if ( -d $_ ) } globex "$local_release_path\\misc\\$Build_Number.$ENV{_BuildBranch}";

   dbgmsg( "Available builds: " );
   dbgmsg( $_ ) foreach @available_builds;

   if ( !@available_builds ) {
      if ( $! != 2 ) {
         errmsg("Error querying for builds matching $build_criteria ($!)");
      }
      else {
         errmsg("No builds found matching $build_criteria");
      }
      return;
   }

   if ( $Op eq 'raise' ) {
      return RaiseAll( $local_release_path, \@available_builds );
   }
   elsif ( $Op eq "lower" ) {
      return LowerAll( $local_release_path, \@available_builds );
   }                                                         
   else {
      errmsg( "Internal error -- operation = \"$Op\"" );
      return;
   }
}

sub RaiseAll {
   my $local_release_path = shift;
   my $all_available_builds = shift;

   # Build number is required
   if ( $Build_Number eq '*' ) {
      errmsg( "Must specify build number." );
      return;;
   }
   # Quality is required
   if ( !defined $Quality ) {
      errmsg( "Must specify a quality." );
      return;
   }

   # For raiseall operations we only want to deal with the
   # newest build of a set of builds with the same build number
   my @available_builds;
   my ($cur_build_no_ts, $last_build_no_ts) = ('foo', 'foo');
   my @sorted_all_available_builds = sort @$all_available_builds;
   for ( my $i = $#sorted_all_available_builds; $i >= 0; $i-- ) {
      # Standard builds
      if ( $sorted_all_available_builds[$i] =~ /(\d+\.[^\.]+\.[^\.]+)\.\d+-\d+$/ ) {
         $cur_build_no_ts = $1;
      }
      # Conglomerator builds (no time-stamp currently)
      elsif ( $sorted_all_available_builds[$i] =~ /([^\\]+)\\(\d+\.[^\.]+)(?:\.\d+-\d+)?$/ ) {
         $cur_build_no_ts = "$1\\$2";
      }
      else {
         errmsg( "Unrecognized build format: $sorted_all_available_builds[$i]" );
         return;
      }

      if ( $cur_build_no_ts ne $last_build_no_ts ) {
         push @available_builds, $sorted_all_available_builds[$i];
         $last_build_no_ts = $cur_build_no_ts;
      }
      else {
         dbgmsg( "Skipping older build: ". basename($sorted_all_available_builds[$i]) );
      }
   }
   
   # Check available builds for outstanding release
   # errors; if there are none, set the *.qly file
   # to the appropriate value
   my $build;
   my $srvrel_errors = 0;
   foreach $build ( @available_builds ) {
		my $sBldName = basename($build);		
      if ( -e "$ENV{temp}\\$sBldName\\SrvRelFailed.txt" ) {
         errmsg( "SrvRel failures on ". $sBldName );
         errmsg( "Please fix errors and remove $ENV{temp}\\$sBldName\\SrvRelFailed.txt" );
         $srvrel_errors++;
      }
      # Update the QLY file if this is not a conglomerator build
      elsif ( IsOSBuild( $build ) &&
              !ModifyQlyFile( basename($build), $Quality, "$build\\build_logs" ) ) {
         errmsg( "Failed updating the QLY file for ". basename($build). ", exiting." );
         return;
      }
   }
   if ( $srvrel_errors ) {
      errmsg( "Aborting due to $srvrel_errors SrvRel failure". ($srvrel_errors > 1?"s.":".") );
      return;
   }

   #
   # Setup parameters needed in ForEachBuild functions
   #
   my @accessed_shares = ();
   my %named_parameters = (
      ComputerName          => $ENV{COMPUTERNAME},
      AccessedShares        => \@accessed_shares,
      Quality               => $Quality,
      Language              => $Language,
      OverrideSafe          => $fOverride_Safe
      );

   #
   # Setup the local shares on the release servers
   #
   logmsg( "Creating release shares..." );
   if ( !ForEachBuild( \&CreateSecuredBuildShare,
                       \%named_parameters,
                       $Language,
                       \@available_builds,
                       $fSafe ) ) {
         errmsg( "Failed to create shares, exiting." );
         return;
   }
   # Print out shares created / checked if in debug mode
   dbgmsg( "$_ share created/verified." ) foreach @accessed_shares;

   #
   # Do the DFS work
   #
   my ( $dfs_map, $dfs_lock ) = GetDfsAccess();
   return if ( !defined $dfs_map );

   # Next few functions need DFS access
   $named_parameters{ DfsMap } = $dfs_map;
   
   logmsg( "Checking numbered shares for older timestamps..." );
   if ( !ForEachBuild( \&UnmapInconsistentNumberedLinks,
                       \%named_parameters,
                       $Language,
                       \@available_builds,
                       $fSafe ) ) {
      errmsg( "Problem occurred checking numbered shares" );
      $dfs_lock->Unlock();
      return;
   }
   logmsg( "Finding/lowering any old DFS links at same quality..." );
   if ( !ForEachBuild( \&RemoveOldLatestDotQlyDfsLinks,
                       \%named_parameters,
                       $Language,
                       \@available_builds,
                       $fSafe ) ) {
      errmsg( "Problem verifying/lowering latest.$Quality and associated DFS links" );
      $dfs_lock->Unlock();
      return;
   }
   logmsg( "Creating/verifying DFS links..." );
   if ( !ForEachBuild( \&CreateDfsMappings,
                       \%named_parameters,
                       $Language,
                       \@available_builds,
                       $fSafe ) ) {
      errmsg( "Problem creating/verifying DFS links." );
      $dfs_lock->Unlock();
      return;
   }
   
   #
   # Do symbol server ops
   #

   # Override standard SKUs with our own
   @{$named_parameters{ DefinedSkus }} = ('sym');

   # Only want 'sym' on OS builds, not conglomerator builds
   my @os_builds = grep { $_ if IsOSBuild($_) } @available_builds;
   
   logmsg( "Checking symbol server state..." );
   if ( !ForEachBuild( \&CreateSymbolServerLink,
                       \%named_parameters,
                       $Language,
                       \@os_builds,
                       $fSafe ) ) {
      errmsg( "Problem updating/verifying symbols server DFS links." );
      $dfs_lock->Unlock();
      return;
   }

   logmsg( "Flushing outstanding DFS operations..." );
   if ( !(tied %$dfs_map)->Flush() ) {
      errmsg( "Problem processing DFS commands." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      dfs_lock->Unlock();
      return;
   }

   #
   # Release the inter-machine lock
   #
   $dfs_lock->Unlock();

   # Done if we are not touching latest.*
   return 1 if ( $fSafe );

   #
   # If we are raising to BVT quality, check INI
   # file to determine if we should run BVT tests
   #
   # TODO: a release server may have more than one architecture
   #       and may have just a fre or chk version, so this call
   #       probably needs to be put in its own function and
   #       used with ForEachBuild(), specifying many more
   #       parameters than just -l and -p
   #
   if ( lc $Quality eq "bvt") {
      my $run_boot_test = &GetIniSetting::GetSettingQuietEx( $ENV{ "_BuildBranch" }, $Language, "RunBVT" );
   
      if (defined $run_boot_test &&
          lc $run_boot_test eq "true") {
           
         logmsg( "Starting BVT tests..." );
         # run tests - spit out warning if there are problems
         if ( !ExecuteProgram::ExecuteProgram("perl $ENV{RazzleToolPath}\\postbuildscripts\\assignbvt.pl -l:$Language -p:". ($Architecture eq '*'?"":$Architecture)) ) {
            wrnmsg( "Problem accessing bvt machine (error returned from assignbvt.pl)." );
            wrnmsg( " ". ExecuteProgram::GetLastCommand() );
            wrnmsg( "  $_" ) foreach ExecuteProgram::GetLastOutput();
         }
      }
   }
   
   return 1;
}

sub LowerAll {
   my $local_release_path = shift;
   my $all_available_builds = shift;

   my @available_builds = sort @$all_available_builds;

   # Build number is normally required
   if ( $Build_Number eq '*' ) {
      if ( defined $fOverride_Safe ) {
         wrnmsg( "Forcibly lowering all builds on machine." );
      }
      else {
         errmsg( "Must specify build number." );
         return;;
      }
   }
   
   # Setting quality is pointless -- let the user know
   wrnmsg( "Quality flag '$Quality' ignored for lower operation." ) if ( defined $Quality );

   # Setting 'safe' is also pointless
   wrnmsg( "-safe ignored for lowerall operation." ) if ( defined $fSafe );

   # remove the *.qly file for all OS (not conglomerator) builds
   logmsg( "Removing the *.qly file..." );
   my $build;
   foreach $build ( @available_builds ) {
      if ( IsOSBuild( $build ) &&
           !DeleteQlyFile( "$build\\build_logs" ) ) {
         wrnmsg( "Failed removing the QLY file from ". basename($build) );
         return;
      }
   }
   
   #
   # Setup parameters needed in ForEachBuild functions
   #
   my @accessed_shares = ();
   my %named_parameters = (
      ComputerName          => $ENV{COMPUTERNAME},
      AccessedShares        => \@accessed_shares,
      Language              => $Language,
      OverrideSafe          => $fOverride_Safe
      );

   #
   # Lower the local shares on the release servers
   #
   logmsg( "Lowering release shares..." );
   if ( !ForEachBuild( \&LowerBuildShare,
                       \%named_parameters,
                       $Language,
                       \@available_builds,
                       $fSafe ) ) {
         errmsg( "Failed to remove shares, exiting." );
         return;
   }
   # Print out shares deleted / checked if in debug mode
   dbgmsg( "$_ share removed/verified." ) foreach @accessed_shares;

   #
   # Do the DFS work
   #
   my ( $dfs_map, $dfs_lock ) = GetDfsAccess();
   return if ( !defined $dfs_map );
   
   # Need DFS access in the next few functions
   $named_parameters{ DfsMap } = $dfs_map;
   
   logmsg( "Removing appropriate DFS links..." );
   if ( !ForEachBuild( \&RemoveDfsMappings,
                       \%named_parameters,
                       $Language,
                       \@available_builds,
                       $fSafe ) ) {
      errmsg( "Problem verifying/removing DFS links" );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      $dfs_lock->Unlock();
      return;
   }

   



   
   #
   # Do symbol server ops
   #
   # Note: this is explicitly the last step taken as
   #       we special-case the symbol server "sku" to
   #       only remove the link if it is the last one
   #       remaining.  This is done so that the
   #       symbol link is torn down only when all
   #       instances of the correspondig build have
   #       been lowered.
   #

   # Override standard SKUs with our own
   @{$named_parameters{ DefinedSkus }} = ('sym');

   # Only want 'sym' on OS builds, not conglomerator builds
   my @os_builds = grep { $_ if IsOSBuild( $_ ) } @available_builds;

   logmsg( "Checking symbol server state..." );
   if ( !ForEachBuild( \&RemoveSymbolServerLink,
                       \%named_parameters,
                       $Language,
                       \@os_builds,
                       $fSafe ) ) {
      errmsg( "Problem removing symbols server DFS links." );
      $dfs_lock->Unlock();
      return;
   }

   logmsg( "Flushing outstanding DFS operations..." );
   if ( !(tied %$dfs_map)->Flush() ) {
      errmsg( "Problem processing DFS commands." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      dfs_lock->Unlock();
      return;
   }

   #
   # Release the inter-machine lock
   #
   $dfs_lock->Unlock();

   return 1;
}

sub GetDfsAccess {
   my $dfs_root = &GetIniSetting::GetSettingQuietEx( $ENV{ "_BuildBranch" }, $Language, "DFSRootName" );
   if ( !defined $dfs_root ) {
      errmsg( "Unable to find 'DFSRootName' in INI file for $ENV{_BuildBranch}." );
      return;
   }
   dbgmsg( "Using DFS root $dfs_root" );
   
   my $lock_location = &GetIniSetting::GetSettingQuietEx( $ENV{ "_BuildBranch" }, $Language, "DFSSemaphore" );
   if ( !$lock_location ) {
      errmsg( "Unable to find DFSSemaphore value in INI file." );
      return;
   }
   # Still using a DFS hash that only gets updated on first
   # retrieval -- therefore we need to do our best to have
   # only one machine at a time updating the DFS.  To that
   # extent we have setup a lock mechanism on a globally
   # accessible share (with 1 minute MAXIMUM intervals
   # between checks - 60000 ms = 1 min)
   my $synchronize_lock = new MultiMachineLock ($lock_location, 60000);
   if ( !defined $synchronize_lock ) {
      errmsg( "Problem acquiring lock using $lock_location" );
      return;
   }
   else {
      logmsg( "Acquiring lock for exclusive DFS access..." );
      while ( !$synchronize_lock->Lock() ) {
         # If we timed out, wait some more
         if ( 2 == $synchronize_lock->GetLastError() ) {
            # Last error message should contain the machine we are waiting on
            timemsg( $_ ) foreach ( split /\n/, $synchronize_lock->GetLastErrorMessage() );
         }
         else {
            errmsg ("Failed to acquire lock.");
            errmsg( $_ ) foreach ( split /\n/, $synchronize_lock->GetLastErrorMessage() );
            return;
         }
      }
   }
   
   # access DFS through a tied hash
   logmsg( "Accessing DFS information..." );
   my %dfs_map;
   if ( ! tie %dfs_map, 'StaticDfsMap', $dfs_root ) {
      errmsg( "Error accessing DFS." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      $synchronize_lock->Unlock();
      return;
   }

   return (\%dfs_map, $synchronize_lock);
}

sub IsOSBuild {
   my $build_name = shift;

   return scalar($build_name =~ /\d+\.[^\.]+\.[^\.]+\.\d+-\d+$/)?1:0;
}

sub AllowQualityTransition {
   my $last_quality = shift;
   my $cur_quality  = shift;

   if ( !exists $Ordered_Qualities{lc $last_quality} ||
        !exists $Ordered_Qualities{lc $cur_quality} ) {
      return;
   }
   # Allow transition to sav from any previous quality
   elsif ( lc $cur_quality eq 'sav' ) {
      return 1;
   }
   # Allow transition from pre/bvt to anything else
   elsif ( lc $last_quality eq 'pre' ||
           lc $last_quality eq 'bvt'  ) {
      return 1;
   }
   # Don't allow transition from anything else to pre/bvt
   elsif ( lc $cur_quality eq 'pre' ||
           lc $cur_quality eq 'bvt' ) {
      return;
   }
   # Otherwise allow transitions based on order specified in %Ordered_Qualities
   elsif ( $Ordered_Qualities{lc $cur_quality} >= $Ordered_Qualities{lc $last_quality} ) {
      return 1;
   }
   else {
      return;
   }
}

sub CreateSymbolServerLink {
   my $named_parameters = shift;
   
   my ( $dfs_access,      $build_number,
        $full_build_path, $branch,   $platform,   $quality,   $language,
        $build_name ) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),        q(BuildNumber),
        q(FullBuildPath), q(Branch), q(Platform), q(Quality), q(Language),
        q(BuildName) );
   return if ( !defined $dfs_access );

   # Get current symbol server share
   my ( $current_symsrv_share, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $current_symsrv_share ) {
      dbgmsg( "No symbol server share defined for $branch -- skipping" );
      return 1;
   }
   
   # Default writeable share is just the $'d version of the non-writeable one
   my $current_writeable_symsrv_path = $current_symsrv_share;
   $current_writeable_symsrv_path =~ s/(.)$/$1\$/;
   
   # attach the subpath (if there is one)
   $current_writeable_symsrv_path .= "\\$sub_path" if ( $sub_path );

   # Default build_logs directory is a sibling to default symbols share
   my $current_symsrv_build_logs = $current_writeable_symsrv_path;
   $current_symsrv_build_logs =~ s/[^\\]+$/build_logs/;

   logmsg( "Verifying symbol server has updated shares for $platform..." );

   # Verify that the symbol server has the current build
   if ( ! -e $current_writeable_symsrv_path ) {
      wrnmsg( "Cannot see $current_writeable_symsrv_path ($!)." );
      return 1;
   }

   # Try to make the build_logs directory if it doesn't already exist;
   if ( ! -e $current_symsrv_build_logs &&
        ! ( mkdir $current_symsrv_build_logs, 0777 ) ) {
       errmsg( "Failed to create $current_symsrv_build_logs ($!)." );
       return;
   }

   # For some reason we maintain a QLY file in two locations
   if ( !ModifyQlyFile( $build_name, $quality, $current_writeable_symsrv_path ) ) {
      wrnmsg ( "Problem verifying/creating $quality.qly file on $current_writeable_symsrv_path." );
      #return;
   }
   if ( !ModifyQlyFile( $build_name, $quality, $current_symsrv_build_logs ) ) {
      wrnmsg ( "Problem verifying/creating $quality.qly file on $current_symsrv_build_logs." );
      #return;
   }

   # Done if going to SAV quality
   return 1 if ( lc $quality eq 'sav' );

   #
   # DFS work
   #
   
   # Check if we need to lower any latest.* shares for this build
   if ( !RemoveOldLatestDotQlyDfsLinks( $named_parameters ) ) {
      errmsg( "Problem verifying/lowering latest symbol server shares for $platform." );
      return;
   }

   # Remove any older numbered shares (older in timestamp)
   if ( !UnmapInconsistentNumberedLinks ( $named_parameters ) ) {
      errmsg( "Problem occurred checking numbered shares" );
      return;
   }
   
   # Now create the DFS link if necessary
   if ( !CreateDfsMappings( $named_parameters ) ) {
      errmsg( "Problem verifying/creating symbol server DFS links for $platform." );
      return;
   }
   
   return 1;
}

sub RemoveSymbolServerLink {
   my $named_parameters = shift;
   
   my ( $dfs_access, $platform,   $branch,
        $build_number,  $build_name ) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(Platform), q(Branch),
        q(BuildNumber), q(BuildName) );
   return if ( !defined $dfs_access );

   # Get current symbol server share
   my ( $current_symsrv_share, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $current_symsrv_share ) {
      dbgmsg( "No symbol server share defined for $branch -- skipping." );
      return 1;
   }
   
   # Default writeable share is just the $'d version of the non-writeable one
   my $current_writeable_symsrv_path = $current_symsrv_share;
   $current_writeable_symsrv_path =~ s/(.)$/$1\$/;
   
   # attach the subpath (if there is one)
   $current_writeable_symsrv_path .= "\\$sub_path" if ( $sub_path );

   # Default build_logs directory is a sibling to default symbols share
   my $current_symsrv_build_logs = $current_writeable_symsrv_path;
   $current_symsrv_build_logs =~ s/[^\\]+$/build_logs/;
   
   # Now attach subpath (if any) to standard symbol share
   $current_symsrv_share .= "\\$sub_path" if ( $sub_path );
   
   # Need all prior DFS actions to have completed
   if ( !(tied %$dfs_access)->Flush() ) {
      errmsg( "Problem processing DFS commands." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      return;
   }

   # We only remove the symbol link when it is the last
   # link left -- we will assume if it is the last
   # link under the numbered share that it is the last
   # relevant link under the latest.* shares as well
   $named_parameters->{ BuildID } = $build_number;
   if ( !IsLastLinkUnderParent( $named_parameters ) ) {
      dbgmsg( "$build_name: leaving symbol links untouched" );
      return 1;
   }
  
   logmsg( "Verifying symbol server links have been removed for $platform..." );

   #
   # NOTE: for now we will disable the removal of the .qly flag from the symbols shares.  That way, if
   #       a build was raised to IDx quality then its symbols will stay at IDx quality even after its
   #       release shares are lowered.  Symbols at IDx quality are not removed by deletebuild.cmd
   #
   # Remove the QLY files
   #
   # For some reason we maintain a QLY file in two locations
   #dbgmsg ( "Deleting QLY file from $current_writeable_symsrv_path" );
   #if ( !DeleteQlyFile( $current_writeable_symsrv_path ) ) {
   #   errmsg ( "Problem reading/removing QLY file from $current_writeable_symsrv_path." );
   #   return;
   #}
   #dbgmsg( "Deleting QLY file from $current_symsrv_build_logs" );
   #if ( !DeleteQlyFile( $current_symsrv_build_logs ) ) {
   #   errmsg ( "Problem reading/removing QLY file from $current_symsrv_build_logs." );
   #   return;
   #}

   #
   # Now remove the DFS link
   #
   if ( !RemoveDfsMappings( $named_parameters ) ) {
      errmsg( "Problem verifying/removing symbol server DFS links for $platform." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      return;
   }

   return 1;
}

sub CreateDfsMappings {
   my $named_parameters = shift;
   
   my ($dfs_access, $computer_name,  $quality,   $build_number,  $language,
       $platform,   $time_stamp,     $branch,    $sku,   $fsafe, $fconglomerator_build,
       $flang_neutral_build ) =
   GetNamedParameters( $named_parameters,
       q(DfsMap),   q(ComputerName), q(Quality), q(BuildNumber), q(Language),
       q(Platform), q(TimeStamp),    q(Branch),  q(Sku), q(SafeFlag), q(IsConglomeratorBuild),
       q(IsLangNeutralBuild) );

   return if ( !defined $dfs_access );
   
   # Done if going to SAV quality
   return 1 if ( lc $quality eq 'sav' );

   # Done if we are at a different and LOWER quality than other builds
   # in our numbered links (e.g. if our build number has been
   # raised to TST and we are just being raised to BVT, we don't
   # want to put ourselves in the number link yet)
   if ( IsQualityHigherAtNumberedLink( $named_parameters )) {
      wrnmsg( "Not creating DFS links!" );
      return 1;
   }

   # latest.* DFS link
   # only gets created if the current branch is
   # responsible for producing the current SKU
   my $latest_dfs_link;
   $named_parameters->{ BuildID } = "latest.$quality";
   $latest_dfs_link = GetDfsLinkName( $named_parameters );
   
   if ( !defined $latest_dfs_link ) {
      errmsg( "Do not know how to create latest.* DFS links for $branch / $sku." );
      return;
   }

   # Create directory structure for $latest_dfs_link in the DFS replica servers

   if( !$fconglomerator_build && !$flang_neutral_build )
   {
   	return if( !CreateDirsInReplicaServers($named_parameters));
   }

   # build number link
   $named_parameters->{ BuildID } = $build_number;
   my $numerical_dfs_link = GetDfsLinkName( $named_parameters );
   if ( !defined $numerical_dfs_link ) {
      errmsg( "Do not know how to create numbered DFS links for $branch / $sku." );
      return;
   }

   # Create directory structure for $numerical_dfs_link in the DFS replica servers
   if( !$fconglomerator_build && !$flang_neutral_build )
   {
   	return if( !CreateDirsInReplicaServers($named_parameters));
   }
   # \\machine\share[\<subdir>] that makes up local release path
   my ( $machine_share, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $machine_share ) {
      errmsg( "Do not know how to create local shares for $branch / $sku." );
      return;
   }
   # Tack on the subpath to the share if it exists
   $machine_share .= "\\$sub_path" if ( $sub_path );
   
   # Do the DFS mappings
   dbgmsg( "Adding/Verifying: $numerical_dfs_link contains $machine_share" );
   if ( !($dfs_access->{$numerical_dfs_link} = $machine_share) ) {
      errmsg( "Problem mapping to DFS." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      return;
   }
   # if lang=cov
   # map <branch>\usa\<buildNumber>\<archType>.cov to <branch>\cov\<buildNumber>\<archType>
   if( lc $language eq "cov" && !$fconglomerator_build && !$flang_neutral_build )
   {
	dbgmsg( "Adding/Verifying: <archType>.cov links contains $machine_share" );
 	my $altCovLink = $numerical_dfs_link;
	$altCovLink =~ s/cov/usa/i;
        $altCovLink =~ s/$platform/$platform.cov/;
	if ( !($dfs_access->{$altCovLink} = $machine_share) ) {
      	    errmsg( "Problem mapping to DFS." );
            errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      	    return;
	}
   }
   # Link language neutral builds to misc directory as well
   if ( $flang_neutral_build) {
       my $misc_dfs_link = $numerical_dfs_link;
       $misc_dfs_link =~ s/$language/misc/i;
       if ( !($dfs_access->{$misc_dfs_link} = $machine_share) ) {
          errmsg( "Problem mapping to DFS." );
          errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
          return;
       }
   }
   if ( defined $latest_dfs_link &&
        !$fsafe ) {
      dbgmsg( "Adding/Verifying: $latest_dfs_link contains $machine_share" );
      if ( !($dfs_access->{$latest_dfs_link} = $machine_share) ) {
         errmsg( "Problem mapping to DFS." );
         errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
         return;
      }
   }

   # Time for some special magic on the DFS servers:
   # hide/unhide directories and create *.BLD/*.SRV files.
   # Skip this step for conglomerator& neutral builds
   if ( !$fconglomerator_build && !$flang_neutral_build &&
        !MagicDFSSettings( $named_parameters ) ) {
      wrnmsg( "Problem verifying/writing to DFS server machines." );
   }

   return 1;
}
sub CreateDirsInReplicaServers
{
    my $named_parameters = shift;
    foreach ( GetBldFileDfsPathNames( $named_parameters ) ) 
    {
	if( !(-e $_ ))
	{
	    if( !ExecuteProgram::ExecuteProgram( "md $_" ) )
	    {
		errmsg( " ". ExecuteProgram::GetLastCommand() );
     		errmsg( "  $_" ) foreach ExecuteProgram::GetLastOutput();
		return 0;
	    }
	}
    }
    return 1;
}
sub IsQualityHigherAtNumberedLink {
   my $named_parameters = shift;

   my ( $dfs_access, $quality,   $build_number,  $branch,   $sku ) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(Quality), q(BuildNumber), q(Branch), q(Sku) );
   return if ( !defined $dfs_access );

   # build number link
   $named_parameters->{ BuildID } = $build_number;
   my $numerical_dfs_link = GetDfsLinkName( $named_parameters );
   # Don't know if quality is higher at numbered
   # link, if we don't know how to make the link
   return 0 if ( !defined $numerical_dfs_link );

   # If there are no builds, then we are OK
   return 0 if ( !exists $dfs_access->{$numerical_dfs_link} );

   my @current_builds = @{$dfs_access->{$numerical_dfs_link}};

   # Otherwise attempt to find a latest.* link for one of the shares
   foreach my $share_to_check ( @current_builds ) {
      my @links_to_share = @{ $dfs_access->{$share_to_check} };
      next if ( !@links_to_share );

      foreach my $link ( @links_to_share ) {
         my $build_id = GetBuildIdFromDfsLink( $named_parameters, $link );
 
         # Determine if this is a latest.* link
         if ( defined $build_id &&
              $build_id =~ /^latest\.(.*)$/ ) {
            
            # Compare quality with our current quality
            if ( lc $1 ne lc $quality &&
                 !AllowQualityTransition( $1, $quality ) ) {
               wrnmsg( "Other builds linked to $build_number are at $1 quality:" );
               wrnmsg( "($share_to_check)." );
               return 1;
            }
         }
      }
   }
      
   # Did not find a latest.* higher than our current quality
   return 0;         
}

sub UnmapInconsistentNumberedLinks {
   my $named_parameters = shift;

   my ($dfs_access, $build_number,  $build_time,  $branch,   $sku,
       $quality) =
   GetNamedParameters( $named_parameters,
       q(DfsMap),   q(BuildNumber), q(TimeStamp), q(Branch), q(Sku),
       q(Quality) );

   # Done if going to SAV quality
   return 1 if ( lc $quality eq 'sav' );

   $named_parameters->{ BuildID } = $build_number;
   my $dfs_numbered_link = GetDfsLinkName( $named_parameters );
   if ( !defined $dfs_numbered_link ) {
      errmsg( "Do not know how to create DFS links for $branch / $sku." );
      return;
   }
   my @current_builds_linked_at_number;
   @current_builds_linked_at_number = @{$dfs_access->{$dfs_numbered_link}} if ( exists $dfs_access->{$dfs_numbered_link} );

   my $ffound_inconsistency;
   # Check for any shares linked to number that do not match our specifications
   foreach ( @current_builds_linked_at_number ) {
         
      my ($current_share_build_number, $current_share_build_time) =
          GetBuildNumberAndTsFromShare( $named_parameters, $_ );
      if ( !defined $current_share_build_number ) {
         errmsg( "Can't determine build number at $dfs_numbered_link from $current_builds_linked_at_number[0] for $branch / $sku." );
         return;
      }

      # If the build number is not what we expected then something is really wrong
      if ( $build_number != $current_share_build_number ) {
         errmsg( "Share $_ linked at $dfs_numbered_link" );
         return;
      }

      # Check time-stamp
      if ( $build_time lt $current_share_build_time ) {
         if ( $fReplaceAtNumberedLink ) {
            wrnmsg( "Replacing $build_number ($current_share_build_time) which appears newer than $build_number ($build_time)." );
            $ffound_inconsistency = 1;
            last;
         }
         else {
            errmsg( "Won't replace $build_number ($current_share_build_time) with $build_number ($build_time) without use of -replace" );
            return;
         }
      }
      elsif ( $build_time gt $current_share_build_time ) {
         dbgmsg( "Replacing links of older build at $build_number: $build_number ($current_share_build_time)" );
         $ffound_inconsistency = 1;
         last;
      }
   }

   # Unmap the share if an inconsistency was found
   if ( $ffound_inconsistency ) {
      return if ( !RemoveDfsLink( $named_parameters ) );
   }

   return 1;
}

sub RemoveOldLatestDotQlyDfsLinks {
   my $named_parameters = shift;
   
   my ($dfs_access, $computer_name,  $quality,   $build_number, $build_name,
       $build_time, $language,   $platform,       $branch,    $sku,
       $fsafe ) =
   GetNamedParameters( $named_parameters,
       q(DfsMap),   q(ComputerName), q(Quality), q(BuildNumber), q(BuildName),
       q(TimeStamp), q(Language), q(Platform),     q(Branch),  q(Sku),
       q(SafeFlag) );
   return if ( !defined $dfs_access );

   # force release is an option
   my $override_safe = $named_parameters->{ q(OverrideSafe) };

   # Done if going to SAV quality
   return 1 if ( lc $quality eq 'sav' );

   my @build_ids = GetBuildIdsFromCurrentLinks( $named_parameters );

   # Leave latest.<quality> shares alone
   # with the exception of pre and bvt
   # if -safe was specified
   if ( !$fsafe ) {
      $named_parameters->{ BuildID } = "latest.$quality";
      my $latest_dfs_link = GetDfsLinkName( $named_parameters );
      if ( !defined $latest_dfs_link ) {
         errmsg( "Do not know how to create DFS links for $branch / $sku." );
         return;
      }
      my @current_latest_builds;
      @current_latest_builds = @{$dfs_access->{$latest_dfs_link}} if ( exists $dfs_access->{$latest_dfs_link} );

      # Trying to enforce rule that you cannot move from a release quality
      #   latest.* (tst, idw, ids) to a non-release quality (pre, bvt)
      foreach ( @build_ids ) {
         if ( /^latest\.(.+)$/ &&
              !AllowQualityTransition( $1, $quality ) ) {
            if ( !defined $override_safe ) {
               errmsg( "Not allowed to move from '$1' to '$quality' quality." );
               return;
            }
            else {
               wrnmsg( "Forcibly moving from '$1' to '$quality' quality." );
            }
         }
      }
   
      my $fforce_safe_flag;
      my ($current_latest_build_number, $current_latest_build_time) = ('', 0);
      # while we are at we will check for inconsistencies
      my ($last_build_number, $last_build_time);
      my $ffound_inconsistency;
      
      foreach ( @current_latest_builds ) {
         
         ($current_latest_build_number, $current_latest_build_time) =
             GetBuildNumberAndTsFromShare( $named_parameters, $_ );
         if ( !defined $current_latest_build_number ) {
            errmsg( "Can't determine build number at $latest_dfs_link from $current_latest_builds[0] for $branch / $sku." );
            return;
         }
         # Consistency check
         if ( $last_build_number && $last_build_number ne $current_latest_build_number ||
              $last_build_time && $last_build_time ne $current_latest_build_time ) {
            wrnmsg( "Inconsistent links found at $latest_dfs_link:" );
            wrnmsg( "$current_latest_build_number ($current_latest_build_time) and $last_build_number ($last_build_time)" );
            $ffound_inconsistency = 1;
         }

         ($last_build_number, $last_build_time) = ($current_latest_build_number, $current_latest_build_time);
      }

      # If we found an inconsistency, let's nuke the share
      if ( $ffound_inconsistency ) {
          wrnmsg( "Links were found to be inconsisent -- removing share" );
          $current_latest_build_number = 1;
      }   

      # Usually don't want to overwrite newer builds
      if ( $current_latest_build_number &&
           ($current_latest_build_number > $build_number ||
            $current_latest_build_number == $build_number &&
            $current_latest_build_time gt $build_time) )
      {
         if ( !$override_safe ) {
            dbgmsg( "Current build for $platform / $sku at $quality is $current_latest_build_number ($current_latest_build_time), switching to '-safe' mode." );
            $named_parameters->{ForceSafeFlag}{$build_name} = 1;
            $fforce_safe_flag = 1;
         } else {
            wrnmsg( "Forcibly moving latest.$quality from $current_latest_build_number ($current_latest_build_time) to $build_number ($build_time)." );
         }
      }
      
      # Make sure we didn't set -safe flag for user
      if ( !$fforce_safe_flag ) {
         # If current latest.* build exists and does
         #  not have our build number and timestamp, lower it
         if ( $current_latest_build_number &&
              ($current_latest_build_number != $build_number ||
               $current_latest_build_time ne $build_time) ) {
            if ( !$ffound_inconsistency ) {
               dbgmsg( "Lowering $latest_dfs_link because $current_latest_build_number ($current_latest_build_time) != current build $build_number ($build_time)." );
            }
            
            $named_parameters->{ BuildID } = "latest.$quality";
            return if ( !RemoveDfsLink( $named_parameters ) );
         }
         
         # Also need to lower the current numbered share if we are the
         # first entry in our latest.* link, as we don't want other
         # shares that are not up at our quality to be accessible
         # through the same number as ourselves
         if ( !exists $dfs_access->{$latest_dfs_link} ) {
            $named_parameters->{ BuildID } = $build_number;
            return if ( !RemoveDfsLink( $named_parameters ) );
         }
      }
   }
   
   #
   # Special rules for BVT and PRE:
   #
   # If we are currently at latest.bvt or latest.pre
   # and are moving to another quality, 
   # remove latest.<bvt/pre>
   #
   foreach ( @build_ids ) {
      if ( /^latest\.(bvt|pre)$/i &&
           lc $1 ne lc $quality ) {
         $named_parameters->{ BuildID } = "latest.$1";
         return if ( !RemoveDfsLink( $named_parameters ) );
      }
   }

   return 1;
}

# FUTURE:
# This function in most cases would seem to do the same
# as delete <share_name> already implemtened in the tied hash
# Might consider removing this logic...
sub RemoveDfsMappings {
   my $named_parameters = shift;
   
   my ( $dfs_access, $branch,   $language,   $sku,   $build_number,
        $flang_neutral_build, $platform, $fconglomerator_build) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(Branch), q(Language), q(Sku), q(BuildNumber),
        q(IsLangNeutralBuild), q(Platform), q(IsConglomeratorBuild));

   my @build_ids = GetBuildIdsFromCurrentLinks( $named_parameters );
   
   my ( $share_name, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $share_name ) {
      dbgmsg( "No local share definition for $branch / $sku -- skipping." );
      return 1;
   }
   $share_name .= "\\$sub_path" if ( $sub_path );

   my $fsuccess = 1;

   foreach ( @build_ids ) {
      $named_parameters->{BuildID} = $_;

      my $dfs_link = GetDfsLinkName( $named_parameters );
    
      if ( !defined $dfs_link ) {
         errmsg( "Do not know how to create DFS links for $branch / $sku." );
         return;
      }
      $fsuccess &&= (tied %$dfs_access)->RemoveShareFromLink( $dfs_link, $share_name );
	
      # Add to support coverage build
      # Remove <branch>\usa\<archType>.cov links
      if( lc $language eq "cov" &&  !$fconglomerator_build && !$flang_neutral_build ){
        my $altLink = $dfs_link;
	$altLink =~ s/cov/usa/i;
	$altLink =~ s/$platform/$platform.cov/;
        $fsuccess &&= (tied %$dfs_access)->RemoveShareFromLink( $altLink, $share_name );
      }
   
   }

   # If we are a misc link and the only remaining link is
   # the misc DFS link, remove it (we're assuming we must have
   # just tore down the last language still raised for it)
   if ( $flang_neutral_build ) {
       my @links_to_share = @{$dfs_access->{$share_name}} if exists $dfs_access->{$share_name};
       
       $named_parameters->{BuildID} = $build_number;
       my $misc_dfs_link = GetDfsLinkName( $named_parameters );
       if ( !defined $misc_dfs_link ) {
          errmsg( "Do not know how to create DFS links for $branch / $sku." );
          return;
       }

       $misc_dfs_link =~ s/$language/misc/i;
       if ( !@links_to_share ||
            !grep {!/\Q$misc_dfs_link\E/i} @links_to_share ) {
           $fsuccess &&= delete $dfs_access->{$share_name};
       }
   }

   return $fsuccess;
}

sub IsSkuLinkedToLatest {
   my $named_parameters = shift;
   my ( $branch,   $sku ) =
   GetNamedParameters( $named_parameters,
        q(Branch), q(Sku) );
   return if ( !defined $branch );

   if ( IsClientSku( $named_parameters ) && IsClientBranch( $named_parameters ) ||
        IsServerSku( $named_parameters ) && IsServerBranch( $named_parameters ) ) {
      return 1;
   }
   else {
      return 0;
   }

}

sub IsServerSku {
    my $named_parameters = shift;
    my ( $sku ) =
    GetNamedParameters( $named_parameters,
         q(Sku) );
   return if ( !defined $sku );

   return scalar grep { lc$sku eq $_ } @ServerSkus;
}

sub IsClientSku {
    my $named_parameters = shift;
    my ( $sku ) =
    GetNamedParameters( $named_parameters,
         q(Sku) );
   return if ( !defined $sku );

   return scalar grep { lc$sku eq $_ } @ClientSkus;
}

sub IsServerBranch {
    my $named_parameters = shift;
    my ( $branch,   $language ) =
    GetNamedParameters( $named_parameters,
         q(Branch), q(Language) );
   return if ( !defined $branch );

   if ( !exists $named_parameters->{ServerBranches}{$branch} ) {
      $named_parameters->{ServerBranches}{$branch} = (&GetIniSetting::GetSettingQuietEx( $branch, $language, 'DFSLatestServerSkus' )?1:0);
      dbgmsg( "$branch is a server branch." ) if ( $named_parameters->{ServerBranches}{$branch} );
   }

   return $named_parameters->{ServerBranches}{$branch};
}
                   
sub IsClientBranch {
    my $named_parameters = shift;
    my ( $branch,   $language ) =
    GetNamedParameters( $named_parameters,
         q(Branch), q(Language) );
   return if ( !defined $branch );

   if ( !exists $named_parameters->{ClientBranches}{$branch} ) {
      $named_parameters->{ClientBranches}{$branch} = (&GetIniSetting::GetSettingQuietEx( $branch, $language, 'DFSLatestClientSkus' )?1:0);
      dbgmsg( "$branch is a client branch." ) if ( $named_parameters->{ClientBranches}{$branch} );
   }

   return $named_parameters->{ClientBranches}{$branch};
}

sub GetBldFileExtension {
   my $named_parameters = shift;
   my ( $branch ) =
   GetNamedParameters( $named_parameters,
        q(Branch) );
   return if ( !defined $branch );

   # IF this branch is a client branch, or this
   # branch is both client and server, use BLD
   if ( IsClientBranch( $named_parameters ) ) {
      return 'BLD';
   }
   else {
      return 'SRV';
   }
}

sub RemoveDfsLink {
   my $named_parameters = shift;
   my ( $dfs_access, $branch,   $build_id,  $sku ) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(Branch), q(BuildID), q(Sku) );
   return if ! defined ( $build_id );

   if ( IsLastLinkUnderParent( $named_parameters ) ) {
     
      # Delete <build>.BLD / <build>.SRV file
      #
      # If the BLD/SRV file still exists when we unmap the link,
      # there will no longer be a DFS link but the directory
      # structure will remain, making it look like there is
      # still a DFS link

      # If we are the last numbered link, assume we are the
      # last relevant latest.* link as well, and remove
      # BLD/SRV files from latest.* as well (this code was added
      # for the XP client/server split)
      my @build_ids;
      if ( $build_id =~ /^\d+$/ ) {
         @build_ids = GetBuildIdsFromCurrentLinks( $named_parameters );
      }
      else {
         @build_ids = ($build_id);
      }
     
      my $bldfile_ext = GetBldFileExtension( $named_parameters );
      foreach ( @build_ids ) {
         $named_parameters->{BuildID} = $_;
         foreach ( GetBldFileDfsPathNames( $named_parameters ) ) {
            dbgmsg( "Removing $bldfile_ext file from link's parent directory" );
            my @bld_files = grep {$_ if ( ! -d $_ )} globex "$_\\*.$bldfile_ext";

            # 0 = success
            # 2 = couldn't find file (may be a failure or there may be no BLD file;
            #                         have to treat as a success as there is no way
            #                         to tell the difference - $^E doesn't help)
            if ( $! != 0 && $! != 2 ) {
               wrnmsg( "Trying to find existing $bldfile_ext file: $!" );
            }

            # Delete all BLD/SRV files
            foreach ( @bld_files ) {
               if ( !unlink $_ ) { wrnmsg( "Unable to delete $_ ($!)." ) }
            }
         }
      }

      # Make sure we are pointing at the right build_id after all of this
      $named_parameters->{BuildID} = $build_id;
   }
   
   #
   # Now actually remove the DFS link
   #
   my $dfs_link = GetDfsLinkName( $named_parameters );
   if ( !defined $dfs_link ) {
      errmsg( "Do not know how to create DFS links for $branch / $sku." );
      return;
   }
   
   dbgmsg( "Removing/Verifying $dfs_link from DFS." );
   if ( !delete $dfs_access->{$dfs_link} ) {
      errmsg( "Problem lowering $dfs_link from DFS." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      return;
   }

   return 1;
}

sub MagicDFSSettings {
   my $named_parameters = shift;

   my ($dfs_access, $branch,   $build_number,  $build_name,
       $language,   $sku,      $platform,      $quality,
       $fsafe ) =
   GetNamedParameters( $named_parameters,
       q(DfsMap),   q(Branch), q(BuildNumber), q(BuildName),
       q(Language), q(Sku),    q(Platform),    q(Quality),
       q(SafeFlag) );
   return if ( !defined $dfs_access );

   #
   # We need all new DFS links to exist in order to find
   # new paths, so flush any outstanding commands here
   #
   if ( !(tied %$dfs_access)->Flush() ) {
      errmsg( "Problem processing DFS commands." );
      errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
      return;
   }
   
   #
   # Hide / Unhide paths on the DFS machine as we move
   #      between pre/bvt and other qualities
   #
   # NOTE: following original code's precedent and not
   #       hiding the latest.* subdirs
   #
   $named_parameters->{ BuildID } = $build_number;
   foreach ( GetHideableDfsPathNames( $named_parameters ) ) {
      my $attribs = 0; # set to avoid warning / actually first used to get return value
      my $fhidden;
      my $fhide_share;
      if ( !GetAttributes( $_, $attribs ) ) {
         wrnmsg( "Unable to get current hidden/unhidden status of $_ ($^E) -- skipping." );
      }
      
      $fhidden = $attribs & 2;
      $fhide_share = ($quality =~ /^(bvt|pre)$/i);

      # See if we need to switch hidden attribute on/off
      if ( $fhide_share &&
           !$fhidden &&
           !SetAttributes( $_, $attribs | 2 ) ) {
         wrnmsg( "Could not hide $_ ($^E)." );
      }
      elsif ( !$fhide_share &&
              $fhidden &&
              !SetAttributes( $_, $attribs & ~2 ) ) {
         wrnmsg( "Could not unhide $_ ($^E)." );
      }
   }
   
   #
   # Write <build>.BLD / <build>.SRV file
   #
   my @builds_to_touch = ( $build_number );
   if ( !$fsafe ) { push @builds_to_touch, "latest.$quality" }

   my $bldfile_ext = GetBldFileExtension( $named_parameters );
   foreach ( @builds_to_touch ) {
      $named_parameters->{ BuildID } = $_;
       foreach ( GetBldFileDfsPathNames( $named_parameters ) ) {
        my $fbldfile_already_set;
         my @bld_files = grep { $_ if ( ! -d $_ ) } globex "$_\\*.$bldfile_ext";
         # 0 = success
         # 2 = couldn't find file (may be a failure or there may be no BLD file;
         #                         have to treat as a success as there is no way
         #                         to tell the difference - $^E doesn't help)
         if ( $! != 0 && $! != 2 ) {
            wrnmsg( "Trying to find existing $bldfile_ext file: $!" );
         }
         # If there is more than one, delete them all and start anew
         elsif ( @bld_files > 1 &&
              ! unlink @bld_files ) {
            wrnmsg( "Multiple *.$bldfile_ext files found at $_ -- unable to delete ($!)." );
         }
         # If there is just one, see if it matches current criteria
         elsif ( 1 == @bld_files ) {
            if ( $bld_files[0] =~ /\\$build_name.$bldfile_ext$/ ) {
               unless ( open BLDFILE, "$bld_files[0]" ) {
                  wrnmsg( "Unable to read $bld_files[0] ($!)." );
                  next;
               }

               my $cur_bld_quality = <BLDFILE>;
               close BLDFILE;
           
               chomp $cur_bld_quality;
               if ( lc $quality eq lc $cur_bld_quality ) {
                  # Current bld file matches all of our criteria
                  $fbldfile_already_set = 1;
               }
            }

            # If something about the current bld file did not match,
            #    delete it in preparation for creating a new one
            if ( !$fbldfile_already_set &&
                 ! unlink $bld_files[0] ) {
               wrnmsg( "Unable to delete $bld_files[0] ($!)." );
            }
         }

         # Write out new BLD file if necessary
         if ( !$fbldfile_already_set ) {
            unless ( open WRITE_BLDFILE, "> $_\\$build_name.$bldfile_ext" ) {
               errmsg( "Unable to write $_\\$build_name.$bldfile_ext ($!)." );
               return;
            }
   
            print WRITE_BLDFILE "$quality\n";
            close WRITE_BLDFILE
         }
      }
   }

   return 1;
}

sub GetNamedParameters {
   my $named_parameters = shift;
   
   my ( $name, @parameter_list );

   while ( $name = shift ) {
      if ( !exists $named_parameters->{ $name } ) {
         my $called_by = (caller 1)[3];
         errmsg( "Undefined parameter \"$name\" to $called_by." );
         return;
      }

      push @parameter_list, $named_parameters->{ $name };
   }

   return @parameter_list;
}

sub ForEachBuild {
   my $func = shift;
   my $named_parameters = shift;
   my $language = shift;
   my $builds = shift;
   my $fsafe = shift;
   my $build;

   foreach $build ( @$builds ) {
      my ( $build_number, $arch, $debug_type, $branch, $time_stamp );
      my $fconglomerator_build = 0;
      my $flang_neutral_build = 0;

      # Normal build
      if ( IsOSBuild( $build ) ) {
         ( $build_number, $arch, $debug_type, $branch, $time_stamp ) = build_name_parts( $build );
      }
      # Conglomerator skus
      elsif ( $build =~ /([^\\]+)\\(\d+)\.([^\.]+)(?:\.(\d+-\d+))?$/ ) {
         ( $build_number, $arch, $debug_type, $branch, $time_stamp ) = ( $2, '', '', $3, $4 || 0 );
         $flang_neutral_build = (lc$1 eq 'misc')?1:0;
         $fconglomerator_build = 1;
      }

      if ( !defined $build_number ) {
         errmsg( "Unable to determine build information for $build." );
         return;
      }
      
      my $platform = "$arch$debug_type";
       
      # use already defined skus or default to looking them up
      my @skus;
      if ( exists $named_parameters->{ DefinedSkus } ) {
         @skus = @{$named_parameters->{ DefinedSkus }};
      }
      elsif ( $fconglomerator_build ) {
         @skus = GetSkusForConglomeratorBuild( $build );
      }
      else {
         @skus = GetSkusForBuild( $build, $language, $debug_type, $arch );
      }

      if ( !@skus ) {
         wrnmsg( "No skus defined for $build ($language) - skipping." );
         # Skip this build
         next;
      }
     
      # Setup common parameters for functions
      $named_parameters->{ FullBuildPath }   = $build;
      if ( $fconglomerator_build ) {
         ($named_parameters->{ BuildName })  = $build =~ /\\([^\\]+\\[^\\]+)$/;
      }
      else {
         $named_parameters->{ BuildName }  = basename( $build );
      }
      $named_parameters->{ BuildNumber }   = $build_number;
      $named_parameters->{ DebugType }     = $debug_type;
      $named_parameters->{ Branch }        = $branch;
      $named_parameters->{ Platform }      = $platform;
      $named_parameters->{ TimeStamp }     = $time_stamp;
      $named_parameters->{ IsConglomeratorBuild } = $fconglomerator_build;
      $named_parameters->{ IsLangNeutralBuild } = $flang_neutral_build;
      if ( defined $fsafe ||
           $named_parameters->{ForceSafeFlag}{$named_parameters->{ BuildName }}) {
         $named_parameters->{ SafeFlag } = 1;
      }
      else {
         $named_parameters->{ SafeFlag } = 0;
      }

      # Loop through all supported flavors
      my $sku;
      foreach $sku ( @skus ) {
         $named_parameters->{ Sku } = $sku;

         # Client/server split: skip skus
         # that are not associated with branch
         if ( !IsSkuLinkedToLatest( $named_parameters ) ) {
            # Handle absurd pro ia64 sku even during C/S split
            if ( !(lc $arch eq 'ia64' and lc $sku eq 'pro') ) {
                next;
            }
         }

         if ( !&$func( $named_parameters ) ) {
            errmsg( "Problem occurred during processing of $sku." );
            return;
         }
      }
   }

   return 1;
}

sub IsLastLinkUnderParent {
   my $named_parameters = shift;

   my ( $dfs_access, $build_id,  $branch,   $sku ) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(BuildID), q(Branch), q(Sku) );
   return if ( !defined $dfs_access );

   my $dfs_link = GetDfsLinkName( $named_parameters );
   if ( !defined $dfs_link ) {
      errmsg( "Do not know how to create DFS links for $branch / $sku." );
      return;
   }

   my ( $cur_share_name, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $cur_share_name ) {
      errmsg( "Do not know how to create release shares for $branch / $sku." );
      return;
   }
   $cur_share_name .= "\\$sub_path" if ( $sub_path );

   #
   # First check that we are the last entry in the current dfs link
   #
   my @cur_dfs_links;
   @cur_dfs_links = @{ $dfs_access->{$dfs_link} } if ( exists $dfs_access->{$dfs_link} );
   if ( !@cur_dfs_links ||
        @cur_dfs_links != 1 ||
        lc $cur_share_name ne lc $cur_dfs_links[0] ) {
      return;
   }

   #
   # Now check that we are the last link under our parent directory
   #
   # Construct full path to dfs link's parent directory
   my $full_dfs_link = (tied %$dfs_access)->GetDfsRoot(). "\\$dfs_link";
   my ($parent_directory) = $dfs_link =~ /^(.*)\\.*$/;
   $parent_directory = (tied %$dfs_access)->GetDfsRoot(). '\\'. $parent_directory;
   # Loop through all directory entries looking for
   # any subdirectories that do not match our share
   # name
   my @parent_entries = grep { $_ if ( -d $_ ) } globex "$parent_directory\\*";
   foreach ( @parent_entries ) {
      # It is a directory -- if it isn't us assume
      # it refers to another existing link
      # WARNING: Special case the 'test' subdirectory
      #          so we don't count it during
      #          this check (we will clean up if
      #          all that is stopping us is 'test')
      if ( lc $_ ne lc $full_dfs_link &&
           $_ !~ /\\test$/i ) {
         return;
      }
   }

   # We must be the only link under our parent directory
   return 1;
}

sub GetSkusForBuild {
   my $build = shift;
   my $language = shift;
   my $build_type = shift;
   my $architecture = shift;

   my %skus = cksku::GetSkus( $language, build_arch( $build ) );
   my @returned_skus;

   @returned_skus = ( sort keys %skus );

   # WinPE image
   if ( lc $language eq 'usa' &&
        lc $build_type eq 'fre' ) {
      push @returned_skus, 'winpe';
   }

   # UpgAdv image
   if ( lc $architecture eq 'x86' && lc $build_type eq 'fre'
	&& lc $language ne 'psu' && lc $language ne 'mir' && lc $language ne 'fe' ) 
   {
      push @returned_skus, 'upgadv';
   }

   # Another special case for PSU/FE:
   # need to link to 'resources' 
   if ( lc $language ne 'usa' ||
        lc $language ne 'mir') {
      push @returned_skus, 'resources';
   }      

   # Special case 'bin' -- everyone gets one
   push @returned_skus, 'bin';
	
   return @returned_skus;
}

sub GetSkusForConglomeratorBuild {
   my $build = shift;

   my @possible_skus = @ConglomeratorSkus;

   # BensonT: Non US builds do not use symbolcd
   if (lc$Language ne "usa") {
     @possible_skus = grep {lc$_ ne 'symbolcd'} @possible_skus;
   }

   my @skus;
   foreach ( @possible_skus )
   {
      push @skus, $_ if ( -e "$build\\$_" );
   }

   return @skus;
}


#
# Returns:
#  
#   ( share, subpath )
#   An array consisting of the full-share name (\\server\share) and
#   a subpath.  \\server\share\subpath would take you to your
#   expected destination
#
sub GetShareName {
   my $named_parameters = shift;

   my ( $computer_name,  $build_name, $build_number,
        $language,       $platform,   $branch,
        $sku,   $fconglomerator_build, $flang_neutral_build,
        $timestamp ) = 
   GetNamedParameters( $named_parameters,
        q(ComputerName), q(BuildName), q(BuildNumber),
        q(Language),     q(Platform),  q(Branch),
        q(Sku), q(IsConglomeratorBuild),  q(IsLangNeutralBuild),
        q(TimeStamp) );
   return if ( !defined $computer_name );

   my $lcsku = lc $sku;

   # symbol server shares
   if ( $lcsku eq 'sym' ) {
      my $symbol_server_share = &GetIniSetting::GetSettingQuietEx( $branch, $language, 'SymFarm' );
      if ( !$symbol_server_share ) {
         dbgmsg( "No INI file setting for 'SymFarm' in $branch / SymFarm." );
         return;
      }
      return ("$symbol_server_share", "$language\\$build_name\\symbols.pri");
   }

   # special "skus"
   if ( $fconglomerator_build ) {
      return ("\\\\$computer_name\\$build_number.$branch.".($flang_neutral_build?'misc':$language), $sku);
   }
   # Standard skus
   else {
      # note the special case for "bin"
      my $subdir;
      $subdir = ($lcsku eq 'bin'?"":$sku);
         
      return ("\\\\$computer_name\\$build_number.$platform.$branch.$timestamp.$language", $subdir);
   }
}

sub GetBuildNumberAndTsFromShare {
   my $named_parameters = shift;
   my $build = shift;
   
   my ( $branch,   $language, $platform, $sku, $fconglomerator_build,
        $flang_neutral_build ) =
   GetNamedParameters( $named_parameters,
        q(Branch), q(Language), q(Platform), q(Sku), q(IsConglomeratorBuild),
        q(IsLangNeutralBuild) );

   my ($build_number, $timestamp);

   #
   # Note: may have to reach into a share and
   #       extract some information if it is
   #       not readily apparent from the name
   #       of the share (as is the case with main)
   #

   # Symbol server points to shares
   # containing the fully-qualified build-name
   #   (build_num.platform.branch.time)
   if ( lc $sku eq 'sym' ) {
      $build_number = build_number( $build );
      $timestamp = build_date( $build );
   }

   # Special "skus"
   elsif ( $fconglomerator_build &&
           $build =~ /^\\\\[^\\]+\\(\d+)\.[^\.]+(?:\.(\d+-\d+))?\.([^\\]+)\\$sku$/i &&
           $flang_neutral_build && lc$3 eq 'misc' ||
           !$flang_neutral_build && lc$3 eq lc$language ) {
      $build_number = $1;
      $timestamp = $2 || 0;
   }

   # Standard skus
   elsif ( !$fconglomerator_build &&
           $build =~ /^\\\\[^\\]+\\(\d+)\.$platform\.[^\.]+\.(\d+-\d+)\.$language(?:\\$sku)?$/i ) {
      $build_number = $1;
      $timestamp = $2;
   }
   else {
      # Error - don't recognize the format
      return;
   }

   return ($build_number, $timestamp);
}

sub GetDfsLinkName {
   my $named_parameters = shift;

   my ($branch,   $language,   $build_id,  $platform,   $sku,
       $fconglomerator_build ) =
   GetNamedParameters( $named_parameters,
       q(Branch), q(Language), q(BuildID), q(Platform), q(Sku),
       q(IsConglomeratorBuild) );
   return if ( !defined $branch );

   my $lcsku = lc $sku;
   
   # Used to add .srv onto skus that appear for both
   # the client and server in the latest.* links
   my $sku_name_suffix = '';

   # If we haven't looked for DFSAlternateBranchName
   # in the INI file, do so now
   my $dfs_branch_name;
   if ( !exists $named_parameters->{DefaultDFSBranches}{$branch} ) {
      my $alt_branch_name = &GetIniSetting::GetSettingQuietEx( $branch, $language, 'DFSAlternateBranchName' );
      # Default to the branch name
      if ( !$alt_branch_name) {
         $named_parameters->{DefaultDFSBranches}{$branch} = $branch;
      }
      else {
         $named_parameters->{DefaultDFSBranches}{$branch} = $alt_branch_name;
      }
   }
   $dfs_branch_name = $named_parameters->{DefaultDFSBranches}{$branch};

   # Special behaviors on latest.* links
   if ( $build_id =~ /^latest/i ) {
      # If we haven't looked for DFSAlternateLatestBranchName
      # in the INI file, do so now
      if ( !exists $named_parameters->{LatestDFSBranches}{$branch} ) {
         my $dfs_latest_branch_name = &GetIniSetting::GetSettingQuietEx( $branch, $language, 'DFSAlternateLatestBranchName' );
         # Default to the current DFS branch name
         if ( !$dfs_latest_branch_name) {
            $named_parameters->{LatestDFSBranches}{$branch} = $named_parameters->{DefaultDFSBranches}{$branch};
         }
         else {
            $named_parameters->{LatestDFSBranches}{$branch} = $dfs_latest_branch_name;
         }
      }
      $dfs_branch_name = $named_parameters->{LatestDFSBranches}{$branch};
   
      # If both client and serer support a sku,
      # append .srv onto the server version.
      # If this branch is both client and server,
      # then don't use the .srv extension
      if ( IsClientSku( $named_parameters ) &&
           IsServerSku( $named_parameters ) &&
           IsServerBranch( $named_parameters ) &&
           !IsClientBranch( $named_parameters ) ) {
         $sku_name_suffix = '.srv';
      }
   }

   # Special "skus"
   if ( $fconglomerator_build ) {
      return "$dfs_branch_name\\$language\\$build_id\\". ($lcsku eq 'symbolcd'?'symcd2':$lcsku). $sku_name_suffix;
   }
   # Standard skus and symbol server sku
   else {
      return "$dfs_branch_name\\$language\\$build_id\\$platform\\$lcsku". $sku_name_suffix;
   }
}

sub GetBuildIdsFromCurrentLinks {
   my $named_parameters = shift;

   my ($dfs_access, $build_number,  $branch,   $platform,   $language,   $sku ) =
   GetNamedParameters( $named_parameters,
       q(DfsMap),   q(BuildNumber), q(Branch), q(Platform), q(Language), q(Sku) );

   return if ( !defined $dfs_access );

   my ( $cur_share_name, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $cur_share_name ) {
      errmsg( "Do not know how to create release shares for $branch / $sku." );
      return;
   }
   $cur_share_name .= "\\$sub_path" if ( $sub_path );

   my @build_ids;
   
   # Return all recognized build IDs we are currently linked to
   #    (expecting <build_number> and latest.* entries)
   my @current_links = @{ $dfs_access->{$cur_share_name} } if ( exists $dfs_access->{$cur_share_name} );
   foreach ( @current_links ) {
      my $next_build_id;

      $next_build_id = GetBuildIdFromDfsLink( $named_parameters, $_ );
      if ( $next_build_id ) {
         push @build_ids, $next_build_id;
      }
   }

   return @build_ids;
}

sub GetBuildIdFromDfsLink {
   my $named_parameters = shift;
   my $build = shift;
   
   my ( $branch,   $platform,   $language,   $sku,
        $fconglomerator_build, $flang_neutral_build ) =
   GetNamedParameters( $named_parameters,
        q(Branch), q(Platform), q(Language), q(Sku),
        q(IsConglomeratorBuild),  q(IsLangNeutralBuild) );

   my $lcsku = lc $sku;
   my $build_id;

   # Special "skus"
   if ( $fconglomerator_build ) {
      my $lang = $flang_neutral_build?'misc':$language;
      my $dfs_sku_name = $lcsku eq 'symbolcd'?'symcd2':$sku;
      $dfs_sku_name .= '(?:\.srv)?';
      ($build_id) = $build =~ /[^\\]+\\$lang\\([^\\]+)\\$dfs_sku_name$/i;
   }
   # Standard skus and symbol server sku
   else {
      ($build_id) = $build =~ /[^\\]+\\$language\\([^\\]+)\\$platform\\$sku(?:\.srv)?$/i;
   }

   return $build_id;
}

sub GetWriteableDfsShares {
   my $named_parameters = shift;

   my ($dfs_access, $branch) =
   GetNamedParameters( $named_parameters,
       q(DfsMap),   q(Branch) );
   return if ( !defined $dfs_access );

   # All known branches use the same writeable share format
   if ( $branch ) # TRUE
   {
      my @dfs_servers = (tied %$dfs_access)->GetDfsHosts();
      if ( !@dfs_servers ) {
         errmsg( "Unable to retrieve hosting machines for DFS root ". (tied %$dfs_access)->GetDfsRoot(). "." );
         errmsg( $_ ) foreach ( split /\n/, StaticDfsMap::GetLastErrorMessage() );
         return;
      }
      
      # Point to writeable shares
      s/(\\\\[^\\]+).*/$1\\writer\$\\release/ foreach ( @dfs_servers );
      return @dfs_servers;
   }
   # Unknown branch
   else {
      return;
   }
}

sub GetHideableDfsPathNames {
   my $named_parameters = shift;

   my ( $dfs_access, $branch,   $language,   $build_id,  $sku ) = 
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(Branch), q(Language), q(BuildID), q(Sku) );
   return if ( !defined $dfs_access );

   # Get writeable DFS share for our branch
   my @writeable_dfs_shares = GetWriteableDfsShares( $named_parameters );
   if ( !@writeable_dfs_shares ) {
      dbgmsg( "Unknown writeable DFS share for $branch." );
      return;
   }
   
   my $dfs_link = GetDfsLinkName( $named_parameters );
   if ( !defined $dfs_link ) {
      errmsg( "Do not know how to create $build_id DFS link for $branch / $sku." );
      return;
   }

   # Want the path up to latest.* or #
   # (build_id): main\usa\<build_id>
   $dfs_link =~ s/^(.*$build_id)\\.*$/$1/;
  
   # All known branches use the same writeable share format
   if ( $branch ) # TRUE
   {
      return map {"$_\\$dfs_link"} @writeable_dfs_shares;
   }
   # Unknown branch
   else {
      return;
   }
}

sub GetBldFileDfsPathNames {
   my $named_parameters = shift;
   
   my ( $dfs_access, $branch,   $language,   $build_id,
        $platform,   $sku ) =
   GetNamedParameters( $named_parameters,
        q(DfsMap),   q(Branch), q(Language), q(BuildID),
        q(Platform), q(Sku) );
   return if ( !defined $dfs_access );

   # Get writeable DFS share for our branch
   my @writeable_dfs_shares = GetWriteableDfsShares( $named_parameters );
   if ( !@writeable_dfs_shares ) {
      dbgmsg( "Unknown writeable DFS share for $branch." );
      return;
   }
   
   my $dfs_link = GetDfsLinkName( $named_parameters );
   if ( !defined $dfs_link ) {
      errmsg( "Do not know how to create $build_id DFS link for $branch / $sku." );
      return;
   }

   # Want the path up to platform: main\usa\<build_id>\<platform>
   $dfs_link =~ s/^(.*$platform)\\.*$/$1/;

   # All known branches use the same writeable share format
   if ( $branch ) # TRUE
   {
      return map {"$_\\$dfs_link"} @writeable_dfs_shares;
   }
   # Unknown branch
   else {
      return;
   }
}


sub ModifyQlyFile {
   my $build = shift;
   my $quality = shift;
   my $path_to_quality_file = shift;

   my ( @existing_qlyfiles, $qly_file );
   my ( $fqlyfile_already_set );
   
   # Check for existing QLY files
   @existing_qlyfiles = grep { $_ if ( ! -d $_ ) } globex "$path_to_quality_file\\*.qly";
   # 0 = success
   # 2 = couldn't find file (may be a failure or there may be no QLY file;
   #                         have to treat as a success as there is no way
   #                         to tell the difference - $^E doesn't help)
   if ( $! != 0 && $! != 2 ) {
      errmsg( "Trying to find existing QLY file: $!" );
      return;
   }

   # Remove any QLY files that don't match current status
   # -- there should never be more than one, but we
   #    should handle that case correctly
   undef $fqlyfile_already_set;
   foreach $qly_file ( @existing_qlyfiles ) {
      my ($qly_file_quality) = $qly_file =~ /\\([^\\]+)\.qly$/;

      if ( lc $qly_file_quality eq lc $quality ) {
         # Check for correct information inside
         my $qly_information = ReadQlyFile( $qly_file );
         if ( !defined $qly_information ) {
            wrnmsg( "Problem reading $qly_file" );
         }
         elsif ( $qly_information =~ /^$build$/i ) {
            $fqlyfile_already_set = 1;
            next;
         }
      }
      elsif ( !AllowQualityTransition( $qly_file_quality, $quality ) ) {
         errmsg( "Not allowed to go from '$qly_file_quality' to '$quality' quality!" );
         return;
      }

      # Remove the QLY file
      unless ( unlink $qly_file ) {
         errmsg( "Could not delete $qly_file ($!)" );
         return;
      }
   }

   # Create new QLY file if necessary
   if ( !$fqlyfile_already_set ) {
      unless ( open QLYFILE, "> $path_to_quality_file\\$quality.qly" ) {
         errmsg( "Could not write to $path_to_quality_file\\$quality.qly ($!)" );
         return;
      }

      print QLYFILE "$build\n";

      close QLYFILE;
   }

   return 1;
}

sub ReadQlyFile {
   my $qlyfile_path = shift;

   my ( $qlyfile_contents );

   unless ( open QLYFILE, $qlyfile_path ) {
      errmsg( "Failure opening $qlyfile_path ($!)" );
      return;
   }

   $qlyfile_contents = <QLYFILE>;
   close QLYFILE;
   
   chomp $qlyfile_contents;
   return $qlyfile_contents;
}

sub DeleteQlyFile {
   my $path_to_quality_file = shift;

   my @existing_qlyfiles;

   # Check for existing QLY files
   @existing_qlyfiles = grep { $_ if ( ! -d $_ ) } globex "$path_to_quality_file\\*.qly";
   # 0 = success
   # 2 = couldn't find file (may be a failure or there may be no QLY file;
   #                         have to treat as a success as there is no way
   #                         to tell the difference - $^E doesn't help)
   if ( $! != 0 && $! != 2 ) {
      errmsg( "Trying to find existing QLY file: $!" );
      return;
   }

   my $qly_file;
   foreach $qly_file ( @existing_qlyfiles ) {
      if ( !unlink $qly_file ) {
         wrnmsg( "Unable to remove $qly_file ($!)" );
      }
   }

   return 1;
}

sub CreateSecuredBuildShare 
{
   my $named_parameters = shift;
   
   my ( $accessed_shares,  $full_build_path,   $computer_name,
        $quality,          $build_number,      $language,
        $platform,         $branch,            $sku ) = 
   GetNamedParameters( $named_parameters,
        q(AccessedShares), q(FullBuildPath),   q(ComputerName),
        q(Quality),        q(BuildNumber),     q(Language),
        q(Platform),       q(Branch),          q(Sku) );
   return if ( !defined $accessed_shares );

   my $fshare_already_exists;
   my $sMember;
   my $sBVTAccessGroup;
   my ( @share_members, @remove_permissions );

   my ( $build_share, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $build_share ) 
   {
      errmsg( "Unable to determine release share for $branch / $sku." );
      return;
   }

   # Optimization: check if we have already looked at this share
   #    (especially useful when each sku uses the same share)
   foreach ( @$accessed_shares ) 
   {
      return 1 if ( lc $_ eq lc $build_share );
   }
   
   # Choose share permissions based on quality
   if ( lc $quality eq "pre" || lc $quality eq "bvt" ) 
   {
      my $share_member_string = &GetIniSetting::GetSettingQuietEx( $branch, $language, "BVTMembers" );
      if ( $share_member_string ) 
      {
         @share_members = split ' ', $share_member_string;
	
      }
      # INI file must specify permissions
      else {
          logmsg( "No entries specified in INI file for BVTMembers" );
          
      }
      #Get the BVT access group
      $sBVTAccessGroup = &GetIniSetting::GetSettingQuietEx( $branch, $language, "BVTAccessGroup" );
      if ( $sBVTAccessGroup) 
      {
		$sBVTAccessGroup =~ s/_/ /g;
		push @share_members, $sBVTAccessGroup;
      }
      
      
   } 
   else 
   {
      my $share_member_string = &GetIniSetting::GetSettingQuietEx( $branch, $language, "ReleaseAccess" );
      if ( $share_member_string ) 
      {
         @share_members = split ' ', $share_member_string;
      }
      # INI file must specify permissions
      else 
      {
         errmsg( "No entries specified in INI file for ReleaseAccess" );
         return;
      }
   
   }
   # Create share if it doesn't already exist
   $fshare_already_exists = ( -e $build_share );
   
   # This will set the current permissions and create the share if necessary
   dbgmsg( "Setting share permissions for $build_share:" );
   dbgmsg( " $_" ) foreach @share_members;
   #BUG FIX: If the share does not exist, create it and then remove access to everyone
   if(!$fshare_already_exists)
   {
		if (!ExecuteProgram::ExecuteProgram( "rmtshare.exe $build_share=$full_build_path /remove everyone"))
		{
			errmsg( "Failed creating the share for $full_build_path." );
			errmsg( " ". ExecuteProgram::GetLastCommand() );
			errmsg( "  $_" ) foreach ExecuteProgram::GetLastOutput();
			return;
		}
   }
   foreach $sMember (@share_members)
   {
		my $iRes = 0;
		$iRes = !ExecuteProgram::ExecuteProgram("rmtshare.exe $build_share /GRANT\"$sMember\":R > NUL");
		if ( $iRes  ) 
		{
			logmsg( "Failed granting access for $sMember." );
			logmsg( " " . ExecuteProgram::GetLastCommand() );
			logmsg( "  $_" ) foreach ExecuteProgram::GetLastOutput();
		}
   }
        
  
   
   # Remove any old permissions from an existing share
   # We don't want to drop the share and recreate it
   # because current connections will be dropped and
   # we decided that was bad
   if ( $fshare_already_exists )  {
      my %hash_share_members;
      $hash_share_members{ lc $_ } = 1 foreach @share_members;
      if ( !ExecuteProgram::ExecuteProgram("rmtshare.exe $build_share") ) {
         errmsg( "Failure executing ". ExecuteProgram::GetLastCommand() );
         errmsg ( " $_" ) foreach ExecuteProgram::GetLastOutput();
         return;
      }
      my @current_share_permissions = ExecuteProgram::GetLastOutput();

      undef @remove_permissions;
      my $permission;
      my $interesting_lines;
      foreach $permission ( @current_share_permissions ) {
         my $user_name;
         
         # skip empty lines
         next if ( $permission eq "" );
         
         # Deal with no permissions set
         if ( $permission eq "No permission specified." ) {
            wrnmsg( "Share $build_share has no default permissions." );
            last;
         }

         # Otherwise we only care about the lines between
         #   'Permissions:' and 'The command completed successfully.'
         if ( $permission eq 'Permissions:' ) {
            $interesting_lines = 1;
            next;
         }
         last if ( $permission eq 'The command completed successfully.' );
         next if ( !$interesting_lines );

         # Only need to verify name and not permissions as rmtshare should
         # have already set the correct permissions for the name.
         # Note that rmtshare also prepends a backslash for builtin
         # groups, but you cannot use the backslash when specifying
         # the name on the command line, so strip out any
         # prepending backslash characters.  This also catches
         # local groups as they are reported as <machine>\Group on
         # remote machines, but can only be added and removed as 'Group".
         if($permission =~ /BVT/)
         {
			next;
         }
         ($user_name) = $permission =~ /^\s*\\?(?:$computer_name\\)?(\S+)\s*\:/i;
         if ( !$user_name ) {
            errmsg( "Problem parsing user from rmtshare output:" );
            errmsg( " $permission" );
            return;
         }
         if ( !exists $hash_share_members{ lc $user_name } ) {
            push @remove_permissions, $user_name;
         }
      }
      
      # Now actually call rmtshare to remove unrecognized users
      if ( @remove_permissions ) {
         dbgmsg( "Removing permissions from $build_share:" );
         dbgmsg( " $_" ) foreach @remove_permissions;
         if ( !ExecuteProgram::ExecuteProgram( "rmtshare.exe $build_share ". join " ", map { "/REMOVE $_" } @remove_permissions ) ) {
            errmsg( "Failed removing old permissions from $build_share." );
            errmsg ( " ". ExecuteProgram::GetLastCommand() );
            errmsg ( "  $_" ) foreach ExecuteProgram::GetLastOutput();
            return;
         }
      }
   }
   
   # Verify that share is reachable
   # This is making the assumption that we
   # are allowed access to the share
   if ( ! -e $build_share ) {
      errmsg( "Unable to access $build_share ($!)" );
      return;
   }
   
   # Add to accessed shares array
   push @$accessed_shares, $build_share;

   return 1;
}

sub LowerBuildShare {
   my $named_parameters = shift;
   my ( $accessed_shares,  $branch,   $sku, $lang ) =
   GetNamedParameters( $named_parameters,
        q(AccessedShares), q(Branch), q(Sku), q(Language) );

   my ( $build_share, $sub_path ) = GetShareName( $named_parameters );
   if ( !defined $build_share) {
      errmsg( "Unable to determine release share for $branch / $sku." );
      return;
   }

   # Optimization: check if we have already removed this share
   #  (especially useful when each sku uses the same share)
   foreach ( @$accessed_shares ) {
      return 1 if ( lc $_ eq lc $build_share );
   }

   # Check if the share exists
   my $fshare_exists = ( -e $build_share );

   # Remove the share
   if ( $fshare_exists ) {
      if ( !ExecuteProgram::ExecuteProgram( "rmtshare.exe $build_share /DELETE" ) ) {
         errmsg( "Failed removing share $build_share." );
         errmsg( " ". ExecuteProgram::GetLastCommand() );
         errmsg( "  $_") foreach ExecuteProgram::GetLastOutput();
         return;
      }
   }
   # If the share doesn't exist we are done,
   # but do a sanity check on the reason
   elsif ( $! != 2 ) {
      errmsg( "Unable to verify share $build_share ($!)." );
      return;
   }
   
   # Add to accessed shares array
   push @$accessed_shares, $build_share;

   return 1;
}

sub GetReleasePath {
    my( @net_share_output, @net_share_local_path_entry );
    my( $field_name, $field_value );

    if ( !ExecuteProgram::ExecuteProgram("net share release") ) {
    errmsg( "Unable to find share \'release\'.");
        errmsg( " ". ExecuteProgram::GetLastCommand() );
        errmsg( "  $_" ) foreach ExecuteProgram::GetLastOutput();
    return;
    }
    @net_share_output = ExecuteProgram::GetLastOutput();
    # note that we are using the second line of the net share
    # output to get this data. if this changes, it'll break.
    @net_share_local_path_entry = split /\s+/, $net_share_output[1];
    dbgmsg( "Path information for release is '". (join " ", @net_share_local_path_entry). "'" );
    if ( $net_share_local_path_entry[0] ne "Path" ) {
    wrnmsg( "Second line of net share does not start with " .
             "\'Path\' -- possibly another language?");
    }
    dbgmsg( "Release path is $net_share_local_path_entry[1]");
    return $net_share_local_path_entry[1];
}

#
# This is a wrapper to glob that expects and
# returns paths using '\' as the path separator
#
sub globex ($)
{
   my $match_criteria = shift;
   croak "Must specify parameter for globex" if ( !defined $match_criteria );

   # Need to use '/' for UNC paths, so just convert to all '/''s
   $match_criteria =~ s/\\/\//g;

   # Return the results, converting back to '\'
   return grep { s/\//\\/g } glob( $match_criteria );
}

parseargs('?'       => \&Usage,
          'lower'   => sub { $Op = 'lower' },
          'n:'      => \$Build_Number,
          'q:'      => \&ValidateAndSetQuality,
          'a:'      => \$Architecture,
          't:'      => \$Debug_Type,
          'time:'   => \$Time_Stamp,
          'f'       => \$fOverride_Safe,
          'safe'    => \$fSafe,
          'replace' => \$fReplaceAtNumberedLink,
          'd'       => \$Logmsg::DEBUG);
#         'l:'      => \$Language, # Done by ParseEnv

Usage() if ( @ARGV );

$Language     = $ENV{LANG};

# Initialize with default values if not specified
$Op           ||= 'raise';
$Build_Number ||= '*';
$Architecture ||= '*';
$Time_Stamp   ||= '*';
$Debug_Type   ||= '*';

$Platform = "$Architecture$Debug_Type";

if ( !Main() ) {
   errmsg( "Terminated abnormally." );
   1;
}
else {
   logmsg( "Completed successfully." );
   0;
}

sub ValidateAndSetQuality {
    my $quality = shift;

    if ( exists $Ordered_Qualities{ lc $quality } ) {
       $Quality = $quality;
       return 1;
    }
    else {
       errmsg( "Unrecognized quality \'$quality\'" );
       exit( 1 );
    }
}

sub Usage {
   my $name = $0;
   print "$name\n";
   $name =~ s/.*?([^\\]+)$/$1/;

   print <<USAGE;

$name -n:\# -q:qly [-lower] [-a:arc] [-l:lng] [-d] [-?]
   
  -n:#                Raise build number #
  -q:qly              Raise to 'qly' quality
  -lower              Lower a build and remove from dfs
  -a:arc              Act on architecture 'arc' (e.g. ??????)
  -t:typ              Act on debug type 'typ' (e.g. fre or chk)
  -time:yymmdd-hhmm   Use time-stamp criteria
  -l:lng              Raise for language 'lng' (from codes.txt)
  -safe               Used to raise an old build to TST/IDx (RAISE only)
  -replace            Will replace "newer" builds at a numbered link
  -f                  Force an action that would not normally be taken
  -d                  Debug mode
  -?                  Display usage (this screen)
  $name will issue the appropriate DFS commands to raise
  a build to a specific quality.
   
USAGE
   
   exit(1);
}


package ExecuteProgram;

my $Last_Command;
my @Last_Output;

sub ExecuteProgram {
   
   $Last_Command = shift;

   @Last_Output = `$Last_Command`;
   chomp $_ foreach ( @Last_Output );
   
   if ( $? ) {
      return;
   }
   else {
      return 1;
   }
}

sub GetLastCommand {
   return $Last_Command;
}

sub GetLastOutput {
   return @Last_Output;
}

# Object to control synchronization among machines
package MultiMachineLock;

use Win32::ChangeNotify;
use Win32::Event;

sub new {
   my $class = shift;
   my $spool_path = shift;
   my $timeout = shift;

   return if not defined $spool_path;

   my $instance = {
      Path            => $spool_path,
      Timeout         => $timeout || INFINITE, # default timeout is INFINITE
      File            => "$ENV{COMPUTERNAME}.txt",
      NotificationObj => undef,
      LocalSyncObj    => undef,
      fHaveLocalSync  => 0,
      Count           => 0,
      LastErrorMsg    => "",
      LastErrorValue  => 0
      };
   
   return bless $instance;
}

sub Lock {
   my $self             = shift;
   my $wait_return;

   return unless ref $self;

   # If we already hold the lock just bump up the ref-count
   if ( 0 != $self->{Count} ) {
      $self->{Count}++;
      return 1;
   }

   # Need to synchronize local access (only one program
   # at a time from the same machine can hold the lock)
   if ( !defined $self->{LocalSyncObj} ) {
      my $lock_path = $self->{Path};
      $lock_path =~ s/\\\\/remote\\/;
      $lock_path =~ s/\\/\//g;

      $self->{LocalSyncObj} = new Win32::Event ( 0, 1, "Global\\$lock_path" );
      if ( !defined $self->{LocalSyncObj} ) {
         $self->{LastErrorMsg}   = "Unable to create a local event ($^E).";
         $self->{LastErrorValue} = 1;
         return;
      }
   }
   
   if ( !$self->{fHaveLocalSync} ) {
      $wait_return = $self->{LocalSyncObj}->wait( $self->{Timeout} );
      # Handle timeout
      if ( 0 == $wait_return ) {
         $self->{LastErrorMsg}   = "Waiting on another process on machine.";
         $self->{LastErrorValue} = 2; # 2 = timeout
         return;
      }
      # Handle error condition
      elsif ( 1 != $wait_return ) {
         $self->{LastErrorMsg}   = "Unexpected error waiting for local synchronization (wait returned ". $wait_return. ")";
         $self->{LastErrorValue} = 1;
         return;
      }

      $self->{fHaveLocalSync} = 1;
   }

   # Check for our existence before
   # we create a file in the queue
   # (this will be the case if something bad
   #  happened on the last run and we are
   #  rerunning the command to recover)
   if ( ! -e "$self->{Path}\\$self->{File}" ) {
      unless ( open SPOOLFILE, "> $self->{Path}\\$self->{File}" ) {
         $self->{LastErrorMsg}   = "Failed to create synchronization file '$self->{Path}\\$self->{File}' ($!).";
         $self->{LastErrorValue} = 1;
         return;
      }

      print SPOOLFILE "This file is used to synchronize access among machines.";
      close SPOOLFILE;
   }

   # Create the notification object if this is the first time we were called
   $self->{NotificationObj} ||= new Win32::ChangeNotify( $self->{Path}, 0, FILE_NOTIFY_CHANGE_FILE_NAME );
   if ( !defined ${$self->{NotificationObj}} ) {
      $self->{LastErrorMsg}   = "Failed creating monitor object ($^E).";
      $self->{LastErrorValue} = 1;
      return;
   }

   # Check our position in the 'queue' at the beginning
   if ( !ExecuteProgram::ExecuteProgram("dir /b /od $self->{Path}") ) {
      $self->{LastErrorMsg}   = "Unable to view directory $self->{Path}.\n";
      $self->{LastErrorMsg}  .= " ". ExecuteProgram::GetLastCommand(). "\n";
      $self->{LastErrorMsg}  .= "  $_\n" foreach ExecuteProgram::GetLastOutput();
      $self->{LastErrorValue} = 1;
      return;
   }
   my @ordered_spool_directory = ExecuteProgram::GetLastOutput();

   # We are at the top
   if ( $ordered_spool_directory[0] eq $self->{File} ) {
      $self->{Count}++;
      return 1;
   }

   # Recheck our position in the 'queue' everytime
   # the state of the directory changes until we
   # are in the top position or we hit the timeout
   # value with no activity
   while ( 1 ) {
      $self->{NotificationObj}->reset();
      $wait_return = $self->{NotificationObj}->wait( $self->{Timeout} );
      
      if ( !ExecuteProgram::ExecuteProgram("dir /b /od $self->{Path}") ) {
         $self->{LastErrorMsg}   = "Unable to view directory $self->{Path}.\n";
         $self->{LastErrorMsg}  .= " ". ExecuteProgram::GetLastCommand(). "\n";
         $self->{LastErrorMsg}  .= "  $_\n" foreach ExecuteProgram::GetLastOutput();
         $self->{LastErrorValue} = 1;
         return;
      }
      @ordered_spool_directory = ExecuteProgram::GetLastOutput();
   
      # We are at the top
      if ( $ordered_spool_directory[0] eq $self->{File} ) {
         $self->{Count}++;
         return 1;
      }
      # Still waiting for others
      else {
         # Make sure we are still in the queue
         my $found_self;
         foreach ( @ordered_spool_directory ) {
            $found_self = 1 if ( $_ eq "$self->{File}" );
         }
         if ( !$found_self ) {
            # Lost our synchronization file -- recreating...
            unless ( open SPOOLFILE, "> $self->{Path}\\$self->{File}" ) {
               $self->{LastErrorMsg}   = "Lost our synchronization file '$self->{Path}\\$self->{File}' -- failed to recreate. ($!).";
               $self->{LastErrorValue} = 1;
               return;
            }
   
            print SPOOLFILE "This file is used to synchronize access among machines.";
            close SPOOLFILE;
         }
      }
      
      # Handle timeout
      if ( 0 == $wait_return ) {
         my $machine_name = $ordered_spool_directory[0];
         $machine_name =~ s/\.txt$//;
         $self->{LastErrorMsg}   = "Waiting on $machine_name ($self->{Path}\\$ordered_spool_directory[0]).";
         $self->{LastErrorValue} = 2; # 2 = timeout
         return;
      }
      # Handle error condition
      elsif ( 1 != $wait_return ) {
         $self->{LastErrorMsg}   = "Unexpected error waiting on directory to change (wait returned ". $wait_return. ")";
         $self->{LastErrorValue} = 1;
         return;
      }
   }

   $self->{LastErrorMsg}   = "Jumped out of an infinte loop -- no idea how we got here";
   $self->{LastErrorValue} = 1;
   return;
}

sub Unlock {
   my $self = shift;

   return unless ref $self;

   # Can't release a lock we don't hold
   if ( 0 == $self->{Count} ) {
      return;
   }

   # Decrement lock count
   if ( 0 == --$self->{Count} ) {
      if ( ! unlink "$self->{Path}\\$self->{File}" ) {
         $self->{LastErrorMsg}   = "Failed to delete synchronization file ($self->{Path}\\$self->{File}).  May need to delete by hand.";
         $self->{LastErrorValue} = 1;
      }
      $self->{LocalSyncObj}->set();
   }

   return 1;
}

sub GetLastError {
   my $self = shift;

   return unless ref $self;

   return $self->{LastErrorValue};
}

sub GetLastErrorMessage {
   my $self = shift;

   return unless ref $self;

   return $self->{LastErrorMsg};
}

sub DESTROY {
   my $self = shift;

   return unless ref $self;

   if ( $self->{Count} > 0 ) {
      #print "Abandoning lock file -- attempting to delete.";
      $self->{Count} = 1;
      return $self->Unlock();
   } else {
      if ( $self->{fHaveLocalSync} ) {
         $self->{LocalSyncObj}->set();
      }
      return 1;
   }
}



package StaticDfsMap;

my $Last_Error_Msg;

sub TIEHASH {
   my $class = shift;
   my $dfs_root = shift;
   my $instance;
   my ($dfs_view_info, $cur_dfs_link);
   my $fchild_dfs_servers;
   
   return if ( @_ or !defined $dfs_root );
   
   # Check current dfscmd.exe version
   if ( !VerifyDfsCmdVer() ) {
      return; # Error message should already be set
   }
   
   # Remove trailing backslash (if it exists) from DFS root
   $dfs_root =~ s/\\$//;

   # Read in current DFS view
   if ( !ExecuteProgram::ExecuteProgram("dfscmd.exe /view $dfs_root /batch") ) {
      $Last_Error_Msg = "Failed viewing dfs root $dfs_root.\n";
      $Last_Error_Msg .= " ". ExecuteProgram::GetLastCommand(). "\n";
      $Last_Error_Msg .= "  $_\n" foreach ExecuteProgram::GetLastOutput();
      return;
   }
   my @full_dfs_view = ExecuteProgram::GetLastOutput();

   $instance = {
      "DFS Root"      => $dfs_root };
#     "DFS Work Root" => {}
#     "DFS Servers"   => (),
#     "Map"           => {}

   # Expected output:
   # dfscmd /map "\\<dfs_root>\<link_name>" "\\<server>\<share>" "<comment>"
   my %dfs_map;
   foreach my $dfs_view_info ( @full_dfs_view ) {
      chomp $dfs_view_info;
      next if ( !$dfs_view_info );
      next if ( $dfs_view_info =~ /^REM BATCH RESTORE SCRIPT/ );

      $dfs_view_info = lc $dfs_view_info;

      # Are we done?
      if ( $dfs_view_info eq 'the command completed successfully.' ) {
         last;
      }

      my ($dfs_link, $share, $comment) = $dfs_view_info =~ /dfscmd \/(?:map|add) "(.*?)" "(.*?)"(?: "(.*)")?$/;
      my $relative_link_name = $dfs_link;
      $relative_link_name =~ s/^\Q$dfs_root\E\\//i;
      if ( !$dfs_link || !$share || !$relative_link_name )
      {
         $Last_Error_Msg = "Unrecognized entry parsing ". ExecuteProgram::GetLastCommand(). "\n";
         $Last_Error_Msg .= "   $dfs_view_info";
         return;
      }

      # If it is just the root, then this entry represents a hosting server
      if ( lc $dfs_link eq lc $dfs_root ) {
         push @{$instance->{"DFS Servers"}}, $share;
      }
      # Otherwise associate the link and the share
      else {
         push @{$dfs_map{$relative_link_name}}, $share;
         push @{$dfs_map{$share}}, $relative_link_name;
      }
   }

   # Expect to find at least one DFS server under the root
   if ( !exists $instance->{"DFS Servers"} ) {
      $Last_Error_Msg = "Did not find the root node and specified servers for $dfs_root.";
      return;
   }

   # FUTURE: find a nicer way around this
   # In cases where more than one server is actually hosting DFS,
   # we need to pick one of the hosting machines to perform
   # our commands against so that we don't have to wait for
   # replication (this is to help tests for just created and
   # just removed directories succeed).
   foreach ( @{$instance->{"DFS Servers"}} ) {
      if ( -e $_ ) {
         $instance->{"DFS Work Root"} = $_;
         last;
      }
   }
   # Verify we could see at least one
   if ( ! exists $instance->{"DFS Work Root"} ) {
      $Last_Error_Msg = "Could not find an accessible DFS server.";
      return;
   }

   #print "\n$_:\n ". (join "\n ", @{$dfs_map{$_}}) foreach ( sort keys %dfs_map );
   # Store the map we just created
   # inside of our private hash data
   $instance->{"Map"} = \%dfs_map;

   return bless $instance, $class;
}

sub FETCH {
   my $self = shift;
   my $link_or_share = shift;
   
   my $dfs_map = $self->{"Map"};

   return $dfs_map->{ lc $link_or_share } if (exists $dfs_map->{ lc $link_or_share });
   return;
}

sub STORE {
   my $self = shift;
   my $link_or_share = shift;
   my $new_link = shift;

   my $dfs_map = $self->{"Map"};
   my $fshare = $link_or_share =~ /^\\\\/;

   # Remove any trailing backslashes
   $link_or_share =~ s/\\$//;
   $new_link =~ s/\\$//;
   
   # If mapping already exists, we are done
   my $cur_mappings = $dfs_map->{lc $link_or_share};
   foreach ( @$cur_mappings ) {
      return 1 if ( lc $_ eq lc $new_link );
   }

   # Create new DFS mapping
   if ( !ExecuteProgram::ExecuteProgram( 
            "dfscmd.exe ". (@$cur_mappings?"/add ":"/map "). $self->{"DFS Root"}. 
                           ($fshare?"\\$new_link $link_or_share":"\\$link_or_share $new_link") )
      ) {
      #
      # COMMENTED OUT: If someone else is trying to manipulate the same
      #                links as we are while we are doing this then 
      #                we have a problem -- don't try to correct
      #
      # Might have gotten into a race-condition with another
      # machine attempting to add a new link -- if that is
      # a possibility try a map instead before giving up
      #
      #if ( !@$cur_mappings ||
      #     !ExecuteProgram( "dfscmd.exe /map ". $self->{"DFS Root"}.
      #                       ($fshare?"\\$new_link $link_or_share":"\\$link_or_share $new_link") ) ) {
      #   errmsg( "Failed to create link \\$self->{Dfs Root}\\". ($fshare?"\\$new_link => $link_or_share":"\\$link_or_share => $new_link") . "." );
      #   return;
      #}
      $Last_Error_Msg = "Problem adding/mapping link ". ($fshare?"$link_or_share":"$new_link"). ":\n";
      $Last_Error_Msg .= " " . ExecuteProgram::GetLastCommand() . "\n";
      $Last_Error_Msg .= join "\n  ", ExecuteProgram::GetLastOutput();
      return;
   }

   # Update the hash with the new information
   push @{$dfs_map->{lc $link_or_share}}, $new_link;
   push @{$dfs_map->{lc $new_link}}, $link_or_share;
   
   return 1;
}

sub DELETE {
   my $self = shift;
   my $link_or_share = shift;
   
   my $dfs_map = $self->{"Map"};
   my $fshare = $link_or_share =~ /^\\\\/;
   
   # Make sure DFS mapping exists before attempting to delete it
   return 1 if ( !exists $dfs_map->{lc $link_or_share} );

   my $cur_mappings = $dfs_map->{lc $link_or_share};

   return 1 if ( !@$cur_mappings );

   if ( $fshare ) {
      my $next_link;
      # Remove all DFS links pointing to this share
      foreach $next_link ( @$cur_mappings ) {
         if ( !$self->RemoveShareFromLink( $next_link, $link_or_share ) ) {
            return;
         }
      }
   } else {
      if ( !ExecuteProgram::ExecuteProgram( 
               "dfscmd.exe /unmap ". $self->{"DFS Root"}. "\\$link_or_share"
            ) ) {
         $Last_Error_Msg = "Failure trying to unmap $link_or_share:\n";
         $Last_Error_Msg .= " " . ExecuteProgram::GetLastCommand() . "\n";
         $Last_Error_Msg .= join "\n  ", ExecuteProgram::GetLastOutput();
         return;
      }

      # Remove the hash references
      delete $dfs_map->{lc $link_or_share};
      for ( my $i = 0; $i < scalar(@$cur_mappings); $i++) {
         if ( lc $cur_mappings->[$i] eq lc $link_or_share ) {
            splice @$cur_mappings, $i, 1;
         }
      }
   }

   return 1;
}

sub CLEAR {
   my $self = shift;

   # We don't actually want to be able to delete the entire
   # DFS structure, so we will just clear our information
   undef %$self;

   return;
}

sub EXISTS {
   my $self = shift;
   my $link_or_share = shift;

   my $dfs_map = $self->{"Map"};
   return exists $dfs_map->{lc $link_or_share};
}

sub FIRSTKEY {
   my $self = shift;
   
   my $dfs_map = $self->{"Map"};
   my $force_to_first_key = keys %$dfs_map;
   
   return scalar each %$dfs_map;
}

sub NEXTKEY {
   my $self = shift;
   my $last_key = shift;

   my $dfs_map = $self->{"Map"};
   return scalar each %$dfs_map;
}

sub DESTROY {
   my $self = shift;

   return;
}

#
# Need more methods than provided by TIEHASH defaults
#
sub RemoveShareFromLink {
   my $self = shift;
   my $link_root = shift;
   my $share_name = shift;

   my $dfs_map = $self->{"Map"};
   
   # Get current associated links
   my $cur_link_mappings = $dfs_map->{lc $link_root};
   my $cur_share_mappings = $dfs_map->{lc $share_name};
   my $fshare_linked;
   
   # If the share is not part of the link, return
   foreach (@$cur_link_mappings) {
         if ( lc $_ eq lc $share_name ) {
            $fshare_linked = 1;
            last;
         }
   }
   return 1 if ( !$fshare_linked );
   
   my $dfs_command = "dfscmd.exe /remove ".
                     $self->{'DFS Root'}.
                     "\\$link_root $share_name";
   if ( !ExecuteProgram::ExecuteProgram( $dfs_command ) ) {
     $Last_Error_Msg = "Could not remove $share_name from DFS link $link_root:\n";
     $Last_Error_Msg .= " " . ExecuteProgram::GetLastCommand() . "\n";
     $Last_Error_Msg .= join "\n  ", ExecuteProgram::GetLastOutput();
     return;
   }
   
   # Remove the associated hash entries
   for ( my $i = 0; $i < scalar(@$cur_link_mappings); $i++) {
      if ( lc $cur_link_mappings->[$i] eq lc $share_name ) {
         splice @$cur_link_mappings, $i, 1;
      }
   }
   for ( my $i = 0; $i < scalar(@$cur_share_mappings); $i++) {
      if ( lc $cur_share_mappings->[$i] eq lc $link_root ) {
         splice @$cur_share_mappings, $i, 1;
      }
   }

   return 1;
}

sub Flush {
   my $self = shift;

   # Do nothing for now, but here in preparation for batching of commands
   return 1;
}

sub GetDfsRoot {
   my $self = shift;

#   return $self->{ "DFS Root" };
   return $self->{ "DFS Root" };
}

sub GetDfsHosts {
   my $self = shift;

   return @{$self->{"DFS Servers"}};
}

sub VerifyDfsCmdVer {
   my ( @file_spec, $file_ver_string, @file_ver_info );
   
   # Verify the dfscmd.exe is proper
   if ( !ExecuteProgram::ExecuteProgram("where dfscmd.exe") ) {
      $Last_Error_Msg = "Could not find dfscmd.exe\n";
      $Last_Error_Msg .= " ". ExecuteProgram::GetLastCommand(). "\n";
      $Last_Error_Msg .= "  $_\n" foreach ExecuteProgram::GetLastOutput();
      return;
   }
   @file_spec = ExecuteProgram::GetLastOutput();
   
   if ( !ExecuteProgram::ExecuteProgram("filever $file_spec[0]") ) {
      $Last_Error_Msg = "Failed executing \'filever $file_spec[0]\'.";
      return;
   }
   $file_ver_string = join " ", ExecuteProgram::GetLastOutput();
   @file_ver_info = split /\s+/, $file_ver_string;

   # Fourth field is version number; compare it with known good
   if ($file_ver_info[4] lt "5.0.2203.1") {
       $Last_Error_Msg = "$file_ver_info[0] version is less than 5.0.2203.1.  Please install DFSCMD.EXE from a 2203 or later build.";
       return;
   }

   return 1;
}

sub GetLastErrorMessage {

   return $Last_Error_Msg;
}