#!/usr/bin/perl
# Author: Christopher Hahn, 2006

sub usage {
print STDERR <<EOT;
usage:
$0 <match> [<path> [...]]

Find and edit Apache virtual hosts matching <match>

<path> Path to an Apache conf to edit.
If a directory, equivalent to all files in <path>/
If omitted, "./" is assumed

<match> is a PERL regular expression to match against ServerName or
ServerAlias for the virtual host entry you want to edit.

If <match> is not found and <path> evaluates to a single file (extant or not)
a template is provided to append a VirtualHost to the file.
EOT

die "\n";
}

&usage unless $re;

my $rv = 0;
my $rc = 0;

# Put something in front so the script won't match itself. :)
my $template = "
V<VirtualHost *>
V ServerName $re
V ServerAlias *.$re
V # DocumentRoot /content/data/$re/htdocs/
V # DocumentRoot /spln/data/
V # Redirect / http://
V # RedirectMatch ^(.*) http://
V</VirtualHost>
";
$template =~ s/^V//mg;

$re = qr/.*?$re/;

@files = ( '.' ) unless @files;
@files = build_file_list(@files);

my $edit_file = "virt.$$";

foreach $file (@files) {
# A single success is considered an overall success
$rc = virt($re, $file);
if($rc < 1 && $rv) { $rv = 0 }
else { $rv = $rc }
}

if($rv > 0) {
print $rv;
die "$!\n";
}

unlink $edit_file;
if( $rv == -1 && $#files == 0 ) {
open EDITFILE, '>>', $edit_file;
print EDITFILE $template;
close EDITFILE;

open TARGFILE, '>>', $files[0];
print TARGFILE edit($edit_file);
close TARFILE;
}

# copy each matching virt to a temp file and run our editor (edit()) against it
# then copy the virt back into place and rewrite the rest of the file
sub virt {
my $re = shift;
my $file = shift;

my $invirt = -1; # position within the file when in a virt
my @virt_content = ();
my $match_flag = 0; # whether we are 'in' a matching virt
my $any_match = 0; # whether we have matched any virt
my $tmpfile = new_temp_file();

return $! unless open(IN, '+<', $file);
return $! unless open(OUT, '+>', $tmpfile);

while(<IN>) {
if($invirt < 0) {
if(/^\s*<VirtualHost/) {
$invirt = tell IN;
$match_flag = 0;
@virt_content = ("#!! You are editing $file. Leave this line here please.\n", $_);
} else {
# Not part of a virt at all, so continue on our merry way...
print OUT $_;
}

} else {
# we're in a virt, so add the line
push @virt_content, $_;

# is it a match?
if(/^\s*Server(?:Name|Alias) $re/) {
$any_match = $match_flag = 1;

} elsif(/^\s*<\/VirtualHost/) {
# End of a virt -- to edit, or not to edit?
if( $match_flag ) {
unless(open EDIT, '>', $edit_file) {
warn "Write to $edit_file failed: $!\n";
return $!;
}

print EDIT @virt_content;
close EDIT;

@virt_content = edit($edit_file);
}

shift @virt_content;
print OUT @virt_content;
$invirt = -1;
}
}
}

if($any_match) {
unlink $edit_file;
# Why not just move it a la rename()?
# Well think about it -- that's a new inode with a new ctime,
# possibly the wrong perms, and the old file might be open
# elsewhere, meaning a dangling file somewhere... et cetera.
seek OUT, 0, 0; # $tmpfile
seek IN, 0, 0; # $file

print IN $_ while <OUT>;

close IN;
unless(truncate $file, tell OUT) {
warn "Truncating $file failed: $!\n";
return $!;
}
close OUT;

} else {
close OUT;
close IN;
}

unlink $tmpfile;

return 0 if $any_match;
return -1;
}

sub build_file_list {
my @in_files = @_;
my @files = ();

foreach $file ( @in_files ) {
if( -d $file ) {
push @files, dirlist( $file );
} else {
push @files, $file;
}
}

return @files;
}

sub new_temp_file {
my $file = '/tmp/virt.';
my @c = split(//, 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890-_');

do {
$file .= $c[ rand @c ];

} while(-e $file);

return $file;
}

sub dirlist {
my $dir = shift;
my @files = ();

die "$dir: $!\n"
unless opendir DIR, $dir;

-f "$dir/$_" && push @files, $_
while $_ = readdir DIR;

closedir DIR;

return @files;
}

sub edit {
my $file = shift;
my @contents = ();

system "$editor $file";

die "Failed reading $file after edit: $!\n"
unless open EDITFILE, $file;

@contents = <EDITFILE>;

close EDITFILE;

return @contents;
}