#
# Dick Munroe (munroe@csworks.com)
#
# Convert all local address blocks from the OSU configuration
# files to a format that can be processed by WASD.
#
# Usage:
#
#	perl CONVERT-OSU-TO-WASD.PL www_system:osu.conf
#
# What is produced are files in the current directory.  Some
# tweaking may be necessary for your configuration to do everything
# at your site.
#
# One thing that I would like to figure out is how to actually
# generate HTA files instead of HTL files for authentication if
# an authenticator is specified in the OSU configuration.
#
# The OSU configuration file is expected to be of the form:
#
# localaddress (cname | ip number) host name
# configuration statements
# localaddress
#

use strict ;

use File::Basename ;
use FileHandle ;
use VMS::Filespec ;

sub glob2pat {
    my $globstr = shift;
    my %patmap = (
        '*' => '(.*)',
        '?' => '.',
        '[' => '[',
        ']' => ']',
    );
    $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
    return '^' . $globstr . '$';
}

sub dcl
{
	return '$ ' . $_[0] . "\n" ;
} ;

sub convertProtToHTL
{
	my $theFileHandle = new FileHandle "< " . $_[0] ;

	die $_[0] . " does not exist" if (!defined $theFileHandle) ;

	my $theLine ;
	my $theRealm ;
	my @theResult ;

	while (defined($theLine = $theFileHandle->getline()))
	{
		chomp $theLine ;

		if ($theLine =~ m/^<realm>\s+(.*)/)
		{
			$theRealm = $1 ;
		}
		elsif ($theLine =~ m/^(\w+?)\s+(\w+)/)
		{
			push @theResult,$1 . "=" . $2 ;
		}
		elsif ($theLine =~ m/^\s*#/)
		{
			push @theResult,$theLine ;
		}
		else
		{
			push @theResult,"# " . $theLine ;
		}
	}

	my @theReturnValue ;

	$theReturnValue[0] = $theRealm ;
	$theReturnValue[1] = (join "\n",@theResult) . "\n" ;

	return @theReturnValue ;
} ;

my $theBusyCount ;
my $theCurrentHost ;
my $theInputFile = new FileHandle "< " . $ARGV[0] ;
my $theLine ;
my %theLocalAddressBlocks ;
my %theProtectionDomains ;

while (defined($theLine = $theInputFile->getline()))
{
	chomp $theLine ;

	#
	# Ignore blank lines.
	#

	next if ($theLine eq "") ;

	#
	# And comments.
	#

	next if ($theLine =~ m/^\s*#/) ;

	last if ($theLine =~ m/^localaddress\s*(#.*$|$)/i) ;

	#
	# The OSU file local address block provides either a
	# canonical name or an ip address followed by a host
	# name.  We use the host name to define the virtual
	# service.
	#

	if ($theLine =~ m/^localaddress\s+(cname|\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})\s+(localhost|([\w-]+(\.[\w-]+)+))/i)
	{
		$theCurrentHost = $2 ;
		$theLocalAddressBlocks{$theCurrentHost}{'ip'} = $1 ;
	}
	elsif ($theLine =~ m/^localaddress\s+\@listen_backlog=(\d+)/i)
	{
		$theBusyCount = $1 if ($theBusyCount < $1) ;
	}
	elsif ($theLine =~ m/^localaddress/i)
	{
		print "ERROR: ",$theLine,"\n" ;
	}
	else
	{
		if ($theLine =~ m/^\s*protect\s+([^\s]+)\s+([^\s]+)/i)
		{
			if (-e $2)
			{
				$theProtectionDomains{$theCurrentHost}{$1} = $2 ;
			}
			else
			{
				print "ERROR: ",$theLine,"\n" ;
			}
		}
		else
		{
			push @{$theLocalAddressBlocks{$theCurrentHost}{'configuration'}},$theLine ;
		} ;
	}
} ;

undef $theInputFile ;

my $theFileHandle ;

$theFileHandle = rmsexpand('sys$disk:[].httpd$service',$ARGV[0]) ;

$theFileHandle = new FileHandle "> " . $theFileHandle ;

print $theFileHandle "#\n" ;
print $theFileHandle "# Generated from ",$ARGV[0]," by convert-osu-to-wasd.pl\n" ;
print $theFileHandle "#\n" ;

foreach (sort keys %theLocalAddressBlocks)
{
	my $theScheme ;

	foreach $theScheme ("http", "https")
	{
		print $theFileHandle "[[$theScheme://",$_,"]]\n" ;

		print $theFileHandle "[ServiceIpAddress] ",$theLocalAddressBlocks{$_}{ip},"\n" if ($theLocalAddressBlocks{$_}{ip} ne 'cname') ;

		print $theFileHandle "\n" ;
	} ;
} ;

undef $theFileHandle ;

my %theAcls ;

$theFileHandle = rmsexpand('sys$disk:[].httpd$map',$ARGV[0]) ;

$theFileHandle = new FileHandle "> " . $theFileHandle ;

print $theFileHandle "#\n" ;
print $theFileHandle "# Generated from ",$ARGV[0]," by convert-osu-to-wasd.pl\n" ;
print $theFileHandle "#\n" ;

foreach (sort keys %theLocalAddressBlocks)
{
	my @theLengths ;
	my @theResult ;

	foreach (@{$theLocalAddressBlocks{$_}{'configuration'}})
	{
		if (m/^(redirect|map)\s+([^\s]+)\s+([^\s]+)/i)
		{
			push @theResult,[$1, unixify($2), unixify($3)] ;
		}
		elsif (m/^(exec)\s+([^\s]+)\s+([^\s]+)/i)
		{
			push @theResult,[$1, unixify($2), '/0::"task=wwwexec"' . unixify($3) . "*"] ;
		}
		elsif (m/^(pass)\s+([^\s]+)\s*([^\s]*)/i)
		{
			push @theResult,[$1, unixify($2), unixify($3)] ;
		}
		else
		{
			push @theResult,"# " . $_ ;
		}
		
		if ((ref $theResult[$#theResult]) ne "")
		{
			my $theIndex ;

			for ($theIndex = 0; $theIndex < scalar(@{$theResult[$#theResult]}); $theIndex++)
			{
				if ($theLengths[$theIndex] < length($theResult[$#theResult]->[$theIndex]))
				{
					$theLengths[$theIndex] = length($theResult[$#theResult]->[$theIndex]) ;
				}
			}
		} ;
	}

	@{$theLocalAddressBlocks{$_}{result}} = @theResult ;

#	print $theFileHandle "if (host:$_*)\n" ;
	print $theFileHandle "[[",$_,"]]\n" ;

	foreach (@theResult)
	{
		my $theRef = ref $_ ;

		if ($theRef eq "")
		{
			print $theFileHandle "    ",$_,"\n" ;
		}
		else
		{
			my $theIndex ;
			my $theString ;

			for ($theIndex = 0; $theIndex < scalar(@{$_}); $theIndex++)
			{
				$theString = $theString . sprintf("%-" . sprintf("%d", $theLengths[$theIndex]) . "s",$_->[$theIndex]) . " " ;
			} ;
			
			print $theFileHandle "    ",$theString,"\n" ;
		}
	}

#	print $theFileHandle "endif\n" ;
	print $theFileHandle "\n" ;
}

undef $theFileHandle ;

my %theConvertedProtectionDomains ;

$theFileHandle = rmsexpand('sys$disk:[].httpd$auth',$ARGV[0]) ;

$theFileHandle = new FileHandle "> " . $theFileHandle ;

print $theFileHandle "#\n" ;
print $theFileHandle "# Generated from ",$ARGV[0]," by convert-osu-to-wasd.pl\n" ;
print $theFileHandle "#\n" ;

foreach (sort keys %theProtectionDomains)
{
	my $theDomain = $_ ;

#	print $theFileHandle "if (host:",$theDomain,")\n\n" ;
	print $theFileHandle "[[",$theDomain,"]]\n\n" ;

 	foreach (sort keys %{$theProtectionDomains{$theDomain}})
	{
		my $theFileName = $theProtectionDomains{$theDomain}{$_} ;

		if (! exists($theConvertedProtectionDomains{$theFileName})) 
		{
			@{$theConvertedProtectionDomains{$theFileName}} = convertProtToHTL($theFileName) ;
		}

		print $theFileHandle "[\"",$theConvertedProtectionDomains{$theFileName}[0],"\"=",uc((fileparse($theFileName,'\..*'))[0]),"=list]\n" ;
		print $theFileHandle $_," r+w\n" ;
		print $theFileHandle "\n" ;
	}

#	print $theFileHandle "endif\n\" ;
	print $theFileHandle "\n" ;
}

undef $theFileHandle ;

foreach (sort keys %theConvertedProtectionDomains)
{
	$theFileHandle = new FileHandle "> " . rmsexpand('sys$disk:[].$htl',$_) ;

	print $theFileHandle "#\n" ;
	print $theFileHandle "# Converted from $_ by convert-osu-to-wasd.pl\n" ;
	print $theFileHandle "#\n" ;

	print $theFileHandle $theConvertedProtectionDomains{$_}[1] ;

	undef $theFileHandle ;
}

if (defined($theBusyCount))
{
	$theFileHandle = new FileHandle "> " . rmsexpand('sys$disk:[].httpd$config',$ARGV[0]) ;

   	print $theFileHandle "[Busy] ",$theBusyCount,"\n" if (defined($theBusyCount)) ;

	undef $theFileHandle ;
} ;

#
# Produce a DCL procedure that will get "close" to the protections
# necessary to run the OSU content and cgis from the new WASD
# server.  Basically what's happening here is that every directory
# that needs read access (shows up in a redirect, map, or pass)
# will have protection set to:
#
#	S:RWED,O:RWED,G:RE,W:RE
#
# for all files, including directories.
#
# An ACL setting the following will then be applied to the directory
# and all subdirectorys:
#
#       (DEFAULT_PROTECTION,SYSTEM:RWED,OWNER:RWED,GROUP:RE,WORLD:RE)
#
# Which will keep the right protections going.
#
# Execute directories will have the following protections set:
#
#	S:RWED,O:RWED,G:RE,W:E
#
# which will allow anybody to execute things.  An ACL will be placed
# on all directories:
#
#       (DEFAULT_PROTECTION,SYSTEM:RWED,OWNER:RWED,GROUP:RE,WORLD:E)
#
# In addition, all .DAT files (and you will need to do this manually
# for all files that need to be written by these CGIs) will have an
# acl added that allows http$nobody full access.
#
#	(IDENTIFIER=WASD_HTTP_NOBODY,ACCESS=READ+WRITE+EXECUTE+DELETE)
#
# Remember that this is just a template and should be inspected
# carefully before executing.
#

$theFileHandle = rmsexpand('sys$disk:[].set-protection',$ARGV[0]) ;

$theFileHandle = new FileHandle "> " . $theFileHandle ;

print $theFileHandle dcl("!") ;
print $theFileHandle dcl("! Generated from " . $ARGV[0] . " by convert-osu-to-wasd.pl") ;
print $theFileHandle dcl("!") ;
print $theFileHandle dcl("EXIT") ;
print $theFileHandle dcl("") ;

print $theFileHandle dcl('DEFAULT_DIRECTORY = F$ENVIRONMENT("DEFAULT")') ;

foreach (sort keys %theLocalAddressBlocks)
{
	if (exists($theLocalAddressBlocks{$_}{result}) &&
	    scalar(@{$theLocalAddressBlocks{$_}{result}}))
	{
		my $theIndex ;

		OUTER :
		for ($theIndex = 0; $theIndex < scalar(@{$theLocalAddressBlocks{$_}{result}}) - 1; $theIndex++)
		{
			next if (ref(${$theLocalAddressBlocks{$_}{result}}[$theIndex]) eq '') ;

			my @theResults = @{${$theLocalAddressBlocks{$_}{result}}[$theIndex]} ;
			my @theInnerResults ;
			my $theResult = $theResults[2] ;
			my $theInnerIndex ;

			if ($theResults[0] eq 'exec')
			{
				@theInnerResults = @{${$theLocalAddressBlocks{$_}{result}}[$theIndex]} ;
				$theResult = $theInnerResults[2] ;
			}
			else
			{
				for ($theInnerIndex = $theIndex + 1; 
				     $theInnerIndex < scalar(@{$theLocalAddressBlocks{$_}{result}});
				     $theInnerIndex++)
				{
					@theInnerResults = @{${$theLocalAddressBlocks{$_}{result}}[$theInnerIndex]} ;

					my $theMatch = glob2pat($theInnerResults[1]) ;
	
					if ($theResult =~ m/$theMatch/)
					{
						if ($theInnerResults[2] ne '')
						{
							my $theTemp = $1 ;

							$theResult = $theInnerResults[2] ;

							$theResult =~ s/\*/$theTemp/ ;

							last if ($theInnerResults[0] ne 'map') ;
						} ;
					} ;
				} ;
			} ;

			$theResult =~ s/\/.*::.*?\//\// ;

			$theResult = vmsify($theResult) ;

			$theResult =~ s/\].*/\]/ ;

			$theAcls{$theResult}{$theInnerResults[0]}++ ;
		}

	}
}

my $theLastKey ;
my $theLastKeyMatch ;

foreach (sort { $b cmp $a } keys %theAcls)
{
	my $theRoot = $_ ;

	chop $theRoot ;

	if (! defined($theLastKey))
	{
		$theLastKey = $theRoot ;
		$theLastKeyMatch = quotemeta($theLastKey) ;
	}
	elsif ($theRoot =~ m/^$theLastKeyMatch\./)
	{
		my $theMap ;
		my $theOriginalKey = $theLastKey . "]" ;
		my $theUndefFlag = 1 ;

		foreach $theMap ("pass", "exec")
		{
			$theUndefFlag = $theUndefFlag && 
			    (((defined($theAcls{$theOriginalKey}{$theMap})) && (defined($theAcls{$_}{$theMap}))) ||
			     ((!defined($theAcls{$theOriginalKey}{$theMap})) && (!defined($theAcls{$_}{$theMap})))) ;
		} ;

		undef $theAcls{$_} if ($theUndefFlag) ;
	}
	else
	{
		$theLastKey = $theRoot ;
		$theLastKeyMatch = quotemeta($theLastKey) ;
	} 
} ;

foreach (sort keys %theAcls)
{
	next if (!defined($theAcls{$_})) ;

	my $theDirectory = $_ ;

	$theDirectory = uc($theDirectory) ;

	print $theFileHandle dcl("!") ;
	print $theFileHandle dcl("SET DEFAULT $theDirectory") ;
	$theDirectory =~ s/^.+\[([^\]]*).*/$1/ ;

	$theDirectory =~ s/^([^\.]+\.)*// ;

	my $theDirectoryAce ;
	my $theDirectoryProtection ;

	if ((defined($theAcls{$_}{'pass'}) && defined($theAcls{$_}{'exec'})) || defined($theAcls{$_}{'pass'}))
	{
		$theDirectoryAce = "(DEFAULT_PROTECTION,SYSTEM:RWED,OWNER:RWED,GROUP:RE,WORLD:RE)" ;
		$theDirectoryProtection = "(SYSTEM:RWED,OWNER:RWED,GROUP:RE,WORLD:RE)" ;
	}
	else
	{
		$theDirectoryAce = "(DEFAULT_PROTECTION,SYSTEM:RWED,OWNER:RWED,GROUP:RE,WORLD:E)" ;
		$theDirectoryProtection = "(SYSTEM:RWED,OWNER:RWED,GROUP:RE,WORLD:E)" ;
	} ;

	print $theFileHandle dcl("SET FILE /PROTECTION=$theDirectoryProtection [-]$theDirectory.DIR;") ;
	print $theFileHandle dcl("SET FILE /PROTECTION=$theDirectoryProtection [...]*.*;*") ;

	print $theFileHandle dcl("SET ACL /ACL=$theDirectoryAce [-]$theDirectory.DIR;") ;
	print $theFileHandle dcl("SET ACL /LIKE=(OBJECT_TYPE=FILE,OBJECT_NAME=[-]$theDirectory.DIR;) [...]*.DIR;") ;

	my $theDataAce = "(IDENTIFIER=WASD_HTTP_NOBODY,ACCESS=READ+WRITE+EXECUTE+DELETE)" ;

	if (defined($theAcls{$_}{'exec'}))
	{
		print $theFileHandle dcl("SET ACL /ACL=$theDataAce [...]*.DAT;*") ;
	}
} ;

print $theFileHandle dcl("!") ;
print $theFileHandle dcl("SET DEFAULT 'DEFAULT_DIRECTORY'") ;
print $theFileHandle dcl("EXIT") ;

undef $theFileHandle ;
