#!/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