#!/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";
}
my $editor = $ENV{EDITOR} || $ENV{VISUAL} || ‘/bin/vi’;
my $re = shift;
my @files = @ARGV;
&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;
}
chahn
