#!/bin/sh

# fpinst.sh - Zeus Frontpage installation script

# Ensure ZEUSHOME is setup to point to our 3.3 installation

if [ -z "$ZEUSHOME" ]
then
    # Have a good guess, we live in $ZEUSHOME/webadmin/bin
    OLD_PWD=`pwd`
    cd `dirname $0`/../..
    ZEUSHOME=`pwd`
    export ZEUSHOME
    cd $OLD_PWD

fi

if [ ! -d "$ZEUSHOME/webadmin" ]
then
  echo 'FATAL: $ZEUSHOME is not set, or is set incorrectly'
  echo 'It should point to the Zeus installation running the adminserver'
  exit 1
fi

exec $ZEUSHOME/perl/miniperl -w -x $0 ${1+"$@"}










##########################################################################
#!perl -w

# Perl

BEGIN {
$fp_dir = "/usr/local/frontpage";
@INC=( "$ENV{ZEUSHOME}/perl/", "$ENV{ZEUSHOME}/admin/etc", "$ENV{ZEUSHOME}/webadmin/etc" );
$ENV{PATH} = "$ENV{ZEUSHOME}/webadmin/bin:$ENV{ZEUSHOME}/web/bin:$fp_dir/currentversion/bin:$ENV{PATH}";
}

use ZConfig;
use ZeusOS;

if ( ! defined $ZeusOS::O_WRONLY ) {
   print STDERR <<'HERE';

Required constants not defined.

You must use this script with a >=3.3.6 version of $ZEUSHOME/perl/ZeusOS.pm

HERE
}


( $O_WRONLY,         $O_CREAT,         $O_TRUNC         ) =
( $ZeusOS::O_WRONLY, $ZeusOS::O_CREAT, $ZeusOS::O_TRUNC );


$| = 1;    # non-buffered STDOUT












$banner = <<'HERE';

*****************************************
Zeus Technology - Express FrontPage Setup
Copyright (C) - Zeus Technology, 2000
Updated to work with FrontPage 2000.
*****************************************

See --help or the Zeus Documentation System
for more information.

Ctrl-c     to quit
?<Return>  at any prompt for help

HERE

$banner_done = 0;

# HELP documentation

$mainhelp = <<'HERE';

fpinst.sh -- Zeus virtual server Frontpage support installation script

Prior to installation install the Frontpage binaries and
enable the 'frontpage' and 'htaccess' modules.

Without arguments this script will take you through an interactive
installation process.

On the command line fpinst.sh accepts the following flags:

fpinst.sh [ -h | --help [ <topic> ] ]
          [ [ --install ]
            --vs=<Zeus virtual server>
            --admin=<Frontpage administrator name>
            --password=<password for same>
            [ --user=<Unix user name>
              --group=<Unix group name> ]
            [ --subserver=<mass hosting site name> ]
            [ --path=<custom subserver path> ]
            [ --realm=<authentification realm> ]
            [ --nofollow ]
            [ --nofix ]
          ]
  or concisely
          [ -V <Zeus virtual server>
            -A <Frontpage administrator name>
            -P <password for same>
            -U <Unix user name>
            -G <Unix group name>
            [ -S <mass hosting site name> ]
          ]

See 'fpinst.sh --help install' for further installation instructions
 or 'fpinst.sh --help topics' for a list of the available help
 or 'fpinst.sh --help scripting' for information on scripting

For more information see the Frontpage module documentation in the
webserver documentation system.

HERE

$help->{topics} = <<'HERE';

  install              Installation
  upgrade              Upgrade Frontpage extensions on a web
  deinstall            Remove configuration from /usr/local/frontpage/zeus
  check                Check that a web will work / problem diagnosis

  admin                Administrator username
  password             Administrator password
  user                 Unix user
  group                Unix group
  virtualservers       Virtual servers
  subservers           Mass hosting and subservers
  realm                Change the authentification realm
  htaccess             Difficulties with .htaccess files
  nofollow             Symlink following behaviour 
  nofix                Only warn about problems, do not fix them
  path                 Custom subserver hash function

  
HERE

$help->{topic} = "##topics";

$help->{install} = <<'HERE';

To install frontpage extensions, firstly ensure you have installed
the Frontpage binaries which are available from ftp.microsoft.com.

Running 'fpinst.sh' will lead you through installing the extensions
on a hosting site. You will need to do this as the root user. 
This method will give you verbose help throughout the process.

fpinst.sh can also be used with command line options suitable.

Used in this way it can easily be integrated into the management
interface of mass hosting enviroments.

e.g. ./fpinst.sh --vs=test    --admin=admin --password=mypass \
                 --user=cust1 --group=customers

For subserver installations specify the subserver hostname with:
  
                --subserver=mysite.customer.com

HERE


$prompt{passwd} = <<'HERE';

This password is used with the user name above to provide
access control to this Frontpage web.

Users will be prompted for this password when publishing.

It is not directly associated with any operating system
or Zeus server account, and should not be. This is the 
password you will give to your customer or web designers.

HERE

$help->{passwd} = $prompt{passwd};
$help->{password} = "##passwd";

$help->{user} = <<'HERE';

This is the user name of the user owning this root web.
All uploaded files etc. will be stored as this user.

Installation files will be created in the target document
root of the Frontpage web as this user.

The Frontpage CGI interface through which the user will
modify these will be running as this user. Running CGI
applications as root is explicitly denied at runtime.

The %s files will be owned by root.

HERE
  
$help->{user} = sprintf( $help->{user}, $fp_dir );

$help->{xuser} = "##user";
$help->{username} = "##user";

$help->{group} = <<'HERE';

Files will be created in the target document root of this
Frontpage web in this group. Some of these files will need
to be writable by the Frontpage CGI scripts.

HERE

$help->{xgroup} = "##group";
$help->{groupname} = "##group";

$help->{admin} = <<'HERE';

This will be the user name used to access the root web of this
Frontpage account as an administrator through your Frontpage
client.

This is not related to any operating system accounts or
accounts used to administer your Zeus servers. 

The user name could be any appropriate word.

e.g. "admin", "Administrator", "myweb" or "george".

HERE

$help->{adminuser} = "##admin";

$help->{vserver} = <<'HERE';

Enter the name for the virtual server that you wish to add
Frontpage support to. This is the short name that appears
on the traffic light page.

If you are adding Frontpage support to a subserver enter the
name of its parent virtual server here. You will be prompted
for the subserver hostname later.

HERE

$help->{server} = "##vserver";
$help->{virtualserver} = "##vserver";
$help->{vs} = "##vserver";

$help->{subserver} = <<'HERE';

Subservers are a method of easily hosting large numbers of
identically configured sites efficiently. If a virtual server
is configured to use the 'subserver' module it will calculate
the document root of a requested site as a function of the
hostname, according to the selected scheme. These subserver
document roots are created relative to the base docroot of that
virtual server.

To use this script with subservers simply give the hostname
of the subserver in addition to the virtual server name and
the relevant files will be set up. 

e.g. --subserver=host1.isp.com or -S www.mysite.co.uk

If the specified subserver does not exist you will need to
create a document root directory for it according to the
chosen layout.

e.g. mkdir /www/p/www.mysite.com or
     mkdir /www/fp/m/y/www.mysite.com 

See the subserver documentation for more details

HERE

$help->{subservers} = "##subserver";
$help->{hostname} = "##subserver";
$help->{site} = "##subserver";
$help->{sites} = "##subserver";
$help->{sitename} = "##subserver";

$help->{path} = <<'HERE';

This option is for situations where a custom subserver hashing
function is being used. The path of a subserver document root
relative to the virtual server document root can be specified.

This is only necessary with and only works with custom hash functions

e.g. --path=home3/a2/fG/7y/mysite

HERE

$help->{htaccess} = <<'HERE';

The Frontpage installation will usually overwrite an existing
.htaccess file in the document root. 

To try to limit the damage caused, we back up this .htaccess file to 
htaccess.old(num) before running the Microsoft fpsrvadm.exe utility. 

If fpsrvadm.exe encounters .htaccess files that it identifies as not
belonging to Frontpage it, currently, exits without changing them.


HERE

$help->{'.htaccess'} = "##htaccess";

$help->{'links'} = <<'HERE';
$help->{'symlinks'} = "##links";
$help->{'nofollow'} = "##links";

Frontpage does not follow symbolic links outside the "Root Web".
This includes the directory itself. 

If you are using Frontpage 4.0, one option is to enable the
"FollowSymLinks" configuration setting ( See Frontpage documentation )

Otherwise the document root specifed in /usr/local/frontpage/*.cnf
has to be a plain directory.

This script will follow a symbolically linked document root one level
by default and pass Frontpage the name of the target.

To suppress this behaviour specify --nofollow 

HERE

$help->{'deinstall'} = <<'HERE';

Use the --deinstall flag to disable a Frontpage extension installation.

This does not remove _vti_bin, _private etc ... so no information will be lost
and the site will continue to function and be visible. The Frontpage configuration
file
   
   /usr/local/frontpage/host:port.cnf

will also be left, along with any alterations you have made.

The only change is that the "fake" configuration files in

   /usr/local/frontpage/zeus/
  
are removed.

The result of this is that the owner of the site will no longer be
able to publish to the site.

HERE

$help->{upgrade} = <<'HERE';

Upgrading will reinstall everything except the FrontPage
username and password.

Frontpage admin program is rerun with the '-o upgrade' option
rather than '-o install'

Required information is the name of the virtual server and the
name of the subserver, is applicable.

Any omissions will be prompted for.

HERE
$help->{upgrading} = "##upgrade";


$help->{scripting} = <<'HERE';

This script can easily be used for scripting using the
command line arguments.

When used  non-interactively ( i.e. when it is not attached
to a terminal ) no prompting occurs.

If insufficient or inaccurate information is given it will
instead exit with a non-zero value and an error message.

HERE

$help->{check} = <<'HERE';

Individual Frontpage installations can be checked using
the --check option.

You will require the virtual server name and the subserver
name, if appropriate.

HERE

# EOF HELP Documentation

# Other messages inline





















# What are we doing .....

# For fpsrvadm we require

# system( 'fpsrvadm.exe', '-o', 'install', '-p', "$port", '-s', "$srmconf", '-u', "$admin", '-pw', "$passwd", '-type', 'apache-fp', '-xUser', "$xuser", '-xGroup', "$xgroup", '-multihost', "$subserver" );

$port = "";
$subserver = "";
$srmconf = "";
$admin = "";
$passwd = "";
$xuser = "";
$xgroup = "";

# makes /usr/local/frontpage/*.cnf

# to build our fake config files ( to keep fp happy )

# mkdir /usr/local/frontpage/zeus/$fpservername

# cat > /usr/local/frontpage/zeus/$fpservername/srm.conf
#DocumentRoot $docroot
#Port $port
#ServerRoot $serverroot
#<VirtualHost $subserver>
#</VirtualHost>

$docroot = "";       # user's document root
$port = "";          # port server listens on 
$serverroot = "";    # location of fp configuration files for a server
$fpservername = "";

# touch /usr/local/frontpage/zeus/$fpservername/etc/access.conf

# cd /usr/local/frontpage/zeus/$fpservername/; ln -s conf .


$restart_vserver = 0;     # tell user to restart this virtual server
$subserver_path = undef;  # cached location of subserver










##############################################
#
# Check for command line arguments
#
##############################################

$action = "install";  # by default

if ( @ARGV ) {
   my $arg;
   my ( $key, $value );
   while ( $arg = shift @ARGV ) {
      my $no_match = 0;
      
      if ( $arg =~ s/^--// ) {
         # long arg processing
         ( $key, $value ) = split( /=/, $arg, 2 );
         $value =~ s/[\"\'](.*)[\"\']/$1/ if $value; # take off an outer layer of quotes if passed

         $_ = $key;
       KEY: {                 # args of form --foo or --foo=val or --foo val
            /^help$/
              && do { $help_topic = $value; $help_topic = shift @ARGV if ! defined $help_topic;
                      $text = &help( $help_topic || "" ) || $mainhelp; print $text; exit 0; };
            
            /^install$/ && do { $action="install"; $action_set++; last KEY;}; # assumed
            
            /^(?:vserver|virtual-server|server|vs)$/
              && do { $vserver = $value;
                      $vserver = shift @ARGV if ! defined $vserver;
                      $vserver_set++; last KEY; };
            
            /^admin(user)?$/
              && do { $admin = $value;
                      $admin =  shift @ARGV if ! defined $admin;
                      $admin_set++; last KEY; };
            
            /^realm$/
              && do { $realm = $value;
                      $realm = shift @ARGV if ! defined $realm;
                      $realm_set++; last KEY; };
            
            /^passw(ord|d)$/
              && do { $passwd = $value;
                      $passwd = shift @ARGV if ! defined $passwd;
                      $passwd_set++; last KEY; };
            
            /^x?user$/
              && do { $xuser = $value;
                      $xuser = shift @ARGV if ! defined $xuser; 
                      $xuser_set++; last KEY; };
            
            /^x?group$/
              && do { $xgroup = $value;
                      $xgroup = shift @ARGV if ! defined $xgroup;
                      $xgroup_set++; last KEY; };
            
            /^(?:subserver|site(?:name)?|host(?:name)?)$/
              && do { $subserver = $value;
                      $subserver = shift @ARGV if ! defined $subserver;
                      $subserver_set++; last KEY; };
            
            /^path$/
              && do { $subserver_path = $value;
                      $subserver_path = shift @ARGV if ! defined $subserver_path;
                      $subserver_path_set++; last KEY; };
            
            /^(?:(?:de|un)install|remove)$/ && do { $action="deinstall"; $action_set++; last KEY; };
           
            /^(?:check)$/ && do { $action = "check"; $action_set++; last KEY; };

            /^(?:upgrade|update)$/ && do { $action = "upgrade"; $action_set++; last KEY; };

            /^nofollow/ && do { $nofollow++; last KEY; };
            
            /^nofix/ && do { $nofix++; last KEY; };

            $no_match = '--';
         }
    } elsif ( $arg =~ s/^-// ) {
       # short arg processing
       $_ = $arg;
     KEY: {
          /^(h|help)$/ && do { print $mainhelp; exit 0; };
          /^V(.*)$/ && do { $vserver = $1 || shift @ARGV; $vserver_set++; last KEY; };
          /^A(.*)$/ && do { $admin = $1 || shift @ARGV; $admin_set++; last KEY; };
          /^R(.*)$/ && do { $realm = $1 || shift @ARGV; $realm_set++; last KEY; };
          /^P(.*)$/ && do { $passwd = $1 || shift @ARGV; $passwd_set++; last KEY; };
          /^U(.*)$/ && do { $xuser = $1 || shift @ARGV; $xuser_set++; last KEY; };
          /^G(.*)$/ && do { $xgroup = $1 || shift @ARGV; $xgroup_set++; last KEY; };
          /^S(.*)$/ && do { $subserver = $1 || shift @ARGV; $subserver_set++; last KEY; };    
          /^path(.*)$/ && do { $subserver_path = $1 || shift @ARGV; $subserver_path_set++; last KEY; };
          $no_match = '-';
       }
  } else {
     print STDERR "Invalid argument: $arg\n";
     exit 1;
  }

      if ( $no_match ) { print STDERR "Invalid argument: $no_match$arg\n";
                         exit 1;
                      }
   }
   
   if ( defined $action_set && $action_set > 1 ) {
      print STDERR "You have specified multiple, conflicting arguments\n";
      exit 1; 
   }

}   







# --------------------------------------------
# See if script is being run from a terminal

$non_interactive = 1 if ! -t; # check to see if STDIN is opened from a tty









# --------------------------------------------
# Decide on action to take

if ( $action eq "deinstall" ) {
   &deinstall( $vserver, $subserver, $non_interactive ); exit 0;
} elsif ( $action eq "install" ) {
   &basic_checks; &install('full'); exit 0;
} elsif ( $action eq "upgrade" ) {
   &basic_checks; &install('upgrade'); exit 0;
} elsif ( $action eq "check" ) {
   &basic_checks;
   ( $value, $msg ) = &check( $vserver, $subserver );
   if ( $value ) { print "Ok\n"; exit 0; }
   else { print "Failed\n"; print STDERR $msg; exit 1; }
}








# --------------------------------------------
# Check with fpsrvadm.exe to see if this web should work
# At least gives a pretty good indication and is
# probably better than us guessing.
# Only trouble is unuseful error messages from fpsrvadm.exe

sub check {
   my ( $vserver, $subserver ) = @_;
   my $response;

   # ensure that a virtual server name is specified

   if ( ! $vserver ) {   
      if ( $non_interactive ) {
         print STDERR "Specify a virtual server to check\n";
         exit 1;
      } else { $vserver = &get_vserver_name; }
   } else {
      if ( ! &check_vserver_exists( $vserver ) ) {
         print STDERR "The virtual server you have specifed '$vserver' does not exist\n";
         if ( $non_interactive ) { exit 1; }
         else { $vserver = &get_vserver_name; }
      }
   }

   # if this is a subserver installation we need to know which one 
  
   my ( $c_ip_name, $c_port, $c_docroot ) = &get_vserver_config($vserver);

   if ( &check_module($vserver, 'subserver') ) {
      if ( ! $subserver ) {
         if ( $non_interactive ) {
            print STDERR "Specify the hostname of the subserver you wish to deinstall from\n";
            exit 1;
         } else {
            $subserver = &get_subserver($vserver, $c_docroot);
         }
      }
   }

   # first check that the required modules are still enabled 
   
   # frontpage
   
   if ( ! &check_module( $vserver, 'frontpage' ) ) {
      return( 0, "Module 'frontpage' not enabled\n" );
   }
   
   # htaccess

   if ( ! &check_module( $vserver, 'htaccess' ) ) {
      return( 0, "Module 'htaccess' not enabled\n" );           
   }

   # use fpsrvadm.exe's checking function to check that fp is happy
   
   if ( $subserver ) { $response = `fpsrvadm.exe -o check -m $subserver -p $c_port`; }
   else              { $response = `fpsrvadm.exe -o check -m $c_ip_name -p $c_port`; } 
  
   if ( $? ) { # Error
      return ( 0, $response );
   } else {
      return ( 1, $response );
   }
}










# uninstall  ( only disables )

sub deinstall {

   my ( $vserver, $subserver, $non_interactive ) = @_;
   if ( ! $vserver ) {   
      if ( $non_interactive ) {
         print STDERR "Specify a virtual server to deinstall configuration files from\n";
         exit 1;
      } else { $vserver = &get_vserver_name; }
   } else {
      if ( ! &check_vserver_exists( $vserver ) ) {
         print STDERR "The specifed virtual server '$vserver' does not exist\n";
         if ( $non_interactive ) { exit 1; }
         else { $vserver = &get_vserver_name; }
      }
   }
   
   my ( $c_ip_name, $c_port, $c_docroot ) = &get_vserver_config($vserver);

   if ( &check_module($vserver, 'subserver') ) {
      if ( ! $subserver ) {
         if ( $non_interactive ) {
            print STDERR "Specify the hostname of the subserver you wish to deinstall from\n";
            exit 1;
         } else {
            $subserver = &get_subserver($vserver, $c_docroot);
         }
      }
   }
   
   # subserver set

   $dir = "$fp_dir/zeus/$vserver";
   $dir .= "_$subserver" if $subserver;

   if ( ! -e $dir ) {
      print STDERR "Already disabled\n - $dir does not exist\n";
      exit 0;
   }

   $name = $subserver || $c_ip_name;

   # just remove zeus generated configuration files
   system( 'rm', '-rf', $dir );
   
   if ( ! $? ) {
      print "Removed directory $dir\n";
      print "Frontpage disabled for server $name\n";
      printf( <<'HERE', "$fp_dir/${name}:${c_port}.cnf" );

The MS Frontpage Extension generated files :
%s
and DOCROOT/_*

Have been left. The site will still function but cannot be published to.

HERE

      print "\n";  
      exit 0;
   } else {
      print STDERR "Failed to remove directory $dir and disable Frontpage on server $name $!\n";
      exit 1;
   }
}















     


#############################################
# Basic common checks
#############################################


sub basic_checks {

   #--------------------------------------------
   # check frontpage directory exists
   
   if ( ! &check_frontpage_exists ) {
      printf STDERR ( <<'HERE', $fp_dir );

Microsoft FrontPage Extensions are not installed under %s

You need to download the correct FrontPage Extension binaries from

  ftp://ftp.microsoft.com/products/frontpage 

The file will be called fp40.platform.tar.Z, where platform refers
to machine architecture.

Untar this file into /usr/local and run this script again.

( See the Zeus webserver documentation on the FrontPage module
  for further information )

The extensions must be installed to this location.

HERE
      exit 1;
   }
   


   # --------------------------------------------
   # check that we are root

   if ( ! &check_user_is_root ) {
      print STDERR ( <<'HERE' );
This script needs to be run as root
HERE
  exit 1;
   }




   
   #--------------------------------------------
   # Check for current version
   
   if ( ! &check_currentversion_exists ) {

      print "\n* Could not find currentversion link in '/usr/local/frontpage' * \n";

      if ( $nofix || $non_interactive ) {
         print STDERR <<'HERE';
To correct this :

cd /usr/local/frontpage
ln -s versionX.X currentversion

HERE
      exit 1;
   }

   # try to find it
   opendir DIR, $fp_dir;
   my @versions = grep /^version/, readdir DIR;
   closedir DIR;
   
   if ( ! @versions ) {
      print STDERR "Could not find any versions of Frontpage in $fp_dir\n";
      exit 1;
   } else {
      @versions = sort @versions;
      my $latest = pop @versions;
      print "Found '$latest'\n";
      
      my $answer = &prompt("Found '$latest', create a link ? (Y|N)", "\nAnswer yes to create a link and continue. Answer no to quit.\n\n", 'Y' );
      if ( $answer =~ /^y/i ) {
         &create_symlink( $fp_dir, $latest, "currentversion" );
      } else {
         print "To fix this :\n  cd /usr/local/frontpage\n  ln -s $latest currentversion\n\n";
      }
   }  
   }





   #--------------------------------------------
   # Check binary works

   if ( ! &check_binary ) {
      print STDERR "Could not run fpsrvadm.exe binary $!\n";
      exit 1;
   }






   #--------------------------------------------
   # check we have permissions to write to the frontpage dir

   if ( ! &check_directory_writable($fp_dir) ) {     
      printf STDERR ( <<'HERE', $fp_dir, $! );
You do not have sufficient permissions to write to the directory '%s'. $!  
HERE
  exit 1;
   }



   #--------------------------------------------
   # check that we're running on an admin server

   if ( ! &check_admin_server ) {
      printf STDERR (<<'HERE', $fp_dir);
This script should only be run on the admin server machine.
In a clustered environment, you should share %s
across a common filesystem.
HERE
  exit 1;
   }


}  # Basic check_admin_servers















#######################################################
#
# User Interaction
#
#######################################################


# INSTALL ( + UPGRADE )

sub install {

   my ( $type ) = @_;



   # --------------------------------------------
   # Check/Get vserver
   
   if ( ! $vserver ) {
      if ( $non_interactive ) {
         print STDERR "Virtual server not specified\n"; exit 1;
      } else {
         $vserver = &get_vserver_name;
      }
   }
   
   # previously fixed if interactive
   if ( ! &check_vserver_exists( $vserver )) { 
      print STDERR "Specified virtual server \"$vserver\" does not exist\n"; exit 1;
   }
   



   #--------------------------------------------
   # Check modules on this vserver

   if ( ! &check_module( $vserver, 'frontpage' ) ) {
      if ( $non_interactive ) {
         if ( ! $nofix ) {
            print "Enabling 'frontpage' module on virtual server '$vserver'\n";
            &enable_module( $vserver, 'frontpage')
              or print STDERR "Failed to enable module 'frontpage' on virtual server '$vserver'\n"
                and exit 1;
            $restart_vserver = 1;
         } else {
            print STDERR "Required module 'frontpage' not enabled on virtual server '$vserver'\n";
            exit 1;
         }
      } else {
         $query++;
         &query_enable_module( $vserver, 'frontpage' );
         $restart_vserver = 1;
      }
   }
   

   if ( ! &check_module( $vserver, 'htaccess' ) ) {
      if ( $non_interactive ) {
	 if ( ! $nofix ) {
	    print "Enabling 'htaccess' module on virtual server '$vserver'\n";
	    &enable_module( $vserver, 'htaccess')
	      or print STDERR "Failed to enable module 'htaccess' on virtual server '$vserver'\n"
		and exit 1;
	    $restart_vserver = 1;
	 } else {
	    print STDERR "'htaccess' module not enabled on this virtual server\n";
	    exit 1;
	 }
      } else {
         $query++;
	 &query_enable_module( $vserver, 'htaccess' );
	 $restart_vserver = 1;
      }
   }


   
   # --------------------------------------------
   # Tell the user to restart the virtual server

   if ( $restart_vserver ) {
      printf( <<'HERE', $vserver );

You must restart the virtual server '%s' for these changes to take effect.
This can be done from the 'Edit' page for '%s' on the Zeus Web Admin interface or
by using the webctl script ('$ZEUSHOME/webadmin/bin/webctl')
e.g. $ZEUSHOME/webadmin/bin/webctl --vs=site1 --action=restart

HERE

}



   #--------------------------------------------
   # Get information we need from the vserver config file
   
   ( $c_ip_name, $c_port, $c_docroot ) = &get_vserver_config($vserver);






   #--------------------------------------------
   # Do special subserver stuff if necessary
   # modifies $fpservername, $subserver and $docroot

   if ( &check_module( $vserver, 'subserver' ) ) {
      print "This server has subservers enabled\n";
   
      if ( ! $subserver ) {
         if ( $non_interactive ) {
            print STDERR "No hostname specified for this subserver\n";
            exit 1;
         } else {
            $query++;
            $subserver = &get_subserver( $vserver, $c_docroot );
         }
      }

      my ( $type, $prefix, $suffix ) = &get_subserver_config( $vserver );
      $subserver_path = undef if $type < 3; # Not complex - ignore
      $new_docroot = "$c_docroot/" . &subserver_path( $vserver, $subserver, $c_docroot );

      if ( ! &check_subserver_exists( $vserver, $subserver, $c_docroot ) ) {
         printf STDERR ( "Subserver %s does not exist\n", $new_docroot );
         exit 1;
      }
   
      $docroot = $new_docroot;
      $fpservername = "${vserver}_${subserver}";
      $subserver = $subserver;
      $port = $c_port;

   } else { # no subservers
      $docroot = $c_docroot;
      $port = $c_port;
      $subserver = $c_ip_name;
      $fpservername = $vserver;
   }





   #--------------------------------------------
   # Find docroot
   # if it's a symlink we must follow that symlink so that FP doesn't fail
   # its security tests.  It won't ever write a file that is outside this 
   # directory
   
   if ( -l $docroot && ! $nofollow ) {
      $newroot = &follow_link( $docroot );
      printf( "Followed symlink from %s to %s\n", $docroot, $newroot );
      $docroot = $newroot;
   }




   #--------------------------------------------
   # check the docroot exists
   
   if ( ! -d "$docroot" ) {
      printf STDERR ( "Document root %s does not exist\n", $docroot);
      exit 1;
   }


   

   # --------------------------------------------
   # Check/Get unix user and group

   ( $default_user, $default_group ) = &get_file_ownership($docroot);
   
   $default_user = undef if ! &check_user_non_root( $default_user );
   
   if ( ! $xuser ) { 
      if ( $non_interactive ) {
         if ( $default_user ) {
            $xuser = $default_user;
         } else {
            print STDERR "Unix username not set\n"; exit 1;
         }
      } else {
         if ( $default_user ) { $xuser = $default_user; }
         else { $xuser = &get_unix_user( $default_user ) if ! $xuser; $query++; }
      }
   }
   
   if ( ! check_user_exists( $xuser ) ) {
      print STDERR "Unix user $xuser does not exist on this system\n"; exit 1;
   }
   
   $default_group = undef if $default_group =~ /(?:root|wheel)/;
   
   if ( ! $xgroup ) {
      if ( $non_interactive ) {
         if ( $default_group ) {
            $xgroup = $default_group;
         } else {
            print STDERR "Unix groupname not set\n"; exit 1;
         }
      } else {
         if ( $default_group ) { $xgroup = $default_group; }
         else { $xgroup = &get_unix_group( $default_group ) if ! $xgroup; $query++; }
      }
   }

   if ( ! &check_group_exists( $xgroup ) ) {
      print STDERR "Unix group $xgroup does not exist on this system\n"; exit 1;    
   }


   # --------------------------------------------------
   # Sort out the final details


   $zfp = $fp_dir . "/zeus";
   $serverroot = $zfp . "/" . $fpservername;

   $srmconf = "$serverroot/srm.conf";
   $accessconf = "$serverroot/etc/access.conf";






   # ---------------------------------------
   # Only if we are installing 
   # get the access control info

   if ( $type eq "full" ) {
      if ( ! $admin ) {
         if ( $non_interactive ) {
            print STDERR "Frontpage administrator username not set\n"; exit 1;
         } else {      
            $admin = &get_admin_user;
            $query++;
         }
      }
      
      if ( ! $passwd ) {
         if ( $non_interactive ) { 
            print STDERR "Frontpage administrator password not set\n"; exit 1;
         } else {
            $passwd = &get_password($admin);
            $query++;
         }
      } else {
         if ( $passwd eq $admin ) { print STDERR "Password matches username\n"; }
         elsif ( $passwd eq "" ) { print STDERR "Blank password\n"; }
         else { print STDERR "Password matches admin server password\n"; }
      }
   } # otherwise leave the login alone


   # ----------------------------------------------------------
   # Give a warning before proceeding if running interactively 


   if ( ! $non_interactive && $type eq 'full' && $query  ) {
      
      # Warn before proceeding
   
      print "We have all the necessary information now.\n";
      print "Ready to create files\n";

      my $help = "Answer 'yes' to continue and add FrontPage support for this site\n";
      $help .=   "Files will be created in the document root and in /usr/local/frontpage\n";

      $answer = prompt("Continue ? (Y|N)", $help, 'Y' );
      if ( $answer =~ /^y/i ) {
         print("Creating the FrontPage configuration files\n");
      }
      else { print "Quitting\n"; exit 0; }
      
   }
   





   # Start taking action




   


   ###################################################
   # try to fix permissions on the frontpage directory
   # Should politely ask first and report if changed
   
   my $check = &check_frontpage;
   
   if ( ! defined $check ) { # find failed 
      print STDERR ( <<'HERE', $fp_dir);
You should manually check that all files under %s
are world readable and that executable files are world executable.
HERE
}
   elsif ( $check ) {
      print "Permissions on $fp_dir ok\n";
   } else {   
      print "Fixing permissions on $fp_dir\n";

      if ( $non_interactive ) {      
         if ( ! $nofix ) {
            &fix_frontpage_permissions;
         }
      } else {
         &query_fix_frontpage_permissions;
         $query++;
      }
   }
   

   ###################################################
   # Backup .htaccess files

   if ( &check_htaccess( $docroot ) ) {
      print "\nCopying a backup of existing $docroot/.htaccess\n";
      print "fpsrvadm.exe is likely to overwrite this file\n";

      my $backup = &backup_htaccess($docroot);
      print "Backed up to $backup\n";

      print "\n** Any access control configured in this file will probably **\n";
      print "** be dropped during the FrontPage installation process     **\n\n";

      if ( ! $non_interactive ) {
         print "Press Ctrl-c immediately to quit without further changes\n";
         print "Return to continue\n";
         {
            local $/ = "\n";
            <STDIN>;
         }
         print "You may need to manually merge the old and new files\n";
      }
   }


   ###################################################
   # Write fake config files
   
   print "\nCreating configuration files in $serverroot ...\n" if ! $non_interactive;
   
   &write_fakeconf( $serverroot, $docroot, $subserver, $port);
   &create_symlink( $serverroot, '.', 'conf' );
   
   print "\nRunning fpsrvadm.exe ...\n" if ! $non_interactive;

   # Run fpsrvadm
   
   if ( $type eq 'upgrade' ) {
      print `fpsrvadm.exe -o upgrade -p \"$port\" -s \"$srmconf\" -type apache-fp -xUser \"$xuser\" -xGroup \"$xgroup\" -multihost \"$subserver\"`;
   } else {
      print `fpsrvadm.exe -o install -p \"$port\" -s \"$srmconf\" -u \"$admin\" -pw \"$passwd\" -type apache-fp -xUser \"$xuser\" -xGroup \"$xgroup\" -multihost \"$subserver\"`;
   }

   if ( $? ) { print STDERR ("fpsrvadm.exe failed $!\n"); exit 1; }
   else { print "fpsrvadm.exe finished\n"; }

   # Fix up the realm. Frontpage will probably have set it to
   # the wrong name.

   my $new_realm;
   if ( $realm ) {
      $new_realm = &adjust_realm( $docroot, $vserver, $realm );
   } else {
      $new_realm = &adjust_realm( $docroot, $vserver, undef );
   }

   print "Altering AuthName in FrontPage .htaccess files\n";
   if ( ! defined $new_realm ) {
      # adjust failed
      print STDERR "Failed to alter AuthName\n";
   } else {
      print "AuthName set to '$new_realm'\n";  
   }

   if ( $restart_vserver ) { print "You must restart the virtual server $vserver to enable required modules\n"; }

   print "Install Completed\n";
   
} # INSTALL   






















#######################################################
#
# SUBROUTINES
#
#######################################################

################
# Checks
################



# --------------------------------------------
# Check frontpage central dir exists

sub check_frontpage_exists { return &check_directory_exists( $fp_dir ); }






# --------------------------------------------
# Check current version exists

sub check_currentversion_exists { return &check_directory_exists( $fp_dir."/currentversion" ); }






# --------------------------------------------
# Check directory exists

sub check_directory_exists {
   my ( $directory_dir ) = @_;
   if ( -d $directory_dir ) {
      return 1;
   }
   elsif ( -l $directory_dir ) {  # see if the link points to a directory
      my $target = &follow_link( $directory_dir );
      if ( ! defined $target ) {
         return undef;
      } else { return -d $directory_dir }
   }
   else { return undef; }
}








#--------------------------------------------
# Check that binary is runnable

sub check_binary {
   my $output = `$fp_dir/currentversion/bin/fpsrvadm.exe -h 2>&1`;
   return $? ? 0 : 1;
}







# --------------------------------------------
# Check that the config file for a vserver ( and hence the vserver ) exists 

sub check_vserver_exists {
   my ( $vserver ) = @_;
   my $filename = &config_filename( $vserver );
   chomp $filename;
   return -f $filename;
}






# --------------------------------------------
# Check that a module is enabled on a vserver

sub check_module {
   my ( $vserver, $module ) = @_;
   my $filename = &config_filename( $vserver );
   my $key = 'modules!'.$module.'!enabled';
   
   my $zc = new ZConf($filename);
   $zc->ZConf::load() or return undef;
   my $val = $zc->ZConf::get( $key ) or return undef;
   if ( $val ne 'yes' ) {
      return undef;
   } else { 
      return 1;
   }
}





 
# ------------------------------------------
# check a UNIX user exists

sub check_user_exists {
   my ( $user ) = @_;
   my $uid = getpwnam($user);
   if ( defined $uid ) {
      return 1;
   } else { return 0; }
}








# ------------------------------------------
# check a UNIX group exists

sub check_group_exists {
   my ( $group ) = @_;
   my $gid = getgrnam($group);
   if ( defined $gid ) {
      return 1;
   } else { return 0; }
}








# --------------------------------------------
# Check that current user is root

sub check_user_is_root { return $> == 0; }










# --------------------------------------------
# Check that a given username is not UID 0

sub check_user_non_root {
   my ( $user ) = @_;
   return 1 if ! $user;
   my $uid = getpwnam($user);

   if ( $user eq 'root' or defined $uid and $uid == 0 ) {
      return 0;
   } else {
      return 1; # if non-root
   }
}








# --------------------------------------------
# Check that the password given is not the admin
# server password

sub check_password_not_zeus_admin {
   my ( $password ) = @_;
   my $md5 = $ENV{ZEUSHOME}."/admin/bin/md5";
   my $conffile = $ENV{ZEUSHOME}."/admin/website";
   my $key = 'modules!access!users!admin';
   if ( ! -x $md5 ) { print STDERR "$md5 not found\n"; return 1; }
   my $zc = new ZConf($conffile);
   $password =~ s/'/\\'/g;
   my $enc_pw = `$md5 -pem -- \'$password\'`;
   chomp $enc_pw;
   $zc->ZConf::load();
   if ( $enc_pw eq $zc->ZConf::get($key) ) {
        return 0;
     } else { return 1; }
}









# --------------------------------------------
# Check directory writable

sub check_directory_writable {
   my ( $directory ) = @_;
   if ( open( TEST, ">${directory}/z_touch_check" ) ) {
      close TEST;
      unlink "${directory}/z_touch_check";
      return 1;
   } else { return 0; }
}










# --------------------------------------------
# Check for existing .htaccess files

sub check_htaccess {
   my ( $docroot ) = @_;
   return -e "$docroot/.htaccess";
}











# --------------------------------------------
# Check frontpage directory

sub check_frontpage {
   # see if there are any files not readable by all
   my $noread = `find $fp_dir ! -perm -444 -print`;
   return undef if $?;
   # or insufficently executable
   my $noexec = `find $fp_dir -perm +111 ! -perm -111 -print`;
   print STDERR ( "'find' failed $?\n" ) && return undef if $?;
   return( ! ( $noread || $noexec ) );
}











# --------------------------------------------
# Check this is an admin server      

sub check_admin_server { return -d "$ENV{ZEUSHOME}/webadmin"; }

sub check_subserver_exists {
   my ( $vserver, $subserver, $docroot ) = @_;
   my $path = &subserver_path( $vserver, $subserver, $docroot );
   if ( -d "$docroot/$path" || -l "$docroot/$path" ) { return 1 }
   else { return 0 }
}







   
   
###############
# User input
###############




# --------------------------------------------
# Prompt user for input

sub prompt {
   my ( $prompt_text, $help_text, $default, $hide ) = @_;
   my $answer;

   if ( ! $banner_done ) { print $banner; $banner_done++; }

   chomp $prompt_text;
   print $prompt_text;
   print " ";
   print "[?]" if $help_text;
   print ": ";
   print "[$default] " if $default;


   system( 'stty', '-echo' ) if $hide;
   $answer = <STDIN>;
   exit if ! defined $answer;
   $answer =~ tr/[\200-\377]//d; # rm high chars
   chomp $answer;
   system( 'stty', 'echo' ) if $hide;
   print "\n" if $hide;

   if ( $help_text && $answer eq '?' ) {
      $answer = "";
      print "\n$help_text\n";
      $answer = prompt( @_ );
   }

   $answer = $default if $default && $answer eq "";
   
   return $answer;
}      








# --------------------------------------------
# Get new password from the user

sub get_password {
   my ( $username ) = @_;
   $username = "" if ! defined $username;
   my ( $pw1, $pw2 );
   my $confirm;

   my $prompt1 = <<'HERE';
Enter a password for the administrator '%s'
HERE

   my $help = &help('password');
   
   my $zp = <<'HERE';

The new password you have entered matches the one used for the
Zeus Administration server. This is probably not what you wanted
as this would give the Frontpage user full access to
your webservers.

Please enter a different password or use the command line options.

HERE


  while( 1 ) {
     $pw1 = prompt( sprintf( $prompt1, $username ), $help, undef, 1 );     

     if ( $pw1 eq "" ) {
        print "No password given. Use command line options to set a blank password\n";
        next;
     }

     if ( $pw1 eq $username ) {
        print "Warning: you have used the username as the password.\n";
     }

     if ( ! &check_password_not_zeus_admin( $pw1 )) {
        print $zp;
        next;
     }

     
     $pw2 = prompt( "Re-enter the password to confirm it.", $help, undef, 1 );     
     
     if ( $pw1 ne $pw2 ) {
        print "The passwords you entered did not match.\n";
        next;
     } else { 
        last; 
     }
  }
   
   return $pw1;
}











# --------------------------------------------
# Get name of unix user owning files

sub get_unix_user {
   my ( $default_user ) = @_;
   my ( $username );
   
   my $prompt = <<'HERE';
Enter UNIX user name
HERE

  my $help = &help('user');

  my $root = <<'HERE';

You should not create these files as root.

If they are then the Frontpage extensions will need
to be run as root and this is explicitly denied in the
webserver.

It would be highly insecure and it is unnecessary.

Please specify a non-root user.

HERE

  my $nonexistent = <<'HERE';
The user you have specified does not exist
HERE

  while ( 1 ) {
     $username = &prompt( $prompt, $help, $default_user );
     
     if ( ! $username ) {
        next;

     } elsif ( ! &check_user_non_root( $username )) {
        printf( $root );

     } elsif ( ! &check_user_exists( $username ) ) {
        printf( $nonexistent );

     } else {
        last;
     }
  }
   return $username;
}









# --------------------------------------------
# Get unix user - owner of home dir files

sub get_unix_group {
   my ( $default_group ) = @_;
   my ( $groupname );
   
   my $prompt = <<'HERE';
Enter UNIX group that owns this web
HERE

  my $help = &help('group');
  
  my $nonexistent = <<'HERE';
The group you have specified does not exist
HERE

  while ( 1 ) {
     $groupname = &prompt( $prompt, $help, $default_group );
     
     if ( ! $groupname ) { 
        next; 

     } elsif ( ! &check_group_exists( $groupname ) ) {
        printf( $nonexistent );

     } else {
        last;
     }
  }
   return $groupname;
}









# --------------------------------------------
# Get web access control admin user name

sub get_admin_user {
   my $admin = "";

   $prompt = <<'HERE';
Enter the administrator user name
HERE

  my $help = &help('admin');

  my $fail = <<'HERE';
You must enter a user name to control access to this Frontpage
web.
HERE

  my $default = "admin";

   while ( 1 ) {
      $admin = &prompt( $prompt, $help, $default );
      if ( $admin ne "" ) { last; }
      else {
         printf( $fail );
      }         
   }
   return $admin;
}









# --------------------------------------------
# Get virtual server name from the user

sub get_vserver_name {
   my $vserver = "";

   my $prompt = <<'HERE';
Enter virtual server name
HERE
  my $help = &help('vserver');
  # print this if the input fails tests
  my $fail = <<'HERE';
The virtual server you have specified "%s" does not appear to
exist. 
HERE
  # print this if input fails and looks like a hostname
  my $host = <<'HERE';

It appears that you may have entered a hostname.

Please enter the _virtual server_ name. This is the short name
that appears on the traffic light page.

If you are adding Frontpage support to a subserver enter the
name of its parent virtual server here. You will be prompted
for the subserver hostname (e.g. mysite.isp.com) later.

HERE
  
  while ( 1 ) {   
     $vserver = prompt($prompt, $help);
     if ( $vserver eq "" ) {
         print "\n$help\n";
      }
     elsif ( ! &check_vserver_exists( $vserver ) ) {
        printf($fail, $vserver);
         
        # Give a helpful hint if they entered a hostname  
        if ( $vserver =~ /\./ ) {
           printf($host, $vserver);
        }
      }
     else { last; }
  }
   return $vserver;
}










# --------------------------------------------
# Get site name for a subserver

sub get_subserver {
   my ( $vserver, $docroot ) = @_;
   my $subserver = "";
   my $path = "";

   my $prompt = <<'HERE';
Enter subserver hostname
HERE
  my $help = &help('subserver');

  while (1) {
     $subserver = prompt($prompt, $help);
     $subserver = lc $subserver;
     if ( $subserver eq "" ) { next; }
     
     $path = &subserver_path( $vserver, $subserver, $docroot );
     if ( $path ) {
        if ( &check_subserver_exists( $vserver, $subserver, $docroot )) {
           print "Subserver found at $docroot/$path\n";
           return $subserver;
        } else {
           print STDERR "Subserver '$subserver' not found at '$docroot/$path' $!\n";
           print STDERR "Subserver '$subserver' does not exist\n";
#           exit 1;
        }
     } else {
        print STDERR "Bad subserver type - check your subserver configuration\n";
        exit 1;
     }
  }
}     











#####################
#  Make Changes  
#####################



# --------------------------------------------
# Fix frontpage permissions
# This might seem a tad severe, but the number of times customers have had
# problems with permissions means we should really try and help them out!
# Ensure permissions in /usr/local/frontpage are reasonable

sub query_fix_frontpage_permissions {
   my $reason = <<'HERE';
These files may be accessed by multiple OS users via the
Frontpage extensions. The simplest way of ensuring that
they can all read the files they need to run is to make the 
central Frontpage configuration files globally readable.
HERE

  my $ask = <<'HERE';
There are potentially problems with the permissions set on
files in %s.
HERE

  my $prompt = <<'HERE';
Fix them ? (Y|N) 
HERE

  $ask = sprintf( $ask, $fp_dir );
   
   # Check with the user that they don't mind us fixing this
   print "$ask\n";
   my $answer = prompt( $prompt, $reason, "Y" );
   if ( $answer =~ /^y/i ) {
      &fix_frontpage_permissions;
   } else { # answer n
      print("Skipping file permission fixes - you may need to manually change these later\n");
   }
}
   




# recursively chmod the frontpage directories

sub fix_frontpage_permissions {
   # Everything should be readable
   `find $fp_dir -exec chmod +r {} \\;`;
   # Anything that is executable, ensure it is also world executable
   `find $fp_dir -perm -100 -exec chmod +x {} \\;`;
         
   if ( $? ) { printf STDERR ("Failed to fix permissions with `find` $?\n"); }
   else { print("Permissions changed\n"); }
}
   


  


# --------------------------------------------
# write_fakeconf
# write out a dummy srm.conf and access.conf files that gives enough
# information about us so that the FrontPage CGIs know where we are

sub write_fakeconf {
   my ( $serverroot, $docroot, $subserver, $port ) = @_;

   my @stat;

   # first make the directory

   $rc = system( 'mkdir', '-p', "$serverroot/etc" );
   $rc >>= 8;

   if ( ! $rc ) { printf("Created directory %s\n", "$serverroot/etc" ); }
   else { printf("Failed to create directory %s\n", "$serverroot/etc" ); exit 1; }

   chmod( 0755, "$serverroot" )
     or printf("Failed to set permissions on %s\n", $serverroot ) && exit 1;
   chmod( 0755, "$serverroot/etc" )
     or printf("Failed to set permissions on %s\n", "$serverroot/etc" )&& exit 1;

   # Next make srm.conf file

   if ( sysopen( SRMCONF, $srmconf, $O_CREAT|$O_WRONLY|$O_TRUNC, 0644 ) ) {
      printf SRMCONF <<'SRM_END', $docroot, $port, $serverroot, $subserver;
DocumentRoot %s
Port %s
ServerRoot %s
<VirtualHost %s>
</VirtualHost>
SRM_END
  close SRMCONF;
      printf("Created %s\n", "$srmconf" ) if -f $srmconf;
      printf("Failed to create %s unusually\n", "$srmconf" ) && exit 1 if ! -f $srmconf;      
   } else { printf("Failed to create %s\n", "$srmconf" ); exit 1; }

   # create access.conf file

   if ( sysopen( TOUCH, $accessconf, $O_CREAT|$O_WRONLY|$O_TRUNC, 0644 ) && close TOUCH ) {
      printf("Created %s\n", $accessconf);
   } else {
      printf("Failed to create %s\n", $accessconf); exit 1;
   }
}









# create the symbolic link

sub create_symlink {
   my ( $dir, $to, $from ) = @_;
   $cwd = `pwd`;
   chdir $dir;
   if ( -e $from ) {
      if ( -l $from ) {
         unlink $from;
      } else {
         print STDERR "FATAL: '$from' exists and is not just a link.\n";
         exit 1;
      }
   }
   symlink $to, $from;
   printf( <<'HERE', "$dir/$from", "$dir/$to");
Created symbolic link %s -> %s
HERE
   chdir $cwd;
}








# check permissions match perms exactly
sub check_perms {
   my ( $file, $perms ) = @_;
   my @stat = stat $file;
   my $result = ( $stat[2] & 0777 ) ^ oct($perms);
   return $result?0:1;
}









# --------------------------------------------
# enable a module on a vserver   


sub enable_module {
   my ( $vserver, $module ) = @_;
   my $filename = &config_filename( $vserver );
   my $key = 'modules!'.$module.'!enabled';
   
   my $zc = new ZConf($filename);
   $zc->ZConf::load() or return undef;
   $zc->ZConf::add( $key, 'yes' );
   $zc->ZConf::save() or return undef;
   
   return 1;
}





# --------------------------------------------
# query enable module
# prompt user before adding module

sub query_enable_module {
   my ( $vserver, $module ) = @_;
   my $help = "Turn on the '$module' module for this virtual server\n";
   $help .=   "The virtual server will not be restarted automatically\n";

   my $answer = &prompt( "The Zeus '$module' module is required. Enable it ? (Y|N)", $help, 'Y' );
   if ( $answer =~ /^y/i ) { &enable_module( $vserver, $module ) && print "Module '$module' enabled\n"; }
   else { print "Module '$module' not enabled, exiting\n"; exit 1; }
}






# --------------------------------------------
# Change the realm (the text displayed on user
# authentification) after it is set by fpsrvadm.exe

sub adjust_realm {
   my ( $docroot, $vserver, $new_realm ) = @_;
   # Update the 'AuthName' directive in the .htaccess files created by 
   # Microsoft's fpsrvadm.exe program to the actual hostname
   # or a user specified realm
  
   my $filename = "$docroot/.htaccess";
   my @filenames = `find $docroot -name \".htaccess\" 2>/dev/null`;
   chomp @filenames;

   if ( ! $new_realm ) {
      # not specified explictly
      if ( $subserver ) {
         # get subserver hostname
         $new_realm = $subserver;
      } else {
         # Get vserver hostname
         my $key = 'ip_name';
         my $zc = new ZConf(&config_filename($vserver));
         $zc->ZConf::load() or return undef;
         $new_realm = $zc->ZConf::get( $key ) || "Root Web";
      }
   }
   
   if ( ! @filenames ) {
      @filenames = ( $filename );
   }

   my $file = "";
   local $/ = undef;

   foreach $filename ( @filenames ) {
      open( FILE, "+<$filename" ) || ( print STDERR "Failed to alter $filename $!" && return undef );
      $file = <FILE>;
      next if $file !~ /#\s*-FrontPage-/im; # only if it appears to be owned by FrontPage

      $file =~ s/^AuthName .*$/AuthName \"$new_realm\"/m;
      
      seek FILE, 0, 0;
      truncate FILE, 0;
      print FILE $file;
      close FILE;
   }
   
   return $new_realm;
}









# --------------------------------------------
# Backup htaccess files 

sub backup_htaccess {
   my ( $docroot ) = @_;
   my $file = "$docroot/.htaccess";
   my $backup_file_base = "$docroot/htaccess.old";
   my $backup_file = $backup_file_base;
   my $suffix = 1;

   while ( -e $backup_file ) {
      $backup_file = $backup_file_base.".$suffix";
      $suffix++;
   }
   
   ( system( "cp", "-p", $file, $backup_file ) >> 8 ) == 0 or 
	print STDERR "Failed to backup file $file $!\n" and exit 1;
   
   return $backup_file;
}
















################################
# Access existing configuration
################################


# --------------------------------------------
# Get filename of a vserver config file

sub config_filename {
   my ( $vserver ) = @_;
   my $filename = $ENV{ZEUSHOME}."/webadmin/conf/sites/".$vserver;
}








# --------------------------------------------
# Get required tunables from vserver config file

sub get_vserver_config {
   my  ( $vserver ) = @_;
   my ( $subserver, $port, $docroot ) = ( "", "", "" );

   my $zc = new ZConf(&config_filename($vserver));
   $zc->ZConf::load();
   $ip_name = $zc->ZConf::get( 'ip_name' ) || "";
   $port = $zc->ZConf::get( 'port' ) || "";
   $docroot = $zc->ZConf::get( 'docroot' ) || "";

   return ( $ip_name, $port, $docroot );
}








# get the user and group ID of the owner of a file

sub get_file_ownership {
   my ( $file ) = @_;
   my @stat = stat $file or return ( undef, undef );
   my ( $uid, $gid ) = ( $stat[4], $stat[5] );
   my ( $user, $group ) = ( scalar getpwuid($uid), scalar getgrgid($gid) );
   return ( $user, $group );
}






# Look in the configuration file to find out
# which type of hash is being used and any prefix/suffix

sub get_subserver_config {
   my ( $vserver ) = @_;
   my $zc = new ZConf(&config_filename($vserver));
   $zc->ZConf::load();
   my $type = $zc->ZConf::get('modules!subserver!layout');
   my $prefix = $zc->ZConf::get('modules!subserver!prefix');
   my $suffix = $zc->ZConf::get('modules!subserver!suffix');
   return ( $type, $prefix, $suffix );
}






# Calculate the relative path to a subserver from the docroot
# Need to know the name of the subserver ( hostname )
# virtual server it runs on. 
# The document root is for use on custom subserver functions

sub get_subserver_path {
   my ( $vserver, $subserver, $docroot ) = @_;
   my ( $type, $prefix, $suffix ) = &get_subserver_config($vserver);
   my $path = undef;

   if ( $type == 0 ) {
      $path = $subserver;
   } elsif ( $type == 1 ) {
      my $str = $subserver;
      $str =~ s/^www\.//; # any leading www.
      $str =~ s/\..*//;   # $str = www.(*).co.uk
      if ( $str =~ /^(.)(.)/ ) {
         $path = "$1/$2/$subserver";
      } else {
         $path = "a/a/$subserver"; # not enough characters
      }
   } elsif ( $type == 2 ) { 
      $path = `$ENV{ZEUSHOME}/webadmin/bin/subserver_hash.pl $subserver`;
      chomp $path;
      if ( $? ) { $path = undef; }      
   } elsif ( $type == 3 ) {
      # specify path
      print "You are using a custom subserver hashing function\n";
      $path = &query_subserver_path( $subserver, $docroot );
   } else { $path = undef; }

   if ( defined $prefix && $prefix ne "" ) {
      $prefix .= '/' if $prefix !~ m|/$|;
      $path = $prefix . $path;
   }
   if ( defined $suffix && $suffix ne "" ) {
      $suffix = '/' . $suffix if $suffix !~ m|^/|;
      $path .= $suffix;
   }

   return $path;
}
     



# get the subserver path from previous calculation if cached

sub subserver_path {
   my ( $vserver, $subserver, $docroot ) = @_;
   if ( ! defined $subserver_path ) {
      $subserver_path = &get_subserver_path( $vserver, $subserver, $docroot );
   }
   return $subserver_path;
}






# Ask the user for the path to a subserver directory as they are using 
# a custom hashing function

sub query_subserver_path {
   my ( $subserver, $docroot ) = @_;
   my $path;

   my $prompt = <<'HERE';
Enter the path to the document root of the subserver '%s'
relative to the document root of the virtual server 
('%s')
HERE

  $prompt = sprintf( $prompt, $subserver, $docroot );

 PROMPT:
   while ( 1 ) {
      $path = &prompt( $prompt );
      if ( ! $path ) {
         next PROMPT;
      } elsif ( ! -d "$docroot/$path" && ! -l "$docroot/$path" ) {
         printf(<<'HERE', $docroot, $path, $subserver );
Directory %s/%s does not exist
 - has the subserver '%s' been created ?
HERE
         next PROMPT;
      } else {
         last PROMPT;
      }
   }

   return $path;
}
      








###############
# Misc
###############






# --------------------------------------------
# Follow link one step

sub follow_link {
   my ( $filename ) = @_;
   my $newname;
   
   if ( $filename !~ m|^/| ) {     # relative
       $cwd = `pwd`;
       chomp $cwd;
       $filename =  "${cwd}/${filename}";
   }

   $filename =~ s|(.+)/$|$1|; # remove trailing slash
  
   $newname = readlink( $filename );
   if ( $newname !~ m|^/| ) {                 # relative
      $filename =~ s|/[^/]*/?$||;           # chop off the filename
      $newname = "${filename}/${newname}";  # add onto base
      while ( $newname =~ s|/\./|/|                
              or $newname =~ s|/[^/]*/\.\./|/| ) {1;}    # remove /./ and /foo/../
      $newname =~ s|(.+)/$|$1|;  # remove trailing slash	
   }

   return $newname;
}






sub help {
   my ( $help_topic ) = @_;
   my $text;
   if( $help->{$help_topic} ) {
      $text = $help->{$help_topic};
      if ( $text =~ /^\#\#(.*)/ ) { $text = $help->{$1}; }
      return $text;
   }
   else { return ""; }
}

