Chip: Windows 2000 Professional Resource Kit/W2KPRK.iso/apps/MigrationWizard/IISv5MigrationUtility-ApacheSource.TAR/source.pl

Perl Script | 1999-04-12 | 96.6 KB | 3,446 lines

#!/usr/bin/perl

# -------------------------------------------------------------
# Microsoft IIS v.5 Migration Utility (Apache source component)
# Copyright (c) 1999. All rights reserved.
# -------------------------------------------------------------
package topmain;


# Configuration constants

# When true, script will cleanup after itself
$myCleanup = 0;

# The name of this web server
$myServerName = $ENV{'SERVER_NAME'};

# Figure out the script directory
$myScriptDir = $0;
$myScriptDir =~ s/Source.PL$//i;

# Temp directory
$myTempDir = $myScriptDir;

# Log file location
$myLogFilepath = $myScriptDir . 'iismu.log';

# Logging types
$myLogNOTICE = 1;               # Used with LogMessage SUB, for logging general info
$myLogWARNING = 2;              # Used with LogMessage SUB, for important warnings
$myLogERROR = 3;                # Used with LogMessage SUB, for fatal stop
$myLogCONONLY = 4;              # Used with LogMessage SUB, for output to console only

# Commands for iismu.data file
$myCmdIISCOMPUTER =      'IISCOMPUTER      ';               # Command for creating new IIsComputer object
$myCmdIISWEBSERVICE =    'IISWEBSERVICE    ';               # Command for creating new IIsWebService object
$myCmdIISWEBINFO =       'IISWEBINFO       ';               # Command for creating new IIsWebInfo object
$myCmdIISFILTERS =       'IISFILTERS       ';               # Command for creating new IIsFilters object
$myCmdIISFILTER =        'IISFILTER        ';               # Command for creating new IIsFilter object
$myCmdIISWEBSERVER =     'IISWEBSERVER     ';               # Command for creating new IIsWebServer object
$myCmdIISCERTMAPPER =    'IISCERTMAPPER    ';               # Command for creating new IIsCertMapper object
$myCmdIISWEBVIRTUALDIR = 'IISWEBVIRTUALDIR ';               # Command for creating new IIsWebVirtualDir object
$myCmdIISWEBDIRECTORY =  'IISWEBDIRECTORY  ';               # Command for creating new IIsWebDirectory object
$myCmdIISWEBFILE =       'IISWEBFILE       ';               # Command for creating new IIsWebFile object
$myCmdPROPERTY =         'PROPERTY         ';               # Command for setting

# Command/operand separator
$myCmdSep = chr(127);


# Config files
$myHttpdConf = 'httpd.conf';
$mySrmConf = 'srm.conf';

# Output files
$myIismuData = 'iismu.data';
$myIismuFiles = 'iismu.files';

# Migration flag bitmasks
$myMIGRATE_CONTENT = 0x1;       # Migrating content for the vserver
$myMIGRATE_SETTINGS = 0x2;      # Migrate settings for the vserver
$myMIGRATE_MIME = 0x4;          # Migrate MIME for the vserver


# Array of server migration settings
%myServerSettings = null;

# Location of /iismu doc directory
$myDocDir = '';


# Get parameters

$theForm = $ENV{'QUERY_STRING'};

if('POST' eq $ENV{'REQUEST_METHOD'})
{
  $theForm = $theForm . '&' . <STDIN>;
}

@theFormPairs = split('&', $theForm);

for($i = 0; $i < scalar(@theFormPairs); $i++)
{
  ($theFieldName, $theFieldValue) = split('=', $theFormPairs[$i]);
  $myForm{$theFieldName} = urlDecode($theFieldValue);
}

# Get misc. form variables
$myBackURL = $myForm{'backurl'};



# Verify password

if(! checkPassword($myForm{'password'}))
{
  print STDOUT "Content-type: text/html\n\n";
  print STDOUT 'ERROR';
  exit(0);
}



# Handle page modes

$myMode =$myForm{'mode'};

if('getservers' eq $myMode)
{
  handleGetServers($myForm{'rootdir'}, $myForm{'configdirs'});
}
elsif('migrate' eq $myMode)
{
  handleMigrate($myForm{'rootdir'}, $myForm{'configdirs'}, $myForm{'servers'});
}
elsif(('getfile' eq $myMode) || ('getindexfile' eq $myMode))
{
  if('getfile' eq $myMode)
  {
    $theFile = $myForm{'file'};
  }
  else
  {
    $theFile = $myTempDir . 'iismu.files';
  }

  if(-e $theFile)
  {
    if(open(THEFILE, $theFile))
    {
      print STDOUT "Content-type: application/octet-stream\n\n";

      binmode(THEFILE);
      binmode(STDOUT);

      while(<THEFILE>)
      {
        print STDOUT $_;
      }

      close(THEFILE);
    }
  }

  exit(0);
}
else
{
  print STDOUT "Content-type: text/html\n\n";
  print STDOUT "OK,TYPE=APACHE,CABBING=FALSE\n";
}



# Begin supporting functions

sub dbgOut {
    print( "<!--@_-->\n" ) ;
}

# --------------------------------------------------------------------------------
# Procedure to convert base 36 "meganum" string to base 10 integer
#
sub base36to10
{
  my $inMegaNum = ucase(trim($_[0]));
  my $theValue = 0;
  my $thePower = 0;
  my $theDigitASC;
  my $theDigitVal;

  for(my $i = length($inMegaNum) - 1; $i >= 0; $i--)
  {
    $theDigitASC = ord(substr($inMegaNum, $i, 1));

    if($theDigitASC >= 65)
    {
      # A=10, A=ASCII65, 65-55=10
      $theDigitVal = $theDigitASC - 55;
    }
    else
    {
      # 0=ASCII48, 48-48=0
      $theDigitVal = $theDigitASC - 48;
    }

     $theValue += ($theDigitVal * (36**$thePower));
     $thePower++;
  }

  return $theValue;
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to check for execution password and return true if correct
#
sub checkPassword
{
  my $inPassword = $_[0];

  if(open(THEFILE, $myScriptDir . "password.txt"))
  {
    my $theLine;
    my $thePassword = '';

    while(<THEFILE>)
    {
      $theLine = $_;

      # Skip blank and comment lines
      next if /^\s*$/;
      next if /^;/;

      if($theLine =~ /^password=/i)
      {
        $theLine =~ s/password=//i;
        $thePassword = trim($theLine);
        last;
      }
    }

    close(THEFILE);
    return ($inPassword eq $thePassword);
  }
  else
  {
    return 1;
  }
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to return directive value
#
sub getDirectiveValue
{
  my $inString = $_[0];
  my $theIndex = index($inString, ' ');

  if($theIndex < 0)
  {
    return '';
  }
  else
  {
    return substr($inString, $theIndex + 1);
  }
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to return array of server migration settings
#
sub getServerArray
{
  my $inServerStr = $_[0];

  my @theServers = split(',', $inServerStr);
  my %theReturnVal = null;
  my $theTempStr;
  my $theServerNo;
  my $theFlags;
  my $theSettings;
  my $theContent;
  my $theMime;

  for(my $i = 0; $i < scalar(@theServers); $i++)
  {
   $theTempStr = $theServers[$i];
   $theServerNo = base36to10(substr($theTempStr, 0, index($theTempStr, "=")));
   $theFlags = base36to10(substr($theTempStr, index($theTempStr, "=") + 1));

   $theSettings = isSet($theFlags, $myMIGRATE_SETTINGS);
   $theContent = isSet($theFlags, $myMIGRATE_CONTENT);
   $theMime = isSet($theFlags, $myMIGRATE_MIME);

   $theReturnVal{$theServerNo} = "s=$theSettings,c=$theContent,m=$theMime";
  }

  return %theReturnVal;
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to handle 'getservers' page mode
#
sub handleGetServers
{
  my $inRootDir = $_[0];
  my $inConfigDirs = $_[1];

  print STDOUT "Content-type: text/html\n\n";

  $webconf = IISMuConf->new(
    'tempdir'        => $myScriptDir,
    'fileglob'       => $inConfigDirs,
    'fileout'        => '',
    'iiswwwroot'     => '',
    'ldifdomain'     => '',
    'perlmod'        => '',
    'serverobj'      => '',
    'userdbfullpath' => '/etc/',
    'userobj'        => '',
    'version'        => '',
    'webserver'      => '',
    'whoami'         => '',
    'wwwroot'        => $inRootDir,
    'wwwcgishl'      => '',
    'wwwsupp'        => '',
    'remote'         => 1,
    'userglob'       => '/home/*'
  );

  unless(defined($webconf))
  {
    print("Could not load configuration.<BR>\n") ;
    exit(0);
  }

  $computer = IISComputer->new( 'webconf' => $webconf ) ;

  # Write output.
  if(defined($computer))
  {
    $computer->writeServers();
  }
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to handle 'migrate' page mode
#
sub handleMigrate
{
  my $inRootDir = $_[0];
  my $inConfigDirs = $_[1];

  %myServerSettings = getServerArray($_[2]);

  print STDOUT "Content-type: text/html\n\n";
  printHeader();

  system("rm $myLogFilepath");
  system("rm $myScriptDir" . "iismu.dirs");
  system("rm $myTempDir" . "iismu.data");
  system("rm $myTempDir" . "iismu.files");

  logMessage($myLogNOTICE, 'Starting migration...');
  #$IISCore::debug = 1;

  $webconf = IISMuConf->new(
    'tempdir'        => $myScriptDir,
    'fileglob'       => $inConfigDirs,
    'fileout'        => '',
    'iiswwwroot'     => '',
    'ldifdomain'     => '',
    'perlmod'        => '',
    'serverobj'      => '',
    'userdbfullpath' => '/etc/',
    'userobj'        => '',
    'version'        => '',
    'webserver'      => '',
    'whoami'         => '',
    'wwwroot'        => $inRootDir,
    'wwwcgishl'      => '',
    'wwwsupp'        => '',
    'remote'         => 1,
    'userglob'       => '/home/*'
  );

  unless(defined($webconf))
  {
    print("Could not load configuration.<BR>\n") ;
    exit(0);
  }

  $computer = IISComputer->new( 'webconf' => $webconf ) ;

  # Write output.
  if(defined($computer))
  {
    $computer->write($webconf->{'webserver'});
    $computer->write_filelist($webconf->{'webserver'});
  }

  printFooter();
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to html encode strings
#
sub htmlEncode
{
  my $inString = $_[0];
  $inString =~ s/&/&\;/;
  $inString =~ s/>/>\;/;
  $inString =~ s/</<\;/;
  $inString =~ s/"/"\;/;
  return $inString;
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to return 1 (true) if the bitflag is set in the bitfield
#
sub isSet
{
  my $inBitField = $_[0];
  my $inBitMask = $_[1];
  return (($inBitField & $inBitMask) > 0);
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to write log entries
#
sub logMessage
{
  my $inErrorLevel = $_[0];
  my $inMessage = $_[1];


  my $theErrorLevel;

  if($inErrorLevel == $myLogNOTICE)
  {
    $theErrorLevel = 'NOTICE  ';
  }
  elsif($inErrorLevel == $myLogWARNING)
  {
    $theErrorLevel = 'WARNING ';
  }
  elsif($inErrorLevel == $myLogERROR)
  {
    $theErrorLevel = 'ERROR   ';
  }
  elsif($inErrorLevel == $myLogCONONLY)
  {
    $theErrorLevel = 'CONONLY ';
  }
  else
  {
    $theErrorLevel = 'UNKNOWN ';
  }


  my ($theSec, $theMin, $theHour, $theMDay, $theMon, $theYear, $theWDay, $theYDay, $theIsDst) = localtime(time);

  $theMon++;
  if($theYear > 99) { $theYear -= 100 };

  my $theAMPM = "AM";

  if($theHour > 12)
  {
    $theHour -= 12;
    $theAMPM = "PM";
  }

  if($theMin < 10) { $theMin = '0' . $theMin };
  if($theSec < 10) { $theSec = '0' . $theSec };

  my $theLogEntry = "$theErrorLevel $theMon/$theMDay/$theYear $theHour:$theMin:$theSec $theAMPM\t$inMessage\n";


  if('' ne $myLogFilepath)
  {
    open(LOGFILE, '>>' . $myLogFilepath);
    print LOGFILE $theLogEntry;
    close(LOGFILE);
  }


  my $theHTMLMessage = htmlEncode($inMessage);
  print STDOUT "$theHTMLMessage<BR>\n";

  if($inErrorLevel == $myLogERROR)
  {
    print STDOUT "Migration aborted.";
    exit(0);
  }
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to output to DIRS file
#
sub printDirs
{
  my $inDir = $_[0];
  my $inScriptDir = $_[1];
  my $inDocDir = $_[2];

  opendir(THEDIR, $inDir);
  my @theChildElements = readdir(THEDIR);
  closedir THEDIR;

  #$inDir =~ tr/[a-z]/[A-Z]/;
  if((index($inDir . '/', $inScriptDir) != 0) && (index($inDir, $inDocDir) != 0))
  {
    my $outDir = $inDir;
    $outDir =~ s/\//\\/g;
    $outDir = "\\Inetpub\\$myServerName$outDir";

    open(DIRSFILE, '>>' . $myTempDir . '/iismu.dirs');
    print DIRSFILE "$outDir\n";
    close(DIRSFILE);
  }

  foreach $theElement (@theChildElements)
  {
    my $theTestDir = $inDir . '/' . $theElement;

    if((-d $theTestDir) && ($theElement ne '.') && ($theElement ne '..'))
    {
      printDirs($theTestDir, $inScriptDir, $inDocDir);
    }
  }
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to output page footer text
#
sub printFooter
{
  print STDOUT '    </FONT>' . "\n\n";
  print STDOUT '    <SCRIPT LANGUAGE="JavaScript">' . "\n";
  print STDOUT '      window.parent.location = "' . $myBackURL . '";' . "\n";
  print STDOUT '    </SCRIPT>' . "\n";
  print STDOUT '  </BODY>' . "\n";
  print STDOUT '</HTML>' . "\n";
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to output page header text
#
sub printHeader
{
  print STDOUT '<HTML>' . "\n";
  print STDOUT '  <BODY BGCOLOR="#FFFFFF">' . "\n";
  print STDOUT '    <FONT FACE="Verdana" SIZE="2">' . "\n";
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to trim spaces off of a string
#
sub trim
{
  my $inString = $_[0];
  $inString =~ s/\s*$//;
  $inString =~ s/^\s*//;
  return $inString;
 }
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to convert a string to uppercase
#
sub ucase
{
  my $inString = $_[0];
  $inString =~ tr/a-z/A-Z/;
  return $inString;
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to URL decode a string
#
sub urlDecode
{
  my $inString = $_[0];
  $inString =~ tr/+/ /;
  $inString =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  $inString =~ tr/+/ /;
  $inString =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
  return $inString;
}
# --------------------------------------------------------------------------------


# --------------------------------------------------------------------------------
# Procedure to write data file header
#
sub writeIismuDataHeader
{
  my $theSec;
  my $theMin;
  my $theHour;
  my $theMDay;
  my $theMon;
  my $theYear;
  my $theWDay;
  my $theYDay;
  my $theIsDst;
  my $theAMPM;

  ($theSec, $theMin, $theHour, $theMDay, $theMon, $theYear, $theWDay, $theYDay, $theIsDst) = localtime(time);

  $theMon++;
  if($theYear > 99) { $theYear -= 100 };
  $theAMPM = "AM";

  if($theHour > 12)
  {
    $theHour -= 12;
    $theAMPM = "PM";
  }

  if($theMin < 10) { $theMin = '0' . $theMin };
  if($theSec < 10) { $theSec = '0' . $theSec };

  print IISMUDATA "#IIsMigrationDataStart\n";
  print IISMUDATA "###########################################################\n";
  print IISMUDATA "#\n";
  print IISMUDATA "# Microsoft IIS v.5 Migration Utility\n";
  print IISMUDATA "# $theMon/$theMDay/$theYear $theHour:$theMin:$theSec $theAMPM\n";
  print IISMUDATA "#\n";
  print IISMUDATA "###########################################################\n\n";
}

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


#############################################################################
#
# iisldif.pm
#
# Copyright (c) MicroCrafts Corporation, 1997
#
#  IIS 4.0 Resource Kit Migration Utilty Perl module - LDIF to NT
#  Resource Kit ADDUSERS module.
#
#############################################################################


#############################################################################
#
#   IIsLDIF
#
#############################################################################
package     IIsLDIF ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( _construct, write, dump ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;
    print( "NEW $class\n" ) if ( $IISCore::debug ) ;

    $self->{'name'}   = $params{'cn'} ;

    $self->_construct() ;

    return $self ;
}

sub _construct {
    my $self = shift ;
    print( "CONSTRUCT $self->{'class'}\n" ) if ( $IISCore::debug ) ;
    $self->dump() if ( $IISCore::debug ) ;
}

sub write {
    my $self = shift ;

    if ( $self->{'type'} eq 'user' ) {
        printf( "%s,%s,,%s,,,,\n",
               $self->{'uid'},
               $self->{'name'},
               $self->{'title'}
               ) ;
    } elsif ( $self->{'type'} eq 'local' ) {
        printf( "%s, %s", $self->{'name'}, $self->{'description'} ) ;
        @members = keys( %{$self->{'uniquemember'}} ) ;
        foreach $member ( sort @members ) {
            printf( "WHO %s\n", $self->{'user'}{'class'} ) ;
            printf( ",<<domain>>\\%s", $self->{'user'}{$member}{'uid'} ) ;
        }
        print( "\n" ) ;
    } elsif ( $self->{'type'} eq 'global' ) {
    } else {
        @content = keys( %$self ) ;
        foreach $key ( sort @content ) {
            if ( $key eq 'uniquemember' ) {
                @subcontent = keys( %{$self->{$key}} ) ;
                foreach $subkey ( sort @subcontent ) {
                    printf( "%s, ", $subkey ) ;
                }
                print( "\n" ) ;
            } else {
                printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
            }
        }
    }
}

sub dump {
    print( "dump()\n" ) ;
    $tab = "  " ;
    my $self = shift ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}

#############################################################################
#   !_IISLDIF_PM  NO CODE BEYOND THIS POINT
1 ;





#############################################################################
#
# iismucore.pm
#
# Copyright (c) MicroCrafts Corporation, 1997
#
#  IIS 4.0 Resource Kit Migration Utilty Perl module - core objects.
#
#############################################################################


#############################################################################
#
#   IISComputer
#
#############################################################################
package     IISComputer ;
use         Cwd ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( write, write_filelist, dump, writeServers ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;

    $self->{'class'} = $class ;
    bless $self, $class ;
    print( "NEW $class\n" ) if ( $IISCore::debug ) ;
    print( "INC @INC\n" ) if ( $IISCore::debug > 1 ) ;

    unless($params{'webconf'})
    {
      print( "No web configuration object\n" ) ;
      $@ = $!;
      return undef ;
    }

    $self->{'webconf'} = $params{'webconf'} ;
    $self->_construct() ;
    return $self ;
}

sub _construct
{
    my $self = shift ;
    print( "CONSTRUCT $self->{'class'}\n" ) if ( $IISCore::debug ) ;

    #
    # Sequence through all virtual servers, processing configuration file(s).
    #   vserver - hash indexed by virtual server name.
    #
    $webconf = $self->{'webconf'} ;
    $olddir = cwd() ;
    chdir( $webconf->{'fullpath'} ) or die( "Could not change to server root $webconf->{'fullpath'}\n" ) ;
    $n = 1;
    @filespec = $webconf->{'fileglob'} ;

    while ( <@filespec> ) {
        chomp( $_ ) ;

        print( "VSERVER <$_>\n" ) if ( $IISCore::debug ) ;
        $name = $_ ;
        # Create virtual server object(s).
        $obj = IISServer->new(
                              'name'      => $name,
                              'serverno'  => $n,
                              'path'      => $webconf->{'fullpath'} . $_,
                              'serverobj' => $webconf->{'serverobj'},
                              'webconf'   => $webconf,
                              ) ;
        if ( defined($obj) ) {
            $n++ ;
            $self->{'vserver'}{ $name } = $obj ;
            undef( $obj ) ;
        }
    }

    #
    # There may be processing at computer level required.
    #
    if ( $webconf->{'computerobj'} ) {
        $self->{'otherself'} = $webconf->{'computerobj'}->new( $self ) ;
    }

    #
    # Migrate user database.
    #

    # remove whitespace at the end
    $webconf->{'userdbfullpath'} =~ tr/\s*$//;

    if($webconf->{'userdbfullpath'})
    {
      $self->{'userdb'} = IISUserDb->new(
       'fullpath' => $webconf->{'userdbfullpath'},
       'userobj'  => $webconf->{'userobj'},
       'userglob' => $webconf->{'userglob'},
                                         );
    }

    #
    # Return to original directory.
    #
    chdir( $olddir ) ;
}

sub write
{
  my $self = shift;
  my $webserver = shift;
  $webconf = $self->{'webconf'};
  print( "WRITE $self->{'class'}\n" ) if ( $IISCore::debug );
  $file = $self->{'webconf'}->{'fileout'} . ".data" ;

  open( FILE, ">" . $file ) or die( "Could not open $file" ) ;
  select( FILE ) ;

  # Write file header.
  ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time) ;
  $mon++;
  if($year > 99) { $year -= 100 };
  $ampm = "AM";

  if($hour > 12)
  {
    $hour -= 12;
    $ampm = "PM";
  }


  print("#IIsMigrationDataStart\n" );
  print("###########################################################\n");
  print("#\n");
  print("# Microsoft IIS v.5 Migration Utility\n");
  print("# $mon/$mday/$year $hour:$min:$sec $ampm\n");
  print("#\n");
  print("###########################################################\n\n");

  $self->{'webconf'}->write();

  # Write W3SVC command
  print('VSERVICE ' . chr(127) . "W3SVC\n");
  print('VSET     ' . chr(127) . 'W3SVC' . chr(127) . 'KeyType' . chr(127) . "IIsWebService\n");
  print('VSET     ' . chr(127) . 'W3SVC' . chr(127) . 'AccessRead' . chr(127) . "True\n");
  print('VSET     ' . chr(127) . 'W3SVC' . chr(127) . 'EnableDefaultDoc' . chr(127) . "True\n");

  # Write each virtual server.
  foreach $key (sort(keys %{$self->{'vserver'}}))
  {
     $self->{'vserver'}{$key}->write() ;
  }

   print( "#IIsMigrationDataEnd\n");

  close( FILE ) ;
  select( STDOUT ) ;
  print( "Wrote $file <BR>\n" ) unless ( $self->{'webconf'}->{'remote'} ) ;

  # Write user database file
  if($webconf->{'userdbfullpath'})
  {
    $file = $self->{'webconf'}->{'fileout'} . ".users";

    if($self->{'userdb'})
    {
      $self->{'userdb'}->write( $webserver, $webconf->{'ldifdomain'}, $file ) ;
    }
  }
}

sub write_filelist
{
  my $self      = shift ;
  my $webserver = shift ;
  $webconf = $self->{'webconf'} ;
  print( "WRITEFILES $self->{'class'}\n" ) if ( $IISCore::debug ) ;
  $file = $self->{'webconf'}->{'fileout'} . ".files" ;

  open( FILE, ">" . $file ) or die( "Could not open $file" ) ;
  select( FILE ) ;

  # Add .data, .users files to the list
  print($topmain::myTempDir . "iismu.data\niismu.data\n");

  if(-e $topmain::myTempDir . "iismu.users")
  {
    print($topmain::myTempDir . "iismu.users\niismu.users\n");
  }

  if(-e $topmain::myLogFilepath)
  {
    print($topmain::myLogFilepath . "\niismu.log\n");
  }

  # Write each virtual server.
  foreach $key (keys %{$self->{'vserver'}})
  {
    $self->{'vserver'}{$key}->write_filelist();
  }

  if(-e $topmain::myScriptDir . 'iismu.dirs')
  {
    print($topmain::myScriptDir . "iismu.dirs\niismu.dirs\n");
  }

  close( FILE );
  select( STDOUT );
  print( "Wrote $file <BR>\n" ) unless ( $self->{'webconf'}->{'remote'} );
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}


sub writeServers
{
  my $self = shift;
  my $webserver = shift;
  $webconf = $self->{'webconf'};
  print( "WRITE $self->{'class'}\n" ) if ( $IISCore::debug );

  # Write each virtual server.
  foreach $key (sort(keys %{$self->{'vserver'}}))
  {
    print('<SERVER>');
    $self->{'vserver'}{$key}->writePath();
    print('</SERVER>');
  }
}

#############################################################################
#
#   IISService
#
#############################################################################
package     IISService ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( _construct, dump ) ;

sub new {

    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;
    print( "NEW $class\n" ) if ( $IISCore::debug ) ;

    $self->_construct() ;

    return $self ;
}

sub _construct
{
my $self = shift ;
    print( "CONSTRUCT $self->{'class'}\n" ) if ( $IISCore::debug ) ;
}

sub dump {
    my $self = shift ;
    topmain::dbgOut( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISServer
#
#############################################################################
package IISServer;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw( _construct, AddServerBinding, write, write_filelist, dump, writePath );


sub new
{
  my $class        = shift ;
  my %params       = @_ ;
  my $self         = {} ;
  $self->{'class'} = $class ;
  bless $self, $class ;
  topmain::dbgOut( "NEW $class" ) if ( $IISCore::debug ) ;

  $self->{'name'}      = $params{'name'};
  $self->{'path'}      = $params{'path'};
  $self->{'serverno'}  = $params{'serverno'};
  $self->{'serverobj'} = $params{'serverobj'};
  $self->{'webconf'}   = $params{'webconf'};

  $self->{'AccessFlags'}       = $topmain::accessDefault;
  $self->{'AllowKeepAlive'}    = '';
  $self->{'AuthFlags'}         = $topmain::authDefault;
  $self->{'CGITimeout'}        = '';
  $self->{'ConnectionTimeout'} = '900';
  $self->{'DefaultDoc'}        = '';
  $self->{'DefaultDocFooter'}  = '';
  $self->{'DirBrowseFlags'}    = $topmain::dirbrowDefault;
  $self->{'EnableDocFooter'}   = '';
  $self->{'EnableDirBrowsing'} = 'False';
  $self->{'HttpCustomHeaders'} = '';
  $self->{'HttpErrors'}        = '';
  $self->{'HttpRedirect'}      = '';
  $self->{'KeyType'}           = 'IIsWebServer';
  $self->{'MaxConnections'}    = '-1';
  $self->{'MimeMap'}           = '';
  $self->{'Realm'}             = '';
  $self->{'SecureBindings'}    = '';
  $self->{'UseHostName'}       = '';

  # Ask web server object to fill in our parameters.
  my $otherself = $self->{'serverobj'}->new( $self );
  $self->{'otherself'} = $otherself ;

  unless(defined($otherself))
  {
    undef( $self->{'otherself'});
    $@ = $!;
    return undef;
  }

  return $self;
}

sub _construct
{
  my $self = shift ;
  topmain::dbgOut( "CONSTRUCT $self->{'class'}($self->{'name'})" ) if ( $IISCore::debug ) ;

  # Complete processing of virtual directories ([0] := ROOT).
  # Home-page
  $self->{'vdir'}[0]->{'DefaultDoc'} = $self->{'DefaultDoc'} ;

  # Default document footer.
  $self->{'vdir'}[0]->{'DefaultDocFooter'}     = $self->{'DefaultDocFooter'} ;
  $self->{'vdir'}[0]->{'DefaultDocFooterType'} = $self->{'DefaultDocFooterType'} ;
  $self->{'vdir'}[0]->{'EnableDocFooter'}      = $self->{'EnableDocFooter'} ;

  # Directory browsing flags
  $self->{'vdir'}[0]->{'DirBrowseFlags'}       = $self->{'DirBrowseFlags'} ;

  $nvdir = scalar( @{$self->{'vdir'}} ) ;

  for($i = 0; $i < $nvdir ; $i++)
  {
    $self->{'vdir'}[$i]->_construct();
    $self->{'vdir'}[$i]->{'DefaultDoc'} = $self->{'DefaultDoc'};
    $self->{'vdir'}[$i]->{'DirBrowseFlags'} = $self->{'DirBrowseFlags'} ;
  }

  my $docdir = $self->{'vdir'}[0]->{'dir'} . '/iismu';

  if(-e $docdir)
  {
    $topmain::myDocDir = $docdir;
  }

  $self->dump() if ($IISCore::debug );
}

sub write
{
  my $self = shift ;

  if(! ($topmain::myServerSettings{$self->{'serverno'}} =~ /s=1/))
  {
    topmain::logMessage($topmain::myLogNOTICE, "Skipping settings for server: $self->{'serverno'}");
    return;
  }

  $pfx = "W3SVC/$self->{'serverno'}";
  # Create server.
  print('VSERVER  ' . chr(127) . $pfx . "\n");
  print('VSET     ' . chr(127) . $pfx . chr(127) . 'KeyType' . chr(127) . "IIsWebServer\n");
  print('VSET     ' . chr(127) . $pfx . chr(127) . 'AccessRead' . chr(127) . "True\n");
  print('VSET     ' . chr(127) . $pfx . chr(127) . 'EnableDefaultDoc' . chr(127) . "True\n");

  if('' ne $self->{'AllowKeepAlive'})
  {
    print('VSET     ' . chr(127) . $pfx . chr(127) . 'AllowKeepAlive' . chr(127) . $self->{'AllowKeepAlive'} . "\n");
  }

  print('VSET     ' . chr(127) . $pfx . chr(127) . 'ConnectionTimeout' . chr(127) . $self->{'ConnectionTimeout'} . "\n") if('' ne $self->{'ConnectionTimeout'});
  print('VSET     ' . chr(127) . $pfx . chr(127) . 'ServerComment' . chr(127) . $self->{'name'} . "\n");

  @theServerBindings = split(',', $self->{'ServerBindings'});

  for($i = 0; $i < scalar(@theServerBindings); $i++)
  {
    if('' ne @theServerBindings[$i])
    {
      print('VSET     ' . chr(127) . $pfx . chr(127) . 'ServerBindings' . chr(127) . @theServerBindings[$i] . "\n");
    }
  }

  if('' ne $self->{'IdentityCheck'})
  {
    print('VSET     ' . chr(127) . $pfx . chr(127) . 'LogExtFileUserName' . chr(127) . $self->{'IdentityCheck'} . "\n");
  }

  if('' ne $self->{'ListenBacklog'})
  {
    print('VSET     ' . chr(127) . $pfx . chr(127) . 'ServerListenBacklog' . chr(127) . $self->{'ListenBacklog'} . "\n");
  }


  print('VSET     ' . chr(127) . $pfx . chr(127) . 'MaxConnections' . chr(127) . $self->{'MaxConnections'} . "\n") if (('' ne $self->{'MaxConnections'}) && ('-1' ne $self->{'MaxConnections'}));
  print('VSET     ' . chr(127) . $pfx . chr(127) . 'EnableDirBrowsing' . chr(127) . "$self->{'EnableDirBrowsing'}\n");


  if('' ne $self->{'AccessExecute'})
  {
    print('VSET     ' . chr(127) . $pfx . chr(127) . 'AccessExecute' . chr(127) . "$self->{'AccessExecute'}\n");
  }

  if('' ne topmain::trim($self->{'HttpRedirect'}))
  {
    print('VSET     ' . chr(127) . $pfx . chr(127) . 'HttpRedirect' . chr(127) . "$self->{'HttpRedirect'}\n");
  }

  $nvdir = scalar( @{$self->{'vdir'}} ) ;

  # MimeMap can only be created *after* ROOT created by 'vdir' processing.
  $self->{'MimeMap'}->write( $pfx ) if ($self->{'MimeMap'});

  # Process virtual directories ([0] := ROOT).
  for($i = 0 ; $i < $nvdir; $i++ )
  {
    $self->{'vdir'}[$i]->write( $pfx );
  }
}

sub write_filelist
{
  my $self = shift ;
  if(! ($topmain::myServerSettings{$self->{'serverno'}} =~ /c=1/))
  {
    topmain::logMessage($topmain::myLogNOTICE, "Skipping content for server: skipping $self->{'serverno'}");
    return;
  }

  $pfx = "W3SVC/<<$self->{'serverno'}>>" ;
  $nvdir = scalar( @{$self->{'vdir'}} ) ;

  # Process virtual directories ([0] := ROOT).
  for ( $i = 0 ; $i < $nvdir ; $i++ ) {
      $self->{'vdir'}[$i]->write_filelist($pfx);
  }
}

sub AddServerBinding {
    my $self = shift ;
    my $addr = shift ;
    my $port = shift ;
    my $name = shift ;
    #my $oc = '[' ;
    #my $cd = ']' ;
    my $oc = ',';
    my $cd = '';

    topmain::dbgOut( "AddServerBinding( |$addr|$port|$name| )" ) if ( $IISCore::debug ) ;
    if ( $self->{'ServerBindings'} ) {
#        $comma = ',' ;
    } else {
        $comma = '' ;
    }
#    if ( !$self->{'ServerBindings'} ) {
        $self->{'ServerBindings'} = join( '', $self->{'ServerBindings'}, $comma,
                                         $oc,
                                         $addr, ':',
                                         $port, ':',
                                         $name,
                                         $cd
                                         ) ;
#    }
}

sub set {
    my $self = shift ;
    my $var  = shift ;
    my $val  = shift ;

    $self->{$var} = $val ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }

    $nvdir = scalar( @{$self->{'vdir'}} ) ;
    for ( $i = 0 ; $i < $nvdir ; $i++ ) {
        $self->{'vdir'}[$i]->dump() ;
    }
}


sub writePath
{
  #xyz
  my $self = shift;
  print '<ADSPATH>IIS://' . $ENV{'SERVER_NAME'} . '/W3SVC/' . $self->{'serverno'} . '</ADSPATH>';
  print '<PATH>' . $self->{'vdir'}[0]->{'dir'} . '</PATH>';
}

#############################################################################
#
#   IISVirtualDir
#
#############################################################################
package     IISVirtualDir ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( _construct, write, write_filelist, dump ) ;

sub new
{
  my $class        = shift ;
  my %params       = @_ ;
  my $self         = {} ;
  $self->{'class'} = $class ;

  bless $self, $class ;
  print( "NEW $class\n" ) if ($IISCore::debug);

  $self->{'dir'}  = $params{'dir'} ;
  $self->{'from'} = $params{'from'} ;
  $self->{'type'} = $params{'type'} ;
  $self->{'name'} = $params{'name'} ;

  # Default IIS Virtual Directory Object property values.
  $self->{'AccessFlags'}      = $topmain::accessDefault;
  $self->{'AuthFlags'}        = $topmain::authDefault;
  $self->{'DefaultDoc'}       = '' ;
  $self->{'DefaultDocFooter'} = '' ;
  $self->{'EnableDocFooter'}  = '' ;
  $self->{'DirBrowseFlags'}   = $topMain::dirbrowDefault;
  $self->{'KeyType'}          = 'IIsWebVirtualDir' ;
  return $self ;
}

sub _construct
{
  my $self = shift;
  print( "CONSTRUCT $self->{'class'}($self->{'name'})\n" ) if ( $IISCore::debug );
  $self->{'root'} = "ROOT$self->{'from'}";

  my($vdrive, $vpath ) = split( ':', $self->{'dir'});

  #$vdrive =~ tr/a-z/A-Z/;
  $self->{'vdrive'} = $vdrive;

  # $vpath =~ tr/\//\\/ ;       # Forward slash to backslash.
  $vpath =~ tr/\s*$//;
  $self->{'vpath'} = $vpath;

  my $checkvpath = $vpath;
  #$checkvpath =~ tr/a-z/A-Z/;
  $checkvpath = $self->{'vdrive'} . $checkvpath;

  my $scriptdir = $topmain::myScriptDir;
  #$scriptdir =~ tr/a-z/A-Z/;
  $scriptdir =~ tr/\s*$//;
  $scriptdir =~ s/\\$//;
  $self->{'scriptdir'} = $scriptdir;

  #my $docdir = $topmain::myDocDir;
  #$docdir =~ tr/a-z/A-Z/;
  #$docdir =~ tr/\s*$//;
  #$self->{'docdir'} = $docdir;

  #print("pfx:" . $pfx . '<BR>checkvpath:' . $checkvpath . '<BR>scriptdir:' . $scriptdir . '<BR>docdir'. $docdir . "\n");
  #print("***:" . index($checkvpath, $scriptdir) . "\n");

  my $skip = 0;

  # mask out our own stuff
  if((index($checkvpath, $scriptdir) == 0) || (index($checkvpath, $topmain::myDocDir) == 0))
  {
    $skip = 1;
  }

  $self->{'skip'} = $skip;

}

sub write
{
  if($self->{'skip'})
  {
    return;
  }
  #xyz
  my $self = shift ;
  my $pfx  = shift ;
  $vpath = $self->{'dir'};
  $vpath =~ s/^\\//;
  $vpath =~ tr/\s*$//;
  $vpath =~ tr/\//\\/;


  my $newpath = "Inetpub\\$topmain::myServerName$vpath";

  print('VCREATE  ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . $newpath . "\n");
  print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'KeyType' . chr(127) . "IIsWebVirtualDir\n");

  #print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'AuthFlags' . chr(127) . $self->{'AuthFlags'} . "\n");
  #print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'AccessFlags' . chr(127) . $self->{'AccessFlags'} . "\n");
  #print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'DirBrowseFlags' . chr(127) . $self->{'DirBrowseFlags'} . "\n");

  #IISCore::writeline('VSET     ', "$pfx/$self->{'root'} HttpErrors", $self->{'HttpErrors'}) if('' ne $self->{'HttpErrors'});

  my @theHttpErrors = split(']', $self->{'HttpErrors'});
  my $theHttpError;

  #xyz
  for($i = 0; $i < scalar(@theHttpErrors); $i++)
  {
    $theHttpError = topmain::trim($theHttpErrors[$i]);
    if(('' ne $theHttpError) && (index(topmain::ucase($theHttpError), "HTTP://") < 0))
    {
      $theHttpError = substr($theHttpError, 1);
      print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'HttpErrors' . chr(127) . $theHttpError . "\n");
    }
  }

  if('' ne $self->{'HostNameLookups'})
  {
    print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'EnableReverseDNS' . chr(127) . $self->{'HostNameLookups'} . "\n");
  }

  if('' ne $self->{'EnableDirBrowsing'})
  {
    print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'EnableDirBrowsing' . chr(127) . $self->{'EnableDirBrowsing'} . "\n");
  }

  if('' ne $self->{'AccessExecute'})
  {
    print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'AccessExecute' . chr(127) . $self->{'AccessExecute'} . "\n");
  }

    if('' ne $self->{'DefaultDoc'})
  {
    $vpath = $self->{'DefaultDoc'} ;
    # $vpath =~ tr/\//\\/ ;       # Forward slash to backslash.
    print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'EnableDefaultDoc' . chr(127) . "True\n");
    print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'DefaultDoc' . chr(127) . $vpath . "\n");
  }

  if($self->{'DefaultDocFooter'})
  {
    #$vfile = join
    #(
    #  '',
    #  ## $self->{'vddrive'},
    #  ## $self->{'vpath'},
    #  "/",
    #  $self->{'name'},
    #  "-docfooter."
    #);
    #
    #if($self->{'DefaultDocFooterType'} eq "text/html" )
    #{
    #  $vfile = join('', $vfile, "html" );
    #}
    #else
    #{
    #  $vfile = join( '', $vfile, "txt" ) ;
    #}
    #
    #$vfile =~ tr/\//\\/ ;   # Forward slash to backslash.
    #IISCore::writeline('VSET', "$pfx/$self->{'root'} DefaultDocFooter", $vfile);
    #IISCore::writeline('VSET', "$pfx/$self->{'root'} EnableDocFooter", "1");
  }

  if('' ne topmain::trim($self->{'HttpRedirect'}))
  {
    print('VSET     ' . chr(127) . "$pfx/$self->{'root'}" . chr(127) . 'HttpRedirect' . chr(127) . $self->{'HttpRedirect'} . "\n");
  }
}

sub write_filelist
{
  if($self->{'skip'})
  {
    return;
  }

  my $self = shift ;
  my $pfx  = shift ;

  #IISCore::writeline( 'VCREATE', "$pfx $self->{'root'}" ) ;
  $vpath = $self->{'vddrive'} . $self->{'vpath'} ;
  # $vpath =~ tr/\//\\/ ;       # Forward slash to backslash.
  #IISCore::writeline( 'VSET', "$pfx $self->{'root'} Path", $vpath ) ;

  # Create file copy list.
  use File::Find ;
  undef @vfilelist ;
  find( \&IISVirtualDir::vdir_wanted, $self->{'dir'} ) ;
  $len = length( $self->{'dir'} ) ;
  #IISCore::writeline( 'VFCOUNT', "$pfx $self->{'root'}", scalar(@vfilelist) ) ;
  $vdir_spec = $pfx . ' ' . $self->{'root'} ;

  my $checksrc;
  my $scriptdir = $self->{'scriptdir'};
  # my $docdir = $self->{'docdir'};

  topmain::printDirs($self->{'dir'}, $scriptdir, $topmain::myDocDir);

  for($i = 0; $i < scalar(@vfilelist); $i++ )
  {
    $src = $vfilelist[$i] ;
    # $src =~ tr/\//\\/ ;       # Forward slash to backslash.
    $src =~ tr/\s*$//;
    $checksrc = $src;
    #$checksrc =~ tr/a-z/A-Z/;

    if((index($checksrc, $topmain::myScriptDir) != 0) && (index($checksrc, $topmain::myDocDir) != 0))
    {
      $dst = substr($vfilelist[$i], $len) ;
      #$dst =~ tr/\//\\/ ;     # Forward slash to backslash.
      $self->write_copyfile($vdir_spec, $src, $dst);
    }
  }

  @content = keys ( %{$self->{'copyfile'}} ) ;
  foreach $key ( @content )
  {
    $self->write_copyfile( $vdir_spec, $key, $self->{'copyfile'}{$key} ) ;
  }

  # Document footer.
  if ( $self->{'DefaultDocFooter'} ) {
      $vfile = join(
                      '',
##                      $self->{'vddrive'},
##                      $self->{'vpath'},
                      "/",
                      $self->{'name'},
                      "-docfooter."
                      ) ;
        if ( $self->{'DefaultDocFooterType'} eq "text/html" ) {
            $vfile = join( '', $vfile, "html" ) ;
        } else {
            $vfile = join( '', $vfile, "txt" ) ;
        }
        # $vfile =~ tr/\//\\/ ;   # Forward slash to backslash.
        #IISCore::writeline( 'VFILE', "$pfx $vfile",  $self->{'DefaultDocFooter'} ) ;
    }
}


# --------------------------------------------------------------------------------
# Method to write statement to .files file
#
sub write_copyfile
{
  my $theSelf = shift;
  my $theVdirSpec = shift;
  my $theSource = shift;
  my $theDestination = shift;

  my $theNewDest = substr($theSource, index($theSource, "\\") + 1);
  $theNewDest =~ tr/\//\\/;

  print "$theSource\nInetpub\\$topmain::myServerName$theNewDest\n";
}
# --------------------------------------------------------------------------------


sub vdir_wanted {
    push( @vfilelist, $File::Find::name ) if -f ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISMimeMap
#
#############################################################################
package     IISMimeMap ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( write, dump ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;
    print( "NEW $class\n" ) if ( $IISCore::debug ) ;

    $self->{'MimeMap'}  = $params{'MimeMap'} ;
    $self->{'serverno'} = $params{'serverno'} ;
    $self->_construct() ;

    return $self ;
}

sub _construct {
    my $self = shift ;
    print( "CONSTRUCT $self->{'class'}\n" ) if ( $IISCore::debug ) ;
    $self->{'root'} = "ROOT" ;
}

sub write
{
  my $self = shift;
  my $pfx  = shift;

  if(! ($topmain::myServerSettings{$self->{'serverno'}} =~ /m=1/))
  {
    return;
  }

  topmain::logMessage($topmain::myLogNOTICE, "Migrating MIME types for server: $self->{'serverno'}");
  #xyz
  #IISCore::writeline( '#VCREATE', "$pfx $self->{'root'}" );

  my @theMimeTypes = split(']', $self->{'MimeMap'});

  foreach $theMimeType (@theMimeTypes)
  {
    $theMimeType = topmain::trim($theMimeType);
    $theMimeType = substr($theMimeType, 1);
    #$theMimeType =~ s/,/\x7f/;

    my @theTypeParts = split(',', $theMimeType);
    my $thePropertyData = $theTypeParts[1] . chr(127) . $theTypeParts[0];

    #IISCore::writeline( 'VSET', chr(127) . "$pfx/$self->{'root'}" . chr(127) . "MimeMap" . chr(127), $thePropertyData);
    IISCore::writeline( 'VSET', chr(127) . "$pfx" . chr(127) . "MimeMap" . chr(127), $thePropertyData);
  }
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISUserDb - NT Resource Kit 'addusers' migration object.
#
#############################################################################
package     IISUserDb ;
require     Exporter ;
#use         IIsLDIF ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( write, dump ) ;

sub new {
    use File::Basename ;
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;
    topmain::dbgOut( "NEW $class" ) if ( $IISCore::debug ) ;

    $self->{'fullpath'} = $params{'fullpath'} ;
#    $self->{'path'}     = $params{'path'} ;
#    $self->{'file'}     = $params{'file'} ;
    $self->{'userobj'}  = $params{'userobj'} ;
    $self->{'userglob'}  = $params{'userglob'} ;

    # Break path, filename into separate components from fullpath.
    $xpath = $self->{'fullpath'} ;
    $xpath =~ tr/\\/\// ;  # Backslash to Forward slash.
    ( $fname, $fpath, $fsfx ) = fileparse( $xpath ) ;
    $self->{'path'} = $fpath ;
    $self->{'file'} = $fname ;

    # Ask user database object to fill in our parameters.
    $self->{'userobj'}->new( $self ) ;

    return $self ;
}

sub _construct {
    my $self = shift ;
    topmain::dbgOut( "CONSTRUCT $self->{'class'}" ) if ( $IISCore::debug ) ;
}

sub write {
    my $self      = shift ;
    my $webserver = shift ;
    my $domain    = shift ;
    my $filename  = shift ;

    print( "WRITE $self->{'class'}\n" ) if ( $IISCore::debug ) ;

   #( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time) ;
   #$year += 1900 ;
   #$file = sprintf( "%s.%4d%02d%02d.users", $webserver, $year, $mon+1, $mday ) ;
    $file = $filename ;

    #
    # Write 'addusers' file.
    #
    open( FILE, ">" . $file ) or die( "Could not open $file" ) ;
    select( FILE ) ;

    print( "[User]\n" ) ;
    foreach $key ( keys %{$self->{'user'}} )
    {
      printf( "apu%s,%s,,%s,,,,\n",
        $self->{'user'}{$key}{'uid'},
        $self->{'user'}{$key}{'name'},
        $self->{'user'}{$key}{'title'}) ;
    }

    print( "\n" ) ;
    print( "[Global]\n" ) ;
    print( "\n" ) ;

    print( "[Local]\n" ) ;
    foreach $key ( keys %{$self->{'local'}} )
    {
      my $atLeastOne = 0;
      my $prefix = 'apg';

      printf( "%s%s,Group%s",
        $prefix,
        $self->{'local'}{$key}{'name'},
        $self->{'local'}{$key}{'description'}) ;

      @members = keys( %{$self->{'local'}{$key}{'uniquemember'}} ) ;

      foreach $member ( sort @members )
      {
        $atLeastOne = 1;
        #printf( ",$domain\\%s", $self->{'user'}{$member}{'uid'} ) ;
        printf( ",apu%s", $self->{'user'}{$member}{'uid'} ) ;
      }

      if(! $atLeastOne)
      {
        print ',';
      }

      print( "\n" ) ;
    }

    print( "\n" ) ;
    close( FILE ) ;
    select( STDOUT ) ;
}

sub dump {
    my $self = shift ;
    topmain::dbgOut( "dump($self->{'class'})" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
      topmain::dbgOut( sprintf("%s%-20s = %s", $tab, $key, $self->{$key}) ) ;
    }
}


#############################################################################
#
#   IISMuConf - Migration Utility web-server configuration.
#
#############################################################################
package     IISMuConf ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( addmacrodef, write, dump ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;
    print( "NEW $class\n" ) if ( $IISCore::debug );

    $self->{'fileglob'}       = $params{'fileglob'};
    $self->{'fileout'}        = $params{'tempdir'} . 'iismu';   # $params{'fileout'};
    $self->{'iiswwwroot'}     = $params{'iiswwwroot'};
    $self->{'ldifdomain'}     = $params{'ldifdomain'};
    $self->{'perlmod'}        = 'IISMuAP.pm';                   # $params{'perlmod'};
    $self->{'serverobj'}      = 'IISServerAP';                  # $params{'serverobj'};
    $self->{'userdbfullpath'} = $params{'userdbfullpath'};
    $self->{'userobj'}        = 'IISUserDbAP';                 # $params{'userobj'};
    $self->{'version'}        = '3.x';                          # $params{'version'};
    $self->{'webserver'}      = 'AP';                          # $params{'webserver'};
    $self->{'whoami'}         = 'Apache';   # $params{'whoami'};
    $self->{'wwwroot'}        = $params{'wwwroot'} ;
    $self->{'wwwcgishl'}      = $params{'wwwcgishl'};
    $self->{'wwwsupp'}        = $params{'wwwsupp'};
    $self->{'remote'}         = $params{'remote'};
    $self->{'userglob'}       = $params{'userglob'};
    $self->{'defaultdrive'}   = $params{'defaultdrive'};
    $self->{'computerobj'}    = 'IISComputerAP';               # $params{'computerobj'};

    $fpath = $self->{'wwwroot'} ;
    $fpath =~ tr/\\/\// ; # Backslash to Forward slash.
    if ( '/' ne substr($fpath, length($fpath)-1) ) {
        $fpath .= '/' ;
    }
    $self->{'fullpath'} = $fpath ;

    #
    # Save support directory on our INC path.
    push( @INC, $self->{'wwwsupp'} ) ;
    print( "INC @INC\n" ) if ( $IISCore::debug ) ;

    #
    # Verify key parameters.
    unless ( $self->{'wwwroot'} ) {
        print( "No 'wwwroot' in file $webserverconf\n" ) ;
        $@ = $! ;
        return undef ;
    }
    unless ( $self->{'serverobj'} ) {
        print( "No 'serverobj' in file $webserverconf\n" ) ;
        $@ = $! ;
        return undef ;
    }

    $self->dump() if ( $IISCore::debug ) ;

    return $self ;
}

sub write {
    my $self = shift ;

#    print( "#############################################\n" ) ;
#    printf( "#\n# IIS 4.0 Migration Wizard Scavenger %s\n", &IISCore::version() ) ;
#    print( "# $self->{'whoami'} $self->{'version'} Migration\n" ) ;
#    ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime(time) ;
#    $year += 1900 ;
#    printf( "# %4d-%02d-%02d %02d:%02d\n", $year, $mon+1, $mday, $hour, $min ) ;
#    print( "#\n#" ) ;
#    print( "#############################################\n\n" ) ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }

    @content = keys( %{$self->{'tokenmap'}} ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{'tokenmap'}{$key} ) ;
    }
}




#############################################################################
#
#   IISMigConf - IIS migration configuration.
#
#############################################################################
package     IISMigConf ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( dump ) ;

sub new {
    use Cwd ;
    use File::Basename ;

    my $class        = shift ;
#    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;
    print( "NEW $class\n" ) if ( $IISCore::debug ) ;

    #
    # Get web configuration file name.
    %webservers = (
                   'NE2' => 'iismine2.conf',
                   'NE3' => 'iismine3.conf',
                   ) ;

    $self->{'webserver'} = shift ;
    $self->{'webserver'} = uc( $self->{'webserver'} ) ;
    if ( !$self->{'webserver'} or !$webservers{$self->{'webserver'}} ) {
        $self->{'webserver'} = 'NE2' ;
    }
    $self->{'file'} = $webservers{$self->{'webserver'}} ;
    unless ( $self->{'file'} ) {
        print( "No web server configuration file for $self->{'webserver'}\n" ) ;
        $@ = $! ;
        return undef ;
    }

    #
    # Read file.
    open( FILE, $self->{'file'} ) or ( $@ = $!, return undef ) ;
    while ( <FILE> ) {
        next if /^\s*$/ ;
        next if /^#/ ;
        chomp( $_ ) ;
        ( $name, $value ) = split( /\s*=\s*/, $_ );
        $self->{$name} = $value ;
    }
    close( FILE ) ;

    #
    $curdir = cwd() ;
    ($curdrive) = split( ':', $curdir ) ;
    unless ( $self->{'sdir'} ) {
        $self->{'sdir'} = $curdrive . ":" ;
    }
#    $self->{'sdir'} = join( '', $self->{'sdir'}, ":" ) ;
    unless ( $self->{'ddir'} ) {
        $self->{'ddir'} = $curdrive ;
    }
#    $self->{'ddir'} = join( '', $self->{'ddir'}, ":/", $self->{'wwwroot'} ) ;
    $self->{'ddir'} = join( '', $self->{'ddir'}, $self->{'wwwroot'} ) ;
    unless ( $self->{'nserver'} ) {
        $self->{'nserver'} = '2' ;
    }

    $self->dump() if ( $IISCore::debug ) ;

    return $self ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'class'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISCore - utility functions.
#
#############################################################################
package     IISCore ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( expandmacros, setdebug, webserver, writeline) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'class'} = $class ;
    bless $self, $class ;

    return $self ;
}

#
# expandmacros
#   expand all macros '<<macro>>' in input string 'istr' using web
#   configuration's token map.
#
#   Numeric macros '<<n>>' are assumed to be virtual server instances.
#   The value 'nserver' is added by the macro processing to arrive at
#   the final virtual server instance value.
#
#
#   Returns expanded string or original string if no macros expanded.
#
sub expandmacros {
    my( $istr, $webconf ) = @_ ;
    my $ostr ;
    my $s1 ;
    my $s2 ;
    my $s3 ;
    my $i ;

    my @tokens = split( "<<", $istr ) ;
    $ostr = $tokens[0] ;
    for ( $i = 1 ; $i < scalar(@tokens) ; $i++ ) {
        ( $s1, $s2 ) = split( '>>', $tokens[$i] ) ;
        $s3 = lc( $s1 ) ;       # Macros are case-insensitive.
        if ( $webconf->{'tokenmap'}{$s3} ) {
            $s1 = $webconf->{'tokenmap'}{$s3} ;
        }
        # If this is a <<n>> macro, add virtual server base value.
        if ( ($s1 =~ /[0-9]+/) and !($s1 =~ /[a-z,A-Z]/) ) {
            $s1 += $webconf->{'tokenmap'}{'nserver'} + 1 ;
        }
        $ostr = join( '', $ostr, $s1, $s2 ) ;
    }

    print( "EXPANDED |$istr| -> |$ostr|\n" ) if ( $IISCore::debug ) ;
    return $ostr ;
}


#
# setdebug
#
sub setdebug {
    my( $dbf ) = @_ ;
    $IISCore::debug = $dbf ;
    print( "DEBUG = $IISCore::debug\n" ) if ( $IISCore::debug ) ;
}

#
# version
#
sub version {
    return sprintf( "1.0.4" ) ;
}

#
# writeline - Write a command line in intermediate file format.
#
sub writeline {
    my( $vcmd, $vpath, $vparm ) = @_ ;
    printf( "%-8s %s%s\n", $vcmd, $vpath, $vparm) ;
}

#

# sprintf_vstring - Return formatted string suitable for intermediate data file.
# String format is:
#   <string-size> <string>
#
sub sprintf_vstring {
    my ( $str ) = @_ ;
    return sprintf( "%d %s", length($str), $str ) ;
}

#############################################################################
#   !_IISMUCORE_PM  NO CODE BEYOND THIS POINT
1 ;



#############################################################################
#
# IISMuAP.pm
#
# Copyright (c) MicroCrafts Corporation, 1997
#
#  IIS 4.0 Resource Kit Migration Utilty Perl module for Netscape
#  Enterprise 2.x, SuiteSpot 3.x
#
#############################################################################


#############################################################################
#
#   IISComputerAP
#
#############################################################################
package     IISComputerAP ;
use         Cwd ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( dump ) ;

sub new
{
  my $class = shift;
  #my %params = @_;
  my $self = {};
  my $otherself = shift;

  $self->{'_AClass'} = $class;
  bless $self, $class ;
  topmain::dbgOut("NEW $class") if ($IISCore::debug );

  $self->_construct( $otherself );
  return $self;
}

sub _construct
{
  my ($self, $otherself) = @_;
  topmain::dbgOut( "CONSTRUCT $self->{'_AClass'} USING $otherself" ) if ( $IISCore::debug ) ;

  # For each virtual host, add a virtual server object.
  my @vservers = keys(%{$otherself->{'vserver'}});
  my $n = scalar( @vservers ) + 1;
  my $conf;
  my $confobj;
  my $content;
  my $key;
  my $vhost;
  my $vhosts;
  my $vsvr1;
  my $vsvr2;

  foreach $key (sort @vservers)
  {
    $vsvr1 = $otherself->{'vserver'}{$key} ;
    $vsvr2 = $vsvr1->{'otherself'};
    @content = keys(%{$vsvr2} );

    foreach $conf (sort @content)
    {
      if ( $vsvr2->{$conf} =~ m'iisconfap'i )
      {
        $confobj = $vsvr2->{$conf} ;
        @vhosts = keys( %{$confobj->{'VirtualHost'}} ) ;

        foreach $vhost ( sort @vhosts )
        {
          if ( defined($confobj->{'VirtualHost'}{$vhost}) )
          {
            $self->_addServer( $otherself, $confobj->{'VirtualHost'}{$vhost}, $n ) ;
            $n++ ;
          }
        }
      }
    }
  }
}


# 'VirtualHost' directive.
sub _addServer {
  my ( $self, $otherself, $conf, $n ) = @_ ;
    my $dirname = $conf->{'_AName'} ;
    topmain::dbgOut( "$self ::_addServer( $n, $dirname ) to $otherself" ) if ( $IISCore::debug ) ;
    my $path = $dirname ;
    if ( $dirname =~ m'/$' ) { #'
        chop( $dirname ) ;
    }
    if ( $path =~ m'/$' ) { #'
        chop( $path ) ;
    }

    my $vsvr = IISServer->new(
                              'name'      => $dirname,
                              'path'      => $path,
                              'serverno'  => $n,
                              'serverobj' => 'IISServerAPEx',
                              'webconf'   => $otherself->{'webconf'}
                              ) ;

    # ROOT virtual directory.
    # NB: [0] reserved for this server ROOT.
    my $rootdir = IISServerAP::_getProperty( $self, 'DocumentRoot', $conf ) ;
    if ( $rootdir =~ m'/$' ) { #'
        chop( $rootdir ) ;
    }
    my $newvdir = IISVirtualDir->new(
                                     'from' => '',
                                     'dir'  => $rootdir,
                                     'type' => '',
                                     'name' => $dirname
                                     ) ;
    IISServerAP::_fancyIndexing( $self, $vsvr, $conf ) ;
    $vsvr->{'DirBrowseFlags'} .= ' Enabled' if ( $vsvr->{'_fancyIndexing'} =~ m'on'i ) ;
    IISServerAP::_options( $self, $vsvr, $conf->{'Options'} ) ;
    @{$vsvr->{'vdir'}}[0] = $newvdir ;

    # Server bindings.
    #JAQ $vsvr->AddServerBinding( '', $conf->{'Port'}, $dirname ) ;
    IISServer::AddServerBinding( $vsvr, '', $conf->{'Port'}, $dirname ) ;
    IISServerAP::_serverBindings( $self, $vsvr, $conf ) ;

    # Alias (virtual directories).
    IISServerAP::_aliasVDir( $self, $vsvr, $conf ) ;

    # ScriptAlias (virtual directories).
    IISServerAP::_scriptAliasVDir( $self, $vsvr, $conf ) ;

    # Allow keep alive.
    IISServerAP::_keepAlive( $self, $vsvr, $conf ) ;
    #IISServerAP::_setProperty( $self, $vsvr, 'KeepAlive', 'AllowKeepAlive', $conf ) ;

    # Connection timeout.
    IISServerAP::_setProperty( $self, $vsvr, 'Timeout', 'ConnectionTimeout', $conf ) ;

    # Default document.
    IISServerAP::_defaultDoc( $self, $vsvr, $conf ) ;

    # Max connections.
    IISServerAP::_setProperty( $self, $vsvr, 'MaxClients', 'MaxConnections', $conf ) ;

    IISServerAP::_redirects($self, $vsvr, $conf);
    IISServerAP::_hostNameLookups($self, $vsvr, $conf);
    IISServerAP::_identityCheck($self, $vsvr, $conf);
    IISServerAP::_errorDocument($self, $vsvr, $conf);

    my $tc;
    if($conf->{'TypesConfig'})
    {
      $tc = $conf->{'TypesConfig'};
    }

    my $mimetypes = IISMimeMapAP->new('_AFile' => $tc,
      'serverno' => $vsvr->{'serverno'});

    # Server comment.
    $vsvr->{'ServerComment'} = $conf->{'ServerName'} if ( $conf->{'ServerName'} ) ;
    my $servercomment = IISServerAP::_getProperty( $self, 'User', $conf ) ;
    $vsvr->{'ServerComment'} = $servercomment unless $vsvr->{'ServerComment'} ;

    # Handle '<Directory>' directives.
    IISServerAP::_directory( $self, $vsvr, $conf, $rootdir ) ;

    # UserDir (virtual directories).
    IISServerAP::_userDir( $self, $vsvr, $conf ) ;

    IISServerAP::_mimeMap($self, $mimetypes, $conf);
    $mimetypes->_exportMimeTypes( $vsvr ) ;

    ##################################################
    #
    # NB: Must do - complete construction of objects
    #
    ##################################################
    #JAQ $vsvr->_construct() ;
    IISServer::_construct( $vsvr ) ;

    # Add to IISComputer object.
    $otherself->{'vserver'}{$n} = $vsvr ;
}


#############################################################################
#
#   IISServerAP
#
#############################################################################
package     IISServerAP ;
require     Exporter ;
use         Cwd ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( dump ) ;

sub new {
    my $class        = shift ;
#    my %params      = @_ ;
    my $self         = {} ;
    my $otherself    = shift ;
    $self->{'_AClass'} = $class ;
    bless $self, $class ;
    print( "NEW $class USING $otherself \n" ) if ( $IISCore::debug ) ;

    $rc = $self->_construct( $otherself ) ;

    unless ( defined($rc) ) {
        $@ = $!;
        return undef;
    }

    return $self ;
}

sub _construct
{
  my( $self, $otherself ) = @_ ;
    print( "CONSTRUCT $self->{'_AClass'} USING $otherself\n" ) if ( $IISCore::debug ) ;
    my $olddir = cwd() ;

    #
    # Parse configuration file(s).
    chdir( $otherself->{'path'} ) or return undef ;
    my $httpd    = IISConfAP->new( '_AFile' => 'httpd.conf' ) ;
    if ( !defined($httpd) ) {
        chdir( $olddir ) ;
        return undef ;
    }
    $self->_httpdDefaults( $httpd ) ;
    my $srm       = IISConfAP->new( '_AFile' => $httpd->{'ResourceConfig'} ) ;
    my $access    = IISConfAP->new( '_AFile' => $httpd->{'AccessConfig'} ) ;
    my $tc ;
    if ( $httpd->{'TypesConfig'} ) {
        $tc = $httpd->{'TypesConfig'} ;
    } elsif ( $srm->{'TypesConfig'} ) {
        $tc = $srm->{'TypesConfig'} ;
    } elsif ( $access->{'TypesConfig'} ) {
        $tc = $access->{'TypesConfig'} ;
    } else {
        $tc = 'mime.types' ;
    }
    my $mimetypes = IISMimeMapAP->new( '_AFile'   => $tc,
      'serverno' => $otherself->{'serverno'} ) ;

    $self->_srmDefaults( $srm ) ;

    # Directory browsing enable for entire server.
    $self->_fancyIndexing( $otherself, ($access, $httpd, $srm) ) ;
    $otherself->{'DirBrowseFlags'} .= ' Enabled' if ( $otherself->{'_fancyIndexing'} =~ m'on'i ) ;

    # Determine document root, giving preference to last 'conf' object in parameter list.
    my $rootdir = $self->_getProperty( 'DocumentRoot', $access, $httpd, $srm ) ;
    if ( $rootdir =~ m'/$' ) { #'
        chop( $rootdir ) ;
    }

    # ROOT virtual directory.
    # NB: [0] reserved for this server ROOT.
    my $rvdir = IISVirtualDir->new(
                                     'from' => '',
                                     'dir'  => $rootdir,
                                     'type' => '',
                                     'name' => $otherself->{'name'}
                                     ) ;
    $rvdir->{'DirBrowseFlags'} .= ' Enabled' if ( $otherself->{'_fancyIndexing'} =~ m'on'i ) ;
    @{$otherself->{'vdir'}}[0] = $rvdir ;

    # HostNameLookup
    $self->_hostNameLookups( $otherself, $access ) ;
    $self->_hostNameLookups( $otherself, $srm ) ;
    $self->_hostNameLookups( $otherself, $httpd ) ;

    # IdentityCheck
    $self->_identityCheck( $otherself, $access ) ;
    $self->_identityCheck( $otherself, $srm ) ;
    $self->_identityCheck( $otherself, $httpd ) ;

    # ListenBacklog
    $self->_listenBacklog( $otherself, $access ) ;
    $self->_listenBacklog( $otherself, $srm ) ;
    $self->_listenBacklog( $otherself, $httpd ) ;

    # Server bindings.
    $self->_serverBindings( $otherself, $access ) ;
    $self->_serverBindings( $otherself, $srm ) ;
    $self->_serverBindings( $otherself, $httpd ) ;

    # Alias (virtual directories).
    $self->_aliasVDir( $otherself, $access ) ;
    $self->_aliasVDir( $otherself, $httpd ) ;
    $self->_aliasVDir( $otherself, $srm ) ;

    # ScriptAlias (virtual directories).
    $self->_scriptAliasVDir( $otherself, $access ) ;
    $self->_scriptAliasVDir( $otherself, $httpd ) ;
    $self->_scriptAliasVDir( $otherself, $srm ) ;

    # Allow keep alive.
    $self->_keepAlive( $otherself, $access ) ;
    $self->_keepAlive( $otherself, $srm ) ;
    $self->_keepAlive( $otherself, $httpd ) ;

    # Connection timeout.
    $self->_setProperty( $otherself, 'Timeout', 'ConnectionTimeout', $access, $srm, $httpd ) ;

    # Default document.
    $self->_defaultDoc( $otherself, $access ) ;
    $self->_defaultDoc( $otherself, $httpd ) ;
    $self->_defaultDoc( $otherself, $srm ) ;

    # Default document.
    $self->_errorDocument($otherself, $access);
    $self->_errorDocument($otherself, $httpd);
    $self->_errorDocument($otherself, $srm);

    # Http Redirects
    $self->_redirects( $otherself, $access);
    $self->_redirects( $otherself, $http);
    $self->_redirects( $otherself, $srm);


    # Max connections.
    $self->_setProperty( $otherself, 'MaxClients', 'MaxConnections', $access, $srm, $httpd ) ;

    # Server comment.
    $self->_setProperty( $otherself, 'ServerName', 'ServerComment', $access, $srm, $httpd ) ;
    my $servercomment = $self->_getProperty( 'User', $access, $srm, $httpd ) ;
    $otherself->{'ServerComment'} = $servercomment unless $otherself->{'ServerComment'} ;

    # Mime maps.
    $self->_mimeMap( $mimetypes, $access ) ;
    $self->_mimeMap( $mimetypes, $httpd ) ;
    $self->_mimeMap( $mimetypes, $srm ) ;
    $mimetypes->_exportMimeTypes( $otherself ) ;

    $self->_options($otherself, $access->{'Options'});
    $self->_options($otherself, $httpd->{'Options'});
    $self->_options($otherself, $srm->{'Options'});

    # Handle '<Directory>' directives.
    $self->_directory( $otherself, $access, $rootdir ) ;
    $self->_directory( $otherself, $httpd, $rootdir ) ;
    $self->_directory( $otherself, $srm, $rootdir ) ;

    # UserDir (virtual directories).
    $self->_userDir( $otherself, $access, $httpd, $srm ) ;

    # Save parameters for later use.
    $self->{'_AAccess'}   = $access ;
    $self->{'_AHttpd'}    = $httpd ;
    $self->{'_AMimetype'} = $mimetypes ;
    $self->{'_ASrm'}      = $srm ;

    ##################################################
    #
    # NB: Must do - complete construction of objects
    #
    ##################################################
    $otherself->_construct() ;

    chdir( $olddir ) ;
}

######################################################

#
# 'HostNameLookups' directive
#
sub _hostNameLookups
{
  my ($self, $otherself, $obj ) = @_;
  my $theDirective = topmain::trim(topmain::ucase($obj->{'HostNameLookups'}));
  my $theValue = 'True';
  my $rvdir = $otherself->{'vdir'}[ 0 ] ;

  if($theDirective eq 'OFF')
  {
    $theValue = 'False';
  }

  $rvdir->{'HostNameLookups'} = $theValue;
}

#
# 'IdentityCheck' directive
#
sub _identityCheck
{
  my ($self, $otherself, $obj ) = @_;
  my $theDirective = topmain::trim(topmain::ucase($obj->{'IdentityCheck'}));

  if($theDirective eq 'ON')
  {
    $otherself->{'IdentityCheck'} = 'True';
  }
  elsif($theDirective eq 'OFF')
  {
    $otherself->{'IdentityCheck'} = 'False';
  }

}

#
# 'ListenBacklog' directive
#
sub _listenBacklog
{
  my ($self, $otherself, $obj ) = @_;
  my $theDirective = $obj->{'ListenBacklog'};
  my $theValue = '';
  my $rvdir = $otherself->{'vdir'}[ 0 ] ;

  if(($theDirective >= 5) && ($theDirective <= 500))
  {
    $theValue = $theDirective;
  }

  $otherself->{'ListenBacklog'} = $theValue;
}


#
# 'Redirect', 'RedirectTemp', 'RedirectPermanent' directives
#
sub _redirects
{
  my ($self, $otherself, $obj ) = @_;

  if($obj->{'redirects'})
  {
    for($i = 0 ; $i < scalar(@{$obj->{'redirects'}}) ; $i++)
    {
      my $redirect = $obj->{'redirects'}[$i];

      if('' ne $redirect)
      {
        my $theIndex = index($redirect, ' ');
        my $thePrefix = substr($redirect, 0, $theIndex);
        my $theSuffix = substr($redirect, $theIndex + 1);

        # Create virtual directory object.
        my $newvdir = IISVirtualDir->new(
          'from' => $thePrefix,
          'dir'  => '',
          'type' => $thePrefix,
          'name' => $otherself->{'name'});

        $newvdir->{'HttpRedirect'} = $theSuffix;
        push( @{$otherself->{'vdir'}}, $newvdir);
      }
    }
  }
}


#
# 'Alias' directive.
#
sub _aliasVDir {
    my ( $self, $otherself, $obj ) = @_ ;
    my $name ;
    my $path ;
    my $vdir ;

    if ( $obj->{'Alias'} ) {
        for ( $i = 0 ; $i < scalar(@{$obj->{'Alias'}}) ; $i++ ) {
            ( $name, $path ) = split( ' ', $obj->{'Alias'}[$i] ) ;
            # Paths should not have trailing.
            if ( $path =~ m'/$' ) { #'
                chop( $path ) ;
            }
            if ( $name =~ m'/$' ) { #'
                chop( $name ) ;
            }
            $vdir = IISVirtualDir->new(
                                       'from' => $name,
                                       'dir'  => $path,
                                       'type' => '',
                                       'name' => $otherself->{'name'}
                                       ) ;
            $vdir->{'DirBrowseFlags'} .= ' Enabled' if ( $otherself->{'_fancyIndexing'} =~ m'on'i ) ;
            push( @{$otherself->{'vdir'}}, $vdir ) ;
        }
    }
}

#
# 'DirectoryIndex' directive.
#
sub _defaultDoc {
    my ( $self, $otherself, $obj ) = @_ ;
    my $dd ;
    if ( $obj->{'DirectoryIndex'} ) {
        $dd = $otherself->{'DefaultDoc'} ;
        @spec = split( ' ', $obj->{'DirectoryIndex'} ) ;
        for ( $i = 0 ; $i < scalar(@spec) ; $i++ ) {
            if ( $dd ) {
                $dd .= "," . $spec[$i] ;
            } else {
                $dd = $spec[$i] ;
            }
        }
        $otherself->{'DefaultDoc'} = $dd if ( $dd ) ;
    }
}

#
# '<Directory x>' directive.
#
sub _directory {
    my ( $self, $otherself, $obj, $inRoot ) = @_ ;
    my $dir ;
    my $dirname, @dirnamex, $fromx ;
    my $dirs ;
    my $opt ;
    my $options ;
    my $vdir ;

    @dirs = keys( %{$obj->{'Directory'}} ) ;
    foreach $dir ( sort @dirs ) {
        if ( defined($obj->{'Directory'}{$dir}) ) {
            $dirname = $obj->{'Directory'}{$dir}->{'_AName'} ;
            @dirnamex = split('/', $dirname ) ;
            $fromx = '/' . $dirnamex[ scalar(@dirnamex) - 1 ] ;

            my $vdir;

            if($dir eq $inRoot)
            {
              $vdir = $otherself->{'vdir'}[ 0 ] ;
            }
            else
            {
              $vdir = $self->_getVDir( $otherself, $fromx ) ;
            }


            # If this directory is already defined as virtual directory,
            # merge directives with existing vdir.
            # Otherwise, create new virtual directory and set properties.
            if ( defined($vdir) )
            {
              $self->_options( $vdir, $obj->{'Directory'}{$dir}{'Options'} ) ;
              undef( $vdir ) ;
            }
            else
            {
                $vdir = IISVirtualDir->new(
                                           'from' => $fromx,
                                           'dir'  => $dirname,
                                           'type' => '',
                                           'name' => $otherself->{'name'}
                                           ) ;
                push( @{$otherself->{'vdir'}}, $vdir ) ;
                $self->_options( $vdir, $obj->{'Directory'}{$dir}{'Options'} ) ;
                undef( $vdir ) ;
            }
        }
    }
}

#
# 'ErrorDocument' directive.
#
sub _errorDocument
{
  my ($self, $otherself, $obj) = @_;
  my $rvdir = $otherself->{'vdir'}[0];
  my $i;
  my $errorcode;
  my $errorspec;

 if(defined($rvdir) and ($obj->{'ErrorDocument'}))
 {
    for($i = 0 ; $i < scalar(@{$obj->{'ErrorDocument'}}) ; $i++)
    {
      $line = $obj->{'ErrorDocument'}[$i];
      $line =~ /\s+/ ;    # Skip past first word and whitespace.
      $errorcode = $`;
      $errorspec = $';

      #$self->__addHttpError($otherself, $rvdir, $errorcode, $errorspec);
      IISServerAP::__addHttpError($self, $otherself, $rvdir, $errorcode, $errorspec);
    }
  }
}

sub __addHttpError
{
  my ($self, $otherself, $rvdir, $errorcode, $errorspec) = @_;
  my $od = '[' ;
  my $cd = ']' ;
  my $fnpfx = '' ;
  my $path ;
  my $fn ;
  my $fnx ;
  my $msgtype = 'URL' ;

  if($errorspec =~ m'http://'i)
  {
    $fnpfx   = '';
  }

  my $xlat = '';
  my $errcontent = '';

  $errspec = $errorspec;

  if($errspec =~ m'^"')
  {
    $errspec = '/error_' . $errorcode . '.html';
    $errcontent = $errorspec;
    $errcontent =~ s/\"//g;
    $errcontent =~ s/ /+/g;
  }


  $fn = $fnpfx . $errspec;
  $fn =~ tr/\\/\//;          # Backslash to Forward slash.

  if($fnpfx)
  {
    $path = $rvdir->{'dir'} . $fnpfx . $errspec;
    $path =~ s/\/\//\//g;
  }
  else
  {
    $path = '';
  }

  $fnx = $fn;
  $fnx =~ tr/\//\\/;         # Forward slash to backslash for NT.

  if(! $errcontent)
  {
    if($errorcode eq '401')
    {
      # Subcodes 1-5 all set to same error response.
      for($i = 1 ; $i <= 5 ; ++$i)
      {
        $xlat = join('', $xlat, $od, $errorcode, ',', $i, ',', $msgtype, ',', $fn, $cd, " ");
      }

      $rvdir->{'copyfile'}{$path} = $fn if ($path and !$errcontent);
    }
    elsif($errorcode eq '403')
    {
      # Subcodes 1-12 all set to same error response.
      for($i = 1 ; $i <= 12 ; ++$i)
      {
        $xlat = join('', $xlat, $od, $errorcode, ',', $i, ',', $msgtype, ',', $fn, $cd, " ");
     }

     $rvdir->{'copyfile'}{$path} = $fn if ($path and !$errcontent);
    }
    else
    {
      $xlat = join('', $xlat, $od, $errorcode, ',*,', $msgtype, ',', $fn, $cd, " ");
      $rvdir->{'copyfile'}{$path} = $fn if ( $path and !$errcontent );
    }

    $rvdir->{'HttpErrors'} .= $xlat;
  }
}

#
# 'FancyIndexing', 'IndexOptions FancyIndexing' directives.
#
sub _fancyIndexing {
    my ( $self, $otherself, @objlist ) = @_ ;
    my $obj ;
    my $i ;
    my $j ;

    $otherself->{'_fancyIndexing'} = 'off' ;
    for ( $i = 0 ; $i < scalar(@objlist) ; $i++ ) {
        $obj = $objlist[ $i ] ;
        if ( defined($obj) ) {
            $otherself->{'_fancyIndexing'} = $obj->{'FancyIndexing'} if ( $obj->{'FancyIndexing'} ) ;
            if ( $obj->{'IndexOptions'} ) {
                for ( $j = 0 ; $j < scalar(@{$obj->{'IndexOptions'}}) ; $j++ ) {
                    if ( $obj->{'IndexOptions'}[$j] =~ m'fancyindexing'i ) {
                        $otherself->{'_fancyIndexing'} = 'on' ;
                    }
                }
            }
        }
    }
}

#
# 'KeepAlive' directive.
#
sub _keepAlive {
    # Keep alive could be a number (v1.1) or on/off (v1.2+).  n = 0
    # indicates disabled, so we purposely skip matching on '0'.
    my ( $self, $otherself, $obj ) = @_ ;
    my $prop = 'False' ;
    if ( defined($obj) ) {
        $prop = 'True' if ( ($obj->{'KeepAlive'} =~ m'on'i)
                      or ($obj->{'KeepAlive'} =~ m'1|2|3|4|5|6|7|8|9')
                      ) ;
        $otherself->{'AllowKeepAlive'} = $prop ;
    }
}

#
# 'AddType' directive.
#
sub _mimeMap
{
  my ( $self, $mimeobj, $obj ) = @_ ;

  if(defined($mimeobj))
  {
    if ($obj->{'AddType'})
    {
      for($i = 0 ; $i < scalar(@{$obj->{'AddType'}}) ; $i++ )
      {
        $mimeobj->_addMimeType( $obj->{'AddType'}[$i] ) ;
      }
    }
  }
}

#
# 'Options' directive.
#
sub _options
{
  my ($self, $vobj, $opt) = @_;

  @options = split(' ', $opt);

  foreach $opt (sort @options)
  {
    if(($opt eq 'Indexes') or ($opt eq '+Indexes'))
    {
      $vobj->{'EnableDirBrowsing'} = 'True';
    }
    elsif(($opt eq 'ExecCGI') or ($opt eq '+ExecCGI'))
    {
      $vobj->{'AccessExecute'} = 'True';
    }
    elsif(($opt eq 'All') or ($opt eq '+All'))
    {
      $vobj->{'EnableDirBrowsing'} = 'True';
      $vobj->{'AccessExecute'} = 'True';
    }
    elsif($opt eq '-Indexes')
    {
      $vobj->{'EnableDirBrowsing'} = 'False';
    }
    elsif($opt eq '-ExecCGI')
    {
      $vobj->{'AccessExecute'} = 'False';
    }
    elsif($opt eq '-All')
    {
      $vobj->{'EnableDirBrowsing'} = 'False';
      $vobj->{'AccessExecute'} = 'False';
    }
  }
}

#
# 'ScriptAlias' directive.
#
sub _scriptAliasVDir {
    my ( $self, $otherself, $obj ) = @_ ;
    my $name ;
    my $path ;
    my $vdir ;

    if ( $obj->{'ScriptAlias'} ) {
        for ( $i = 0 ; $i < scalar(@{$obj->{'ScriptAlias'}}) ; $i++ ) {
            ( $name, $path ) = split( ' ', $obj->{'ScriptAlias'}[$i] ) ;
            if ( $path =~ m'/$' ) { #'
                chop( $path ) ;
            }
            if ( $name =~ m'/$' ) { #'
                chop( $name ) ;
            }
            $vdir = IISVirtualDir->new(
                                       'from' => $name,
                                       'dir'  => $path,
                                       'type' => '',
                                       'name' => $otherself->{'name'}
                                       ) ;
            $vdir->{'AccessFlags'}    .= ' Script Execute' ;
            $vdir->{'DirBrowseFlags'} .= ' Enabled' if ( $otherself->{'_fancyIndexing'} =~ m'on'i ) ;
            push( @{$otherself->{'vdir'}}, $vdir ) ;
        }
    }
}

#
# 'BindAddress', 'Listen', 'ServerAlias', 'NameVirtualHost' directives.
#
sub _serverBindings {
    my ( $self, $otherself, $obj ) = @_ ;
    my $ip, $port, @spec, $host ;

    # Server bindings syntax is <ip_address>, <port>, <name>
    $otherself->AddServerBinding( '', $obj->{'Port'}, '' ) if ( $obj->{'Port'} ) ;

    $ba = $obj->{'BindAddress'} ;
    if ( $ba and ($ba =~ m'[a-z]') ) {
        $otherself->AddServerBinding( '', '', $ba ) if ( $ba and ($ba ne '*') ) ;
    } else {
        $otherself->AddServerBinding( $ba, '', '' ) if ( $ba and ($ba ne '*') ) ;
    }

    if ( $obj->{'Listen'} ) {
        for ( $i = 0 ; $i < scalar(@{$obj->{'Listen'}}) ; $i++ ) {
            if ( $obj->{'Listen'}[$i] =~ m':' ) {
                ( $ip, $port ) = split( ':', $obj->{'Listen'}[$i] ) ;
            } else {
                # Port-only specification.
                $ip = '' ;
                $port = $obj->{'Listen'}[$i] ;
            }
            $otherself->AddServerBinding( $ip, $port, '' ) ;
        }
    }

    if ( $obj->{'ServerAlias'} ) {
        for ( $i = 0 ; $i < scalar(@{$obj->{'ServerAlias'}}) ; $i++ ) {
            @spec = split( ' ', $obj->{'ServerAlias'}[$i] ) ;
            foreach $host ( @spec ) {
                $otherself->AddServerBinding( '', $obj->{'Port'}, $host ) unless ( $host =~ m'\*|\?' ) ;
            }
        }
    }

    if ( $obj->{'NameVirtualHost'} ) {
        for ( $i = 0 ; $i < scalar(@{$obj->{'NameVirtualHost'}}) ; $i++ ) {
            ( $ip, $port ) = split( ':', $obj->{'NameVirtualHost'}[$i] ) ;
            $otherself->AddServerBinding( $ip, $port, '' ) ;
        }
    }
}

#
# 'UserDir' directive.
#
sub _userDir {
    my ( $self, $otherself, $obj1, $obj2, $obj3 ) = @_ ;
    my $i ;
    my $usr ;

    # Read/parse passwd file to translate user home directory to user
    # name.
    open( PFILE, '/etc/passwd' ) or die( "Could not open PASSWD\n" ) ;
    my %passwd ;
    while ( <PFILE> ) {
        chomp( $_ ) ;
        $line = $_ ;
        $line =~ m':' ;
        $usr = $` ;
        $line = $' ;
        @params = split( ':', $line ) ;
        $home = $params[ scalar(@params) - 2 ] ;
        $passwd{$home} = '/~' . $usr ;
    }
    close( PFILE ) ;

    # First combine all 'UserDir' directives into one (hash) list.
    # This has the added benefit of combining repeated directives
    # among the different '.conf' files.
    my @objlist ;
    @objlist = ( @objlist, @{$obj1->{'UserDir'}} ) if ( $obj1->{'UserDir'} ) ;
    @objlist = ( @objlist, @{$obj2->{'UserDir'}} ) if ( $obj2->{'UserDir'} ) ;
    @objlist = ( @objlist, @{$obj3->{'UserDir'}} ) if ( $obj3->{'UserDir'} ) ;
    for ( $i = 0 ; $i < scalar( @objlist ) ; $i++ ) {
        $self->{'userdir'}{$objlist[$i]} = 1 ;
    }
    my @userdir = sort( keys(%{$self->{'userdir'}}) ) ;

    # Create user list (prepend '~' for elements that don't have '/'
    # as their first character.
    my @users = split( ' ', $otherself->{'webconf'}->{'userglob'} ) ;
    my %usersaccess ;
    for ( $i = 0 ; $i < @users ; $i++ ) {
        if ( $users[$i] !~ m'^/' ) {
            $users[$i] = '~' . $users[$i] ;
        }
        $usersaccess{$users[$i]} = 1 ;
    }

    # Remove all users if global 'disabled' used.
    foreach $udir ( @userdir ) {
        if ( $udir =~ m'disabled'i ) {
            %usersaccess = () ;
            last ;
        }
    }
    # Include only users explicitly 'enabled'.
    foreach $udir ( @userdir ) {
        if ( $udir =~ m'enabled' ) {
            $udir =~ /\s+/ ;    # Skip past first word and whitespace.
            ( @userlist ) = split( ' ', $' ) ;
            foreach $usr ( @userlist ) {
                $usersaccess{$usr} = 1 ;
            }
        }
    }
    # Remove users explicitly 'disabled'.
    foreach $udir ( @userdir ) {
        if ( $udir =~ m'disabled' ) {
            $udir =~ /\s+/ ;    # Skip past first word and whitespace.
            ( @userlist ) = split( ' ', $' ) ;
            foreach $usr ( @userlist ) {
                delete( $usersaccess{$usr} ) ;
            }
        }
    }
    my %usersaccess1 ;
    foreach $key ( keys(%usersaccess) ) {
        if ( ($key !~ m'^/') and ($key !~ m'^~') ) {
            $key = '~' . $key ;
        }
        $usersaccess1{$key} = 1 ;
    }
    my %usersacc ;
    my @ua = keys( %usersaccess1 ) ;
    while ( <@ua> ) {
        $usersacc{$_} = 1 ;
    }

    # Prepend '~' for users that don't have '/'
    # as their first character.
    for ( $i = 0 ; $i < @users ; $i++ ) {
        if ( ($users[$i] !~ m'^/') and ($users[$i] !~ m'^~') ) {
            $users[$i] = '~' . $users[$i] ;
        }
    }
    # For each user, create a virtual directory for each UserDir spec.
    my $udir ;
    my $dirspec ;
    my $vdir ;

    while ( <@users> ) {
        chomp( $_ ) ;
        foreach $udir ( @userdir ) {
            if ( ($udir !~ m'enabled'i) and ($udir !~ m'disabled') ) {
                $dirspec = $_ . '/' . $udir ;
                if ( -d $dirspec and $passwd{$_} ) {
                    $vdir = IISVirtualDir->new(
                                               'from' => $passwd{$_},
                                               'dir'  => $dirspec,
                                               'type' => '',
                                               'name' => $otherself->{'name'}
                                               ) ;
                    push( @{$otherself->{'vdir'}}, $vdir ) ;
                }
            }
        }
    }
}

#
# _httpdDefaults - sets defaults values for directives if not already
#      set.  Call before other processing.
sub _httpdDefaults {
    my( $self, $conf ) = @_ ;
    if ( defined($conf) ) {
        $conf->{'KeepAlive'}  = 'on' unless ( $conf->{'KeepAlive'} ) ;
        $conf->{'MaxClients'} = 256 unless ( $conf->{'MaxClients'} ) ;
        $conf->{'Timeout'}    = 300 unless ( $conf->{'Timeout'} ) ;
    }
}

#
# _srmDefaults - sets defaults values for directives if not already
#      set.  Call before other processing.
sub _srmDefaults {
    my( $self, $conf ) = @_ ;
    if ( defined($conf) and (not $conf->{'UserDir'}) ) {
        push( @{$conf->{'UserDir'}}, 'public_html' ) ;
    }
}

#
# _getVDir
#
sub _getVDir {
    my ( $self, $otherself, $dirname ) = @_ ;
    my $i ;
    my $ndir ;
    my $vdir ;

    $ndir = scalar( @{$otherself->{'vdir'}} ) ;
    if ( $dirname =~ m'/$' ) { #'
        chop( $dirname ) ;
    }
    undef( $vdir ) ;
    # Search for virtual directory.
    for ( $i = 0 ; $i < $ndir and !defined($vdir) ; $i++ ) {
        if ( $dirname eq $otherself->{'vdir'}[$i]->{'from'} ) {
            $vdir = $otherself->{'vdir'}[$i] ;
            last ;
        }
    }

    return $vdir ;
}

#
# _getProperty
#
sub _getProperty {
    my ( $self, $src_prop, $obj1, $obj2, $obj3 ) = @_ ;

    $prop = $obj1->{$src_prop} if ( defined($obj1) and ($obj1->{$src_prop}) ) ;
    $prop = $obj2->{$src_prop} if ( defined($obj2) and ($obj2->{$src_prop}) ) ;
    $prop = $obj3->{$src_prop} if ( defined($obj3) and ($obj3->{$src_prop}) ) ;

    return $prop ;
}

#
# _setProperty
#
sub _setProperty {
    my ( $self, $otherself, $src_prop, $dst_prop, $obj1, $obj2, $obj3 ) = @_ ;
    my $prop ;

    $prop = $obj1->{$src_prop} if ( defined($obj1) and ($obj1->{$src_prop}) ) ;
    $prop = $obj2->{$src_prop} if ( defined($obj2) and ($obj2->{$src_prop}) ) ;
    $prop = $obj3->{$src_prop} if ( defined($obj3) and ($obj3->{$src_prop}) ) ;

    $otherself->{$dst_prop} = $prop if ( $prop ) ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'_AClass'})\n" ) ;
    $tab = " " ;
    $tabnum = $tablvl * length( $tab ) ;
    $fmt = "%" . $tabnum . "s%-20s = %s\n" ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( $fmt, $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISServerAPEx
#
#############################################################################
package     IISServerAPEx ;
require     Exporter ;
use         Cwd ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( dump ) ;

sub new {
    my $class        = shift ;
#    my %params      = @_ ;
    my $self         = {} ;
    my $otherself    = shift ;
    $self->{'_AClass'} = $class ;
    bless $self, $class ;
    topmain::dbgOut( "NEW $class USING $otherself" ) if ( $IISCore::debug ) ;

    $rc = $self->_construct( $otherself ) ;

    unless ( defined($rc) ) {
        $@ = $!;
        return undef;
    }

    return $self ;
}

sub _construct
{
  my ( $self, $otherself ) = @_ ;
    topmain::dbgOut( "CONSTRUCT $self->{'_AClass'} USING $otherself" ) if ( $IISCore::debug ) ;
    return $self ;
}


#############################################################################
#
#   IISConfAP
#       Apache '.conf' parsing object.
#
#############################################################################
package     IISConfAP ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( _construct, dump ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'_AClass'} = $class ;
    bless $self, $class ;

    $self->{'_AFile'} = $params{'_AFile'} ;
    print( "NEW $class, $self->{'_AFile'}\n" ) if ( $IISCore::debug ) ;

    my $line ;
    my $fullline ;

    open( FILE, $self->{'_AFile'} ) or ( $@ = $!, return undef ) ;

    # Special initialization for 'httpd.conf'
    if ( $self->{'_AFile'} eq 'httpd.conf' ) {
        $self->{'ResourceConfig'} = 'srm.conf' ;
        $self->{'AccessConfig'}   = 'access.conf' ;
#        $self->{'TypesConfig'}    = 'mime.types' ;
        $self->{'TypesConfig'}    = '' ;
    }

    my $obj ;
    undef( $obj ) ;
    while ( <FILE> ) {
        $fullline = $_ ;
        # Accumulate line if line-continuation encountered.
        while ( /\\$/ ) {
            $line = <FILE> ;
            $_ = $' . $line ;
            $fullline = join( '', $fulline, $line ) ;
            # Exit loop if we encounter EOF.
            last if ( $_ eq $' ) ;
        }

        # Skip blank and comment lines
        next if /^\s*$/ ;
        next if /^#/ ;

        if ( m'^<' and !m'^</' ) {
            # This is a nested directive object.
            # One of <Directory>, <Files>, <Limit>, <Location>, <VirtualHost>
            $obj = IISDirectiveObjAP->new( '_ALine' => $' ) ;
        } elsif ( defined($obj) ) {
            # Look for object terminator.
            if ( $obj->isTerminator($_) ) {
                # Add object to our hash.
                $self->{$obj->{'_AType'}}{$obj->{'_AName'}} = $obj ;
                undef( $obj ) ;
            } else {
                # Add directive to our current object.
                $self->_addDirective( $_, $obj ) ;
            }
        } else {
            # Add directive to top-level object.
            $self->_addDirective( $_, $self ) ;
        }

    }
    close( FILE ) ;
    $self->dump() if ( $IISCore::debug ) ;

    return $self ;
}

sub _addDirective
{
  my ($self, $line, $obj) = @_;

  chomp($line);

  # Split into name/value pairs
  ($name, $value) = /(\w+)\s+(.*)/;

  if($name eq 'AddEncoding'
    or $name eq 'AddHandler'
    or $name eq 'AddLanguage'
    or $name eq 'AddType'
    or $name eq 'Alias'
    or $name eq 'ErrorDocument'
    or $name eq 'IndexOptions'
    or $name eq 'Listen'
    #or $name eq 'Options'
    or $name eq 'NameVirtualHost'
    or $name eq 'ScriptAlias'
    or $name eq 'ServerAlias'
    or $name eq 'UserDir'
    or $name eq 'Redirect'
    or $name eq 'RedirectTemp'
    or $name eq 'RedirectPermanent')
  {
    if(index($name, 'Redirect') == 0)
    {
      $name = 'redirects';
    }

    push(@{$obj->{$name}}, $value );
  }
  else
  {
    $obj->{$name} = $value;
  }
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'_AClass'})\n" ) ;
    my $tab = "  " ;
    my $tablvl = 0 ;
    my $fmt = "%" . $tabnum . "s%-20s = %s\n" ;
    my @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}

sub rdump {
    my $self   = shift ;
    my $key    = shift ;
    my $tablvl = shift ;
    $tab = " " ;
    $tabnum = $tablvl * length( $tab ) ;
    $fmt = "%" . $tabnum . "s%-20s = %s\n" ;

    if ( $self->{$key} =~ m'hash'i ) {
        printf( $fmt, $tab, $key, $self->{$key} ) ;
        @content = keys( %{$self->{$key}} ) ;
        $tablvl++ ;
        foreach $subkey ( sort @content ) {
            $self->{$key}{$subkey}->dump() ;
        }
    } elsif ( $self->{$key} =~ m'array'i ) {
        printf( $fmt, $tab, $key, $self->{$key} ) ;
        for ( $i = 0 ; $i < scalar( @{$self->{$key}} ) ; $i++ ) {
            printf( $fmt, $tab, " ", $self->{$key}[$i] ) ;
        }
    } else {
        printf( $fmt, $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISDirectiveObjAP
#       Apache '.conf' directive object.
#
#############################################################################
package     IISDirectiveObjAP ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( isTerminator, dump ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'_AClass'} = $class ;
    bless $self, $class ;

    $self->{'_ALine'} = $params{'_ALine'} ;
    chomp( $self->{'_ALine'} ) ;
    print( "NEW $class, $self->{'_ALine'}\n" ) if ( $IISCore::debug ) ;

    my $line = $params{'_ALine'} ;
    chomp( $line ) ;
    $line =~ /\s+/ ;            # Skip past first word and whitespace.

    my $AType = $` ;
    #$AType =~ tr/[A-Z]/[a-z]/;
    $AType = topmain::ucase(substr($AType, 0, 1)) . substr($AType, 1);
    $self->{'_AType'} = $AType;

    $line = $' ;
    $line =~ s/>$// ;           # Get rid of final '>'
    $self->{'_AName'} = $line ;
    $self->dump() if ( $IISCore::debug ) ;

    return $self ;
}

sub isTerminator {
    my $self = shift ;
    my $line = shift ;

    return ( $line =~ /$self->{'_AType'}/i ) ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'_AClass'})\n" ) ;
    $tab = "  " ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( "%s%-20s = %s\n", $tab, $key, $self->{$key} ) ;
    }
}


#############################################################################
#
#   IISMimeMapAP
#       Apache 'mime.types' parsing object.
#
#############################################################################
package     IISMimeMapAP ;
require     Exporter ;
@ISA    = qw( Exporter ) ;
@EXPORT = qw( _addMimeType, _construct, _exportMimeTypes, dump ) ;

sub new {
    my $class        = shift ;
    my %params       = @_ ;
    my $self         = {} ;
    $self->{'_AClass'} = $class ;
    bless $self, $class ;

    $self->{'_AFile'}   = $params{'_AFile'} ;
    $self->{'serverno'} = $params{'serverno'} ;
    print( "NEW $class, $self->{'_AFile'}\n" ) if ( $IISCore::debug ) ;

    my $line ;
    my $exts ;
    my $fullline ;
    my $mimetype ;

    #open( FILE, $self->{'_AFile'} ) or ( $@ = $!, return undef)  ;
    open( FILE, $self->{'_AFile'} ) or return $self;

    while ( <FILE> ) {
        $fullline = $_ ;
        # Accumulate line if line-continuation encountered.
        while ( /\\$/ ) {
            $line = <FILE> ;
            $_ = $' . $line ;
            $fullline = join( '', $fulline, $line ) ;
            # Exit loop if we encounter EOF.
            last if ( $_ eq $' ) ;
        }

        # Skip blank and comment lines
        next if /^\s*$/ ;
        next if /^#/ ;

        # Add mime type to hash.
        chomp( $fulline ) ;
        $fullline =~ /\s+/ ;    # Skip past first word/whitespace
        $mimetype = $` ;        # First word is mime-type.
        $exts     = $' ;        # Remaining is extention(s).
        $exts =~ s/^\s*(.*?)\s*$/$1/ ; # Trim whitespace
        if ( $exts ) {
            $self->{'mimetype'}{$exts} = $mimetype ;
        }
    }
    close( FILE ) ;
    $self->dump() if ( $IISCore::debug ) ;

    return $self ;
}

sub _addMimeType {
    my $self = shift ;
    my $line = shift ;
    my $mimetype ;
    my $exts ;

    chomp( $line ) ;
    $line =~ /\s+/ ;            # Skip past first word/whitespace
    $mimetype = $` ;            # First word is mime-type.
    $exts     = $' ;            # Remaining is extention(s).
    $exts =~ s/\.//g ;          # Remove '.' from extensions.
    $exts =~ s/^\s*(.*?)\s*$/$1/ ; # Trim whitespace
    if ( $exts ) {
        $self->{'mimetype'}{$exts} = $mimetype ;
    }
}

sub _exportMimeTypes {
    my $self      = shift ;
    my $otherself = shift ;

    my $content ;
    my $ext ;
    my $exts ;
    my $mimetype ;
    my $mimemap ;
    my $key ;

    @content = keys( %{$self->{'mimetype'}} ) ;
    foreach $key ( sort @content ) {
        @exts = split( ' ', $key ) ;
        foreach $ext ( sort @exts ) {
            $mimetype = "[." . $ext . "," . $self->{'mimetype'}{$key} . "]" ;
            $mimemap .= $mimetype ;
        }
    }
    $otherself->{'MimeMap'} = IISMimeMap->new( 'MimeMap'  => $mimemap,
                                               'serverno' => $self->{'serverno'} ) ;
}

sub dump {
    my $self = shift ;
    print( "dump($self->{'_AClass'})\n" ) ;
    $tablvl = 0 ;
    $tab = "  " ;
    $tabnum = $tablvl * length( $tab ) ;
    $fmt = "%" . $tabnum . "s%-20s = %s\n" ;
    @content = keys( %$self ) ;
    foreach $key ( sort @content ) {
        printf( $fmt, $tab, $key, $self->{$key} ) ;
    }
    @content = keys( %{$self->{'mimetype'}} ) ;
    foreach $key ( sort @content ) {
        printf( $fmt, $tab, $key, $self->{'mimetype'}{$key} ) ;
    }
}


#############################################################################
#
#   IISUserDbAP - convert LDIF format to NT Resource Kit 'addusers'.
#
#############################################################################
package     IISUserDbAP ;
require     Exporter ;
use         Cwd ;
@ISA    = qw(