#!/usr/bin/perl -T

=head1 NAME

editconf - edit apache httpd.conf files

=head1 SYNOPSIS

Usage: editconf [--add|--remove] [OPTIONS]

=cut

use strict;
use warnings;

use Pod::Usage;
use Getopt::Long;
use Data::Dumper;
use Tie::File;
use Fcntl ':flock';
use subs;

sub virtualhost_blocks ;
sub search_by_servername($@);
sub remove_block($);
sub add_block($$$$);
sub get_valid_range($);
sub help ;

# Conf file to work with
my $conf_file = "./httpd.conf";

# Should we remove comments above and/or below blocks we delete?
my $clean_remove = 1;
my $clean_remove_below = 1;

# What serveradmin to write to new VirtualHost blocks
my $serveradmin = 'webmaster@lemonlime.se';

# Name of the VirtualHost we write
my $virtualhost = "85.112.166.69";


my %conf;
my @conf = ();
my @blocks = ();

# Set some sane defaults;
$conf{verbose} = 0;
$conf{debug} = 0;
$conf{force} = 0;

# Get arguments
GetOptions(\%conf,
        "verbose|v",
        "debug",
        "force|F",
        "add|a",
        "remove|r",
        "webroot|w=s",
        "servername|s=s",
        "user|u=s",
        "group|g=s",
        "help|h|?",
) or pod2usage(2);

=head1 OPTIONS
    
    Only one action can be specified at a time

    -a, --add                   Adds a new VirtualHost block
        -w, --webroot=NAME      Webroot to add to add to conf
        -s, --servername=NAME   Servername to add to add to conf
        -u, --user=USER         User to add to conf
        -g, --group=GROUP       Group to add to conf

    -r, --remove                Removes a VirtualHost block
        -s, --servername=NAME   Servername to search for and remove
        -F, --force             Force removal if several matches (removes all matching blocks)

    -v, --verbose               Print verbose messages
    -d, --debug                 Print debug messages (noisy)
    -h, --help                  Brief help message

=cut

pod2usage(1) if $conf{help};

# Some early sanity checks
if ($conf{add}) {
    pod2usage("You didn't specify one of the needed options, see --help")
        unless ($conf{webroot} and $conf{servername} and $conf{user} and $conf{group});
} elsif ($conf{remove}) {
    pod2usage("You have to specify -servername") unless $conf{servername};
} else {
    pod2usage("No action specified, see --help\n");
}

# Sanitize tainted data


##
# Main
##

# Prepare for flock'ing
open(LOCK, "<", $conf_file) or die "Can't open $conf_file: $!";
tie @conf, 'Tie::File', $conf_file or die "Can't open $conf_file: $!";

# Get or wait for a file lock on $conf_file
print "Setting file lock on ${conf_file} ..." if $conf{verbose};
flock(LOCK,LOCK_EX);
print " done!\n" if $conf{verbose};

# Getting blocks

# Handle action
if ($conf{add}) {
    add_block($conf{webroot}, $conf{servername}, $conf{user}, $conf{group});
    print "Successfully added webroot \"$conf{webroot}\" to $conf_file\n" if $conf{verbose};
} elsif ($conf{remove}) {
    @blocks = virtualhost_blocks;
    my @matches = search_by_servername($conf{servername}, @blocks);
    my $ies = $#matches == 1 ? "entry" : "entries";

    # Delete backwards so we don't change the offset of the preceeding lines
    foreach my $match (reverse(@matches)) {
        if (remove_block($match)) {
            print "Removed block $match\n" if $conf{verbose};
        } else {
            print "Failed to remove block\n";
        }
    }

    print "Removed ", $#matches + 1, " $ies\n";
}

# Add block

# Release the file lock we have on $conf_file
flock(LOCK,LOCK_UN);

##
# Subs
##

# Get the line numbers of all <VirtualHost> blocks in @conf, putting them in an array with the syntax $blocks[$i]="start,end"
sub virtualhost_blocks {
    my ($start,$end) = qw(0 0);
    my @blocks = ();

    for (my $i=0; $i < scalar(@conf); $i++) {
        $_ = $conf[$i];

        if (!$start and /^\s*\<VirtualHost .+\>/) { # Make sure that another unfinished startblock isn't matched already
            $start = $i;
            print "Found start of block at $start\n" if $conf{debug};
        } elsif ($start and /^\s*\<\/VirtualHost\>/) { # An $end without a $start is a httpd.conf syntax error
            $end = $i;
            push(@blocks, "$start,$end");
            print "Found end of block at $end\n" if $conf{debug};
            ($start,$end) = (0,0);

        # Handle the above error conditions
        } elsif (!$start and /^\s*\<\/VirtualHost\>/) {
            die "Syntax error in $conf_file(line ", $i + 1, "): Found a </VirtualHost> without a matching <VirtualHost> before it. Missing <VirtualHost>\n";
        } elsif ($start and /^\s*\<VirtualHost\>/) {
            die "Syntax error in $conf_file(line " . $i + 1 . "): Starting a new <VirtualHost> before closing the last. Missing </VirtualHost>\n";
        }
    }

    return @blocks;
}

# Searches for a VirtualHost block containing a ServerName matching $search
# and returns the position of that block, or false
# Takes 2 arguments, $search and @blocks
sub search_by_servername($@) {
    my ($start,$end,$match);
    my $search = shift;
    my @blocks = @_;
    my @matches = ();

    print "Searching for: \"$search\"\n" if $conf{verbose};

    return 0 unless $search;
    return 0 unless @blocks;

    foreach (@blocks) {
        ($start,$end) = get_valid_range(shift);

        for (my $i=$start; $i <= $end; $i++) {
            $_ = $conf[$i];

            # Only match on "^[spaces*]ServerName[spaces+]domain.se[spaces*]$"
            # "     ServerName moe.lemonlime.se  " will match.
            # "ServerName     moe.lemonlime.se" will match
            # "ServerName moe.lemonlime.se" will match
            # "ServerName moe.lemonlime.se x" will not match
            # "xServerName moe.lemonlime.se" will not match
            if (/\s*ServerName\s+($search)\s*$/) { 
                push(@matches, "$start,$end");
                print "Found match on block spanning over lines $start - $end\n" if $conf{verbose};
            }
        }
    }

    if (! $conf{force} and $#matches > 0) {
        die "Got ", $#matches + 1, " matches on one ServerName (search: $search), use -F to force removal of all of them";
    }

    return @matches;
}

sub remove_block($) {
    my ($start,$end) = get_valid_range(shift);

    my $length = $end - $start + 1; # How long the block is

    # Remove # commented lines above the <VirtualHost> block we're removing.
    # If you want to keep a speciffic comment from being removed with this
    # option turned on you must comment in this way: "# KEEP <your text here>"
    if ($clean_remove) {
        for (my $i = $start - 1; $conf[$i] =~ /^\s*\#[^\s*KEEP]/; $i--) {
            $start--;
            $length++;

            print "Found comment on line ", $start + 1 ,": new start and length values: $start,$length\n" if $conf{debug};
        }

        # Also remove comments BELOW the block?
        if ($clean_remove_below) {
            for (my $i = $end + 1; $conf[$i] =~ /^\s*\#[^\s*KEEP]/; $i++) {
                $end++;
                $length++;

                print "Found comment on line ", $end + 1 ,": new start and length values: $start,$length\n" if $conf{debug};
            }
        }
    }

    for (my $i = $end + 1; defined $conf[$i] and $conf[$i] =~ /^(\s*|\t*)$/; $i++) {
        $end++;
        $length++;

        print "Found blank line on line ", $end + 1 ,": new start and length values: $start,$length\n" if $conf{debug};
    }

    # Delete everything between $start to $start+$length in @conf
    my @removed_lines = splice(@conf,$start,$length) or die "Couldn't remove block";

    # Check if we actually did remove the right ammount of lines
    print "Removed ", $#removed_lines + 1, " lines in block spanning from $start to ", $start + $length, "\n" if $conf{debug};

    return 0 unless $#removed_lines + 1 == $length;

    return 1;
}

sub add_block($$$$) {
    my $data;

    my $webroot = shift;
    my $servername = shift;
    my $user = shift;
    my $group = shift;

    if ($conf[$#conf] !~ /(\s*|\t*)$/) {
        $data .= "\n";
    }

    # Add a newline if there isn't already one at the end of the file (tidy)
    $data .= "\n" if $conf[$#conf] !~ /(\s*|\t*)$/;

    $data .= "# Generated " . gmtime() . "\n";
    $data .= "<VirtualHost $virtualhost>\n";
    $data .= "  ServerAdmin $serveradmin\n";
    $data .= "  DocumentRoot /usr/www-root/kunder/$webroot\n";
    $data .= "  ServerName $servername\n";
    $data .= "  ServerAlias $servername\n";
    $data .= "  ErrorLog /www/logs/${servername}-error_log\n";
    $data .= "  CustomLog /www/logs/${servername}-access_log combined\n";
    $data .= "  User $user\n";
    $data .= "  Group $group\n";
    $data .= "  Alias /icon/ \"/www/icons/\"\n";
    $data .= "</VirtualHost>\n";
    $data .= "\n";

    return push(@conf, $data) or
        die "Can't add block to $conf_file";
}

# Check if a range "start,end" is valid, and return them in list context or die.
sub get_valid_range($) {
    my ($start,$end) = split(/,/,shift);

    die "Start value: \"$start\" is invalid" unless $start =~ /^\d+/;
    die "End value: \"$end\" is invalid" unless $end =~ /^\d+/;
    die "Start of range is below 0 (start: $start)" unless $start > 0;
    die "End of range is less than start of range (start: \"$start\" end: \"$end\")" unless $end > $start;
    
    return ($start,$end);
}

__END__

=head1 DESCRIPTION

B<This program> will add or remove a <VirtualHost> block to an apache conf file

=cut