#!../../bin/https/perl/perl
BEGIN {
    @INC = ( '../../bin/https/perl' );
}

use ObjConf;

$| = 1;

die "Usage: $0 obj.conf\n" unless scalar( @ARGV ) == 1;

if ( $ARGV[0] eq '-t' ) {
    &cvtNSconfig( '/u/flc/play/htaccess/.nsconfig',
		  '/u/flc/play/htaccess/.htaccess' );
    exit 0;
}

$obj = new ObjConf( $ARGV[0] ) || die "Can't read $ARGV[0]: $@\n";

foreach $directive ( @{$obj->{'names'}->{'default'}->{'directives'}} ) {
    if ( $directive->{'type'} eq 'NameTrans' ) {
	if ( $directive->{'name'} eq 'pfx2dir' ) {
	    &cvt( $directive->{'params'}->{'dir'} );
	} elsif ( $directive->{'name'} eq 'document-root' ) {
	    &cvt( $directive->{'params'}->{'root'} );
	}
    }
}

# Find .nsconfig files, and convert them to .htaccess files, recursively.
# Keep track of dirs already done, and don't redo them.
sub cvt {
    my	$dir = shift;
    my	$file;
    my	@dirs = ();
    my	$subDir;

    return if $doneDirs{$dir};
    $doneDirs{$dir} = 1;
    print "Going to convert $dir\n";
    if ( opendir( DIR, $dir ) ) {
      while ( $file = readdir( DIR ) ) {
        next if $file =~ /^\.\.?$/;	# skip this and parent directory
        &cvtNSconfig( "$dir/$file", "$dir/.htaccess" ) if $file eq '.nsconfig';
	push( @dirs, $file ) if -d "$dir/$file";
      }
      closedir( DIR );
      foreach $subDir ( @dirs ) {
	&cvt( "$dir/$subDir" );	# recurse
      }
    }
    else {
        print "Can't open $dir: $!\n";
    }
}

sub cvtNSconfig {
    my	$src = shift;
    my	$dest = shift;
    my	%curFiles;

    print "Converting $src to $dest\n";
    open( SRC, $src ) || die "Couldn't read $src: $!\n";
    while ( -f $dest ) {
	print "Not overwriting $dest, consider moving $dest.new to $dest\n";
	$dest .= '.new';
    }
    open( DEST, ">$dest" ) || die "Can't create $dest: $!\n";
    while ( <SRC> ) {
	chomp;
	if ( m'^#' || /^$/ ) {
	    print DEST $_, "\n";
	    next;
	} elsif ( /^<Files\s*/i ) {
	    my	$remainder = $';

	    die "Nested <Files> directives: $src: $..  Can't handle it\n"
		if defined( %curFiles );
	    $remainder =~ s/>\s*$//;
	    if ( $remainder ne '*' ) {
		print "Non-global $_ specification ignored, check $src: $.\n";
	    }
	    $curFiles{'active'} = 1;
	} elsif ( m'^</Files>'i ) {
	    die "Unexpected $_: $src: $.\n" unless defined( %curFiles );
	    delete $curFiles{'active'};
	    &processDirectives( \%curFiles );
	    undef( %curFiles );
	} else {
	    my	$directive;
	    my	$data;

	    ( $directive, $data ) = /^(\w+)\s*(.*)/;
	    push( @{$curFiles{$directive}}, $data );
	}
    }
    close( SRC );
    close( DEST );
}

sub processDirectives {
    my	$directives = shift;
    my	$directive;
    my	$directiveData;
    my	$data;

    print DEST "<Limit GET>\n";
    print DEST "order deny,allow\n";
    print DEST "deny from all\n";	# default
    if ( defined( $directives->{'RestrictAccess'} ) ) {
	my	%params;
	my	$i;
	my	$currentPermission;
	my	$prefix = '';

	for ( $i = 0 ; $i < scalar( @{$directives->{'RestrictAccess'}} ) ; ++$i ) {
	    %params = &parseParams( $directives->{'RestrictAccess'}->[$i] );
	    if ( $params{'type'} ne $currentPermission ) {
		print DEST "$prefix$params{'type'} from";
		$currentPermission = $params{'type'};
		$prefix = "\n";
	    }
	    die "Unexpected method $params{'method'}, can only handle GET\n"
		unless $params{'method'} eq 'GET';
	    if ( defined( $params{'ip'} ) ) {
		my	$ip = $params{'ip'};

		$ip =~ s/^\*\.\*\.\*\.\*$/all/;
		$ip =~ s/\*$//;
		$ip =~ s/(\*\.)+$//g;
		print DEST ' ', $ip;
	    }
	    if ( defined( $params{'dns'} ) ) {
		my	$dns = $params{'dns'};

		$dns =~ s/^\*$/all/;
		$dns =~ s/^\*//;
		$dns =~ s/^(\.\*)+//g;
		print DEST ' ', $dns;
	    }
	}
	print DEST "\n";
    }
    if ( defined( $directives->{'RequireAuth'} ) ) {
	my	%params;
	my	$i;
	my	$users;

	for ( $i = 0 ; $i < scalar( @{$directives->{'RequireAuth'}} ) ; ++$i ) {
	    %params = &parseParams( $directives->{'RequireAuth'}->[$i] );
	    if ( $params{'userlist'} ) {
		( $users = $params{'userlist'} ) =~ s/,/ /g;
		$users = 'user ' . $users;
	    } else {
		$users = 'valid-user';
	    }
	    print DEST "require $users\n";
	    print DEST "AuthType Basic\n";
	    print DEST "AuthName $params{'realm'}\n";
	    #QQQQ If there is no userfile, we're hosed
	    if ( defined( $params{'userfile'} ) ) {
		print DEST "AuthUserFile $params{'userfile'}\n";
	    }
	}
    }
    print DEST "</Limit>\n";
    print DEST "<Limit POST PUT>\n";
    print DEST "order deny,allow\n";
    print DEST "deny from all\n";
    print DEST "</Limit>\n";
}

sub parseParams {
    my	$line = shift;
    my	%params;
    my	$param;
    my	$partParam = '';
    my	$name;
    my	$data;
    my	@quotes;

    foreach $partParam ( split( /\s+/, $line ) ) {
	$param .= $partParam;
	# If quoted spaces, we have to remerge
	@quotes = $param =~ m'[^\\]"'g;
	if ( scalar( @quotes ) % 2 ) {	# odd number
	    $param .= ' ';
	    next;
	}
	$param =~ /=/;
	$params{$`} = &stripQuotes( $' );
	$param = '';
    }
    return %params;
}

sub stripQuotes {
    my	$string = shift;

    $string =~ s/^"//;
    $string =~ s/"$//;

    return $string;
}
