home *** CD-ROM | disk | FTP | other *** search
/ Chip: Windows 2000 Professional Resource Kit / W2KPRK.iso / apps / perl / ActivePerl.exe / data.z / MetabaseConfig.pm < prev    next >
Encoding:
Perl POD Document  |  1999-10-14  |  17.4 KB  |  520 lines
  1.     ######################################################
  2.  
  3.     # Company : ActiveState Tool Corp.
  4.     # Author  : James A. Snyder ( James@ActiveState.com )
  5.     # Date    : 7/11/98
  6.     # Copyright ⌐ 1998 ActiveState Tool Corp., all rights reserved.
  7.     #
  8.  
  9.     ######################################################
  10.  
  11.     # MetabaseConfig.pm
  12.  
  13.     package MetabaseConfig;
  14.     use Win32::OLE;
  15.     use strict;
  16.     eval('use Win32::Service;');
  17.     if(Win32::IsWinNT && $@) {
  18.         print $@;
  19.     }
  20.     
  21.     ######################################################
  22.  
  23.     # ScriptMap flags
  24.  
  25.     sub MD_SCRIPTMAPFLAG_SCRIPT_ENGINE{1};
  26.     sub MD_SCRIPTMAPFLAG_CHECK_PATH_INFO{4};
  27.  
  28.     ######################################################
  29.  
  30.     # Access Permission Flags
  31.  
  32.     sub MD_ACCESS_READ               { 0x00000001 }; #   // Allow for Read
  33.     sub MD_ACCESS_WRITE              { 0x00000002 }; #   // Allow for Write
  34.     sub MD_ACCESS_EXECUTE            { 0x00000004 }; #   // Allow for Execute
  35.     sub MD_ACCESS_SCRIPT             { 0x00000200 }; #   // Allow for Script execution
  36.     sub MD_ACCESS_NO_REMOTE_WRITE    { 0x00000400 }; #   // Local host access only
  37.     sub MD_ACCESS_NO_REMOTE_READ     { 0x00001000 }; #   // Local host access only
  38.     sub MD_ACCESS_NO_REMOTE_EXECUTE  { 0x00002000 }; #   // Local host access only
  39.     sub MD_ACCESS_NO_REMOTE_SCRIPT   { 0x00004000 }; #   // Local host access only
  40.  
  41.     
  42.     ######################################################
  43.     
  44.     $MetabaseConfig::LogObject = undef;
  45.  
  46.     # Set the reference to the Log object
  47.     
  48.     sub SetLogObject {
  49.         $MetabaseConfig::LogObject = shift;
  50.         if(!$MetabaseConfig::LogObject->isa("Log")) {
  51.             $MetabaseConfig::LogObject = undef;
  52.         }
  53.     }
  54.  
  55.  
  56.     $MetabaseConfig::StatusStarted = 4;
  57.     $MetabaseConfig::StatusStopped = 1;
  58.  
  59.  
  60.     sub StopIISAdmin {
  61.         my $output = `net stop IISAdmin /y`;
  62.         if($?) {
  63.             return "oops there was a problem stopping the IISAdmin service\n";
  64.         }
  65.  
  66.         $output = `net start`;
  67.         my @output = split($/, $output);
  68.         my $grep_results = grep(/IIS Admin Service/, @output);
  69.         if($grep_results) {
  70.             return "oops we thought we stopped the IISAdmin service when we didn't\n";
  71.         }
  72.  
  73. #        MetabaseConfig::StopService('W3SVC') || return "Error stopping the W3SVC service";
  74. #        MetabaseConfig::StopService('MSFTPSVC') || return "Error stopping the MSFTPSVC service";
  75. #        MetabaseConfig::StopService('IISADMIN') || return "Error stopping the IISADMIN service";
  76. #        my $result = `net stop IISADMIN /y`;
  77.     }
  78.  
  79.     sub StartIISAdmin {
  80.         MetabaseConfig::StartService('IISADMIN') || return "Error starting the IISADMIN service";
  81.         MetabaseConfig::StartService('W3SVC') || return "Error starting the W3SVC service";
  82.         MetabaseConfig::StartService('MSFTPSVC') || return "Error starting the MSFTPSVC service";
  83. #        my $result = `net start IISADMIN /y`;
  84. #        $result = `net start W3SVC /y`;
  85. #        $result = `net start MSFTPSVC /y`;
  86.     }
  87.     
  88.     ######################################################
  89.  
  90.     # StopIISAdmin();
  91.  
  92.     sub StopService {
  93.         my $service = shift;
  94.         my $status = {};
  95.         my $rv = Win32::Service::GetStatus('', $service, $status);
  96.         if(!$rv) {
  97.             print Win32::FormatMessage(Win32::GetLastError()), "\n";            
  98.             $MetabaseConfig::LogObject->ERROR("Could not GetStatus of $service service in first attempt MetabaseConfig::StopIISAdmin: $!") if $MetabaseConfig::LogObject;
  99.             return 1;
  100.         }
  101.  
  102.         if($status->{'CurrentState'} != $MetabaseConfig::StatusStopped) {
  103.             $rv = Win32::Service::StopService('', $service);
  104.             if(!$rv) {
  105.                 print Win32::FormatMessage(Win32::GetLastError()), "\n";            
  106.                 $MetabaseConfig::LogObject->ERROR("Could not stop $service service in MetabaseConfig::StopIISAdmin: $!") if $MetabaseConfig::LogObject;
  107.                 return $rv;
  108.             }
  109.  
  110.             while($status->{'CurrentState'} != $MetabaseConfig::StatusStopped) {
  111.                 sleep(10);
  112.                 $rv = Win32::Service::GetStatus('', $service, $status);
  113.                 if(!$rv) {
  114.                     print Win32::FormatMessage(Win32::GetLastError()), "\n";            
  115.                     $MetabaseConfig::LogObject->ERROR("Could not GetStatus of $service service in MetabaseConfig::StopIISAdmin: $!") if $MetabaseConfig::LogObject;
  116.                     return $rv;
  117.                 }
  118.             }
  119.         }
  120.  
  121.         $MetabaseConfig::LogObject->TRACE("$service service is stopped in MetabaseConfig::StopIISAdmin") if $MetabaseConfig::LogObject;
  122.         return 1;
  123.     }
  124.  
  125.     ######################################################
  126.  
  127.     # StartIISAdmin();
  128.     
  129.     sub StartService {
  130.         my $service = shift;
  131.         my $status = {};
  132.         my $rv = Win32::Service::GetStatus('', $service, $status);
  133.         if(!$rv) {
  134.             $MetabaseConfig::LogObject->ERROR("Could not GetStatus of $service service in first attempt MetabaseConfig::StartIISAdmin: $!") if $MetabaseConfig::LogObject;
  135.             return 1;
  136.         }
  137.  
  138.         if($status->{'CurrentState'} != $MetabaseConfig::StatusStarted) {
  139.             $rv = Win32::Service::StartService('', $service);
  140.             if(!$rv) {
  141.                 $MetabaseConfig::LogObject->ERROR("Could not start $service service in MetabaseConfig::StartIISAdmin: $!") if $MetabaseConfig::LogObject;
  142.                 return $rv;
  143.             }
  144.  
  145.             while($status->{'CurrentState'} != $MetabaseConfig::StatusStarted) {
  146.                 sleep(5);
  147.                 $rv = Win32::Service::GetStatus('', $service, $status);
  148.                 if(!$rv) {
  149.                     $MetabaseConfig::LogObject->ERROR("Could not GetStatus of $service service in MetabaseConfig::StartIISAdmin: $!") if $MetabaseConfig::LogObject;
  150.                     return $rv;
  151.                 }
  152.             }
  153.         }
  154.  
  155.         $MetabaseConfig::LogObject->TRACE("$service service is started in MetabaseConfig::StartIISAdmin") if $MetabaseConfig::LogObject;
  156.         return 1;
  157.     }
  158.  
  159.  
  160.     @MetabaseConfig::ServerStash = ();
  161.  
  162.     ######################################################
  163.  
  164.     # StashRunningServers()
  165.  
  166.     sub StashRunningServers {
  167.         my $index = 1;
  168.         my $path = 'IIS://localhost/W3SVC/';
  169.         my $testPath = $path . $index;
  170.         my $server;
  171.  
  172.         $MetabaseConfig::LogObject->TRACE("Stashing running web servers in MetabaseConfig::StashRunningServers") if $MetabaseConfig::LogObject;
  173.         while ( ($server = Win32::OLE->GetObject($testPath)) )
  174.         {
  175.             $MetabaseConfig::ServerStash[$index] = ($server->Status() == 2);
  176.             $index++;
  177.             $testPath = $path . $index;
  178.         }
  179.     }
  180.  
  181.     
  182.     ######################################################
  183.  
  184.     # StartStashedServers()
  185.  
  186.     sub StartStashedServers {
  187.         my $index = 1;
  188.         my $path = 'IIS://localhost/W3SVC/';
  189.         my $testPath = $path . $index;
  190.         my $server;
  191.         my $wasStarted;
  192.  
  193.         
  194.         $MetabaseConfig::LogObject->TRACE("Starting stashed web servers MetabaseConfig::StartStashedServers") if $MetabaseConfig::LogObject;
  195.         foreach $wasStarted (@MetabaseConfig::ServerStash) {
  196.             if($wasStarted == 1) {
  197.                 $server = Win32::OLE->GetObject($testPath);
  198.                 if(!$server) {
  199.                     $MetabaseConfig::LogObject->ERROR("Could not GetObject($testPath) in MetabaseConfig::StartStashedServers: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  200.                 } else {
  201.                     $server->Start();
  202.                 }
  203.             }
  204.             $index++;
  205.             $testPath = $path . $index;
  206.         }
  207.     }
  208.     
  209.     ######################################################
  210.     
  211.     # StartWWW( $dwWebServerID );
  212.  
  213.     sub StartWWW
  214.     {
  215.         my $serverID = $_[0];
  216.         my $path   = 'IIS://localhost/W3SVC/' . $serverID;
  217.         my $server =  Win32::OLE->GetObject($path);
  218.         $MetabaseConfig::LogObject->TRACE("Starting WWWServer: $path") if $MetabaseConfig::LogObject;
  219.         if(!$server) {
  220.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($path) in MetabaseConfig::StartWWW: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  221.             return undef;
  222.         }
  223.         $server->Start();
  224.     }
  225.  
  226.     ######################################################
  227.  
  228.     # StopWWW( $dwWebServerID );
  229.  
  230.     sub StopWWW
  231.     {
  232.         my $serverID = $_[0];
  233.         my $path   = 'IIS://localhost/W3SVC/' . $serverID;
  234.         my $server =  Win32::OLE->GetObject($path);
  235.         $MetabaseConfig::LogObject->TRACE("Stopping WWWServer: $path") if $MetabaseConfig::LogObject;
  236.         if(!$server) {
  237.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($path) in MetabaseConfig::StopWWW: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  238.             return undef;
  239.         }
  240.         $server->Stop();
  241.     }
  242.  
  243.     ######################################################
  244.  
  245.     # $arrayRef = EnumWebServers();
  246.  
  247.     sub EnumWebServers
  248.     {
  249.         my $index = 1;
  250.         my $path = 'IIS://localhost/W3SVC/';
  251.         my $testPath = $path . $index;
  252.         my $server;
  253.         my @webServers = ();
  254.  
  255.         while ( ($server=Win32::OLE->GetObject($testPath)) )
  256.         {
  257.             $webServers[$index] = $server->{ServerComment};
  258.             $index++;
  259.             $testPath = $path . $index;
  260.         }
  261.  
  262.         return \@webServers;
  263.     }
  264.  
  265.     ######################################################
  266.  
  267.     # GetFileExtMapping($dwServerID, $szVirDir, $szFileExt)
  268.  
  269.     sub GetFileExtMapping
  270.     {
  271.         if( @_ < 3 )
  272.         {
  273. #            die "Not enough Parameters for GetFileExtMapping()\n";
  274.         }
  275.  
  276.         my $server        = '';
  277.         my $szVirDirPath  = '';
  278.         my $dwServerID    = shift;
  279.         my $szVirDir      = shift;
  280.         my $szFileExt     = shift;
  281.         my $scriptMap      = '';
  282.  
  283.         # Create string that contains the Path to our Virutal directory or the WebServer's Root
  284.         $szVirDirPath = 'IIS://localhost/W3SVC/' . $dwServerID . '/ROOT';
  285.         $MetabaseConfig::LogObject->TRACE("Getting file extension mapping: $szFileExt") if $MetabaseConfig::LogObject;
  286.         if( length($szVirDir) )
  287.         {
  288.             $szVirDirPath = $szVirDirPath . "/" . $szVirDir;
  289.         }
  290.  
  291.         # Get the IIsVirtualDir Automation Object
  292.         $server = Win32::OLE->GetObject($szVirDirPath);
  293.         if(!$server) {
  294.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($szVirDirPath) in MetabaseConfig::GetFileExtMapping: " . Win32::OLE->LastError) if $MetabaseConfig::LogObject;
  295.             return;
  296.         }
  297.         
  298.         foreach $scriptMap (@{$server->{ScriptMaps}}) {
  299.             if($scriptMap =~ /^$szFileExt,/i) {
  300.                 return $scriptMap;
  301.             }
  302.         }
  303.     }
  304.  
  305.  
  306.     ######################################################
  307.  
  308.     # RemoveFileExtMapping($dwServerID, $szVirDir, $szFileExt)
  309.  
  310.     sub RemoveFileExtMapping
  311.     {
  312.         if( @_ < 3 )
  313.         {
  314. #            die "Not enough Parameters for AddFileExtMapping()\n";
  315.         }
  316.  
  317.         my $szVirDirPath    = '';
  318.         my @newScriptMap  = ();
  319.         my $dwServerID    = shift;
  320.         my $szVirDir      = shift;
  321.         my $szFileExt     = shift;
  322.         my $virDir;
  323.         my $ScriptMap      = '';
  324.  
  325.         if(GetFileExtMapping($dwServerID, $szVirDir, $szFileExt) eq '') {
  326.             return 1;
  327.         }
  328.  
  329.         # Create string that contains the Path to our Virutal directory or the WebServer's Root
  330.         $szVirDirPath = 'IIS://localhost/W3SVC/' . $dwServerID . '/ROOT';
  331.  
  332.         if( length($szVirDir) )
  333.         {
  334.             $szVirDirPath = $szVirDirPath . "/" . $szVirDir;
  335.         }
  336.  
  337.         # Get the IIsVirtualDir Automation Object
  338.         $virDir = Win32::OLE->GetObject($szVirDirPath);
  339.         if(!$virDir) {
  340.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($szVirDirPath) in MetabaseConfig::RemoveFileExtMapping: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  341.             return;
  342.         }
  343.         
  344.  
  345.         $MetabaseConfig::LogObject->TRACE("Removing file extension mapping: $szFileExt") if $MetabaseConfig::LogObject;
  346.         foreach $ScriptMap (@{$virDir->{ScriptMaps}}) {
  347.             if($ScriptMap !~ /^$szFileExt,/i) {
  348.                 push(@newScriptMap, $ScriptMap);
  349.             }
  350.         }
  351.  
  352.         # set the ScriptsMaps property to our new script map array
  353.         $virDir->{ScriptMaps} = \@newScriptMap;
  354.  
  355.         # Save the new script mappings
  356.         $virDir->SetInfo();
  357.     }
  358.  
  359.     ######################################################
  360.  
  361.     # AddFileExtMapping($dwServerID, $szVirDir, $szFileExt, $lpszExec, $dwFlags, $szMethodExclusions)
  362.  
  363.     sub AddFileExtMapping
  364.     {
  365.         if( @_ < 6 )
  366.         {
  367. #            die "Not enough Parameters for AddFileExtMapping()\n";
  368.         }
  369.  
  370.         my $server        = '';
  371.         my $szVirDirPath    = '';
  372.         my $scriptMapping = '';
  373.         my @newScriptMap  = ();
  374.         my $dwServerID    = shift;
  375.         my $szVirDir      = shift;
  376.         my $szFileExt     = shift;
  377.         my $szExecPath    = shift;
  378.         my $dwFlags       = shift;
  379.         my $szMethodExc   = shift;
  380.  
  381.         if(GetFileExtMapping($dwServerID, $szVirDir, $szFileExt) ne '') {
  382.             return 1;
  383.         }
  384.         
  385.         # Create string that contains the Path to our Virutal directory or the WebServer's Root
  386.         $szVirDirPath = 'IIS://localhost/W3SVC/' . $dwServerID . '/ROOT';
  387.         if( length($szVirDir) )
  388.         {
  389.             $szVirDirPath = $szVirDirPath . "/" . $szVirDir;
  390.         }
  391.         
  392.         # Get the IIsVirtualDir Automation Object
  393.         $server = Win32::OLE->GetObject($szVirDirPath);
  394.         if(!$server) {
  395.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($szVirDirPath) in MetabaseConfig::AddFileExtMapping: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  396.             return;
  397.         }
  398.         
  399.         # create our new script mapping entry
  400.         $scriptMapping = "$szFileExt,$szExecPath,$dwFlags";
  401.  
  402.         # make sure the length of szMethodExc is greater than 2 before adding szMethodExc to the script mapping
  403.         if( length($szMethodExc) > 2 )
  404.         {
  405.             $scriptMapping = $scriptMapping . ",$szMethodExc";
  406.         }
  407.  
  408.         $MetabaseConfig::LogObject->TRACE("Adding file extension mapping: $scriptMapping") if $MetabaseConfig::LogObject;
  409.         @newScriptMap = @{$server->{ScriptMaps}};
  410.         push(@newScriptMap, $scriptMapping);
  411.         
  412.         $server->{ScriptMaps} = \@newScriptMap;
  413.  
  414.         # Save the new script mappings
  415.         $server->SetInfo();
  416.     }
  417.  
  418.     ######################################################
  419.  
  420.     # CreateVirDir( $dwServerID, $szPath, $szName, $dwAccessPerm, $bEnableDirBrowse, $bAppRoot);
  421.  
  422.     sub CreateVirDir
  423.     {
  424.         if( @_ < 6 )
  425.         {
  426. #            die "Not enough Parameters for CreateVirDir()\n";
  427.         }
  428.  
  429.         # Local Variables
  430.         my $serverPath;
  431.         my $server;
  432.         my $virDir;
  433.         my $dwServerID       = shift;
  434.         my $szPath           = shift;
  435.         my $szName           = shift;
  436.         my $dwAccessPerm     = shift;
  437.         my $bEnableDirBrowse = shift;
  438.         my $bAppRoot         = shift;
  439.  
  440.  
  441.         if($szPath eq "" || $szName eq "")
  442.         {
  443.             die "Incorrect Parameter to CreateVirDir() ...\n";
  444.         }
  445.  
  446.         # Create string that contains the Path to our Webserver's Root
  447.         $serverPath = 'IIS://localhost/W3SVC/' . $dwServerID . '/Root';
  448.         $MetabaseConfig::LogObject->TRACE("Creating virtual directory: $szName") if $MetabaseConfig::LogObject;
  449.  
  450.         # Get the IIsWebServer Automation Object
  451.         $server = Win32::OLE->GetObject($serverPath);
  452.         if(!$server) {
  453.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($serverPath) in MetabaseConfig::CreateVirDir: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  454.             return;
  455.         }
  456.         
  457.  
  458.         # Create Our Virutual Directory or get it if it already exists
  459.         $virDir = $server->Create('IIsWebVirtualDir', $szName);
  460.         if( not UNIVERSAL::isa($virDir, 'Win32::OLE') )
  461.         {
  462.             $MetabaseConfig::LogObject->ERROR("Did not create IIsWebVirtualDir object in MetabaseConfig::CreateVirDir: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  463.             $virDir = $server->GetObject('IIsWebVirtualDir', $szName);
  464.             if(!$virDir) {
  465.                 $MetabaseConfig::LogObject->ERROR("Could not GetObject($szName) in MetabaseConfig::CreateVirDir: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  466.                 return;
  467.             }
  468.             
  469.         }
  470.  
  471.         $virDir->{Path}                  = $szPath;
  472.         $virDir->{AppFriendlyName}       = $szName;
  473.         $virDir->{EnableDirBrowsing}     = $bEnableDirBrowse;
  474.         $virDir->{AccessRead}            = $dwAccessPerm & MD_ACCESS_READ;
  475.         $virDir->{AccessWrite}           = $dwAccessPerm & MD_ACCESS_WRITE;
  476.         $virDir->{AccessExecute}         = $dwAccessPerm & MD_ACCESS_EXECUTE;
  477.         $virDir->{AccessScript}          = $dwAccessPerm & MD_ACCESS_SCRIPT;
  478.         $virDir->{AccessNoRemoteRead}    = $dwAccessPerm & MD_ACCESS_NO_REMOTE_READ;
  479.         $virDir->{AccessNoRemoteScript}  = $dwAccessPerm & MD_ACCESS_NO_REMOTE_SCRIPT;
  480.         $virDir->{AccessNoRemoteWrite}   = $dwAccessPerm & MD_ACCESS_NO_REMOTE_WRITE;
  481.         $virDir->{AccessNoRemoteExecute} = $dwAccessPerm & MD_ACCESS_NO_REMOTE_EXECUTE;
  482.  
  483.         $virDir->AppCreate($bAppRoot);
  484.         $virDir->SetInfo();
  485.     }
  486.  
  487.     ######################################################
  488.  
  489.     # DeleteVirDir( $dwServerID, $szVirDir );
  490.  
  491.     sub DeleteVirDir
  492.     {
  493.         my $dwServerID = $_[0];
  494.         my $szVirDir   = $_[1];
  495.         my $szPath     = '';
  496.         my $server     = '';
  497.  
  498.         if($dwServerID eq "" || $szVirDir eq "")
  499.         {
  500. #            die "Incorrect Parameter to DeleteVirDir() ...\n";
  501.         }
  502.  
  503.         # Create string that contains the Path to our Webserver's Root
  504.         $szPath = 'IIS://localhost/W3SVC/' . $dwServerID . '/Root';
  505.         $MetabaseConfig::LogObject->TRACE("Deleting virtual directory: $szPath") if $MetabaseConfig::LogObject;
  506.         
  507.         # Get the IIsWebServer Automation Object
  508.         $server = Win32::OLE->GetObject($szPath);
  509.         if(!$server) {
  510.             $MetabaseConfig::LogObject->ERROR("Could not GetObject($szPath) in MetabaseConfig::DeleteVirDir: " . Win32::OLE->LastError()) if $MetabaseConfig::LogObject;
  511.             return;
  512.         }
  513.         
  514.         $server->Delete( "IIsWebVirtualDir", $szVirDir );
  515.         $server->SetInfo();
  516.     }
  517.  
  518.  
  519. 1;
  520.