use strict;
use FileHandle;
use Fcntl ':flock';
use File::Path qw( mkpath );
use LWP;
my $Tdir = '/home/north/www/webdot/tmp';
my $DotFontPath = '/home/north/lib/fonts/dos/windows/fonts';
my $GraphvizBinDir = '/home/north/arch/linux.i386/bin';
my $EPSIfilter = '/usr/bin/ps2epsi';
my $GS = '/usr/bin/gs';
my $SigCommand = '/usr/bin/cksum';
my %KnownTypes = (
dot => 'application/x-dot',
gif => 'image/gif',
png => 'image/png',
mif => 'application/x-mif',
hpgl => 'application/x-hpgl',
pcl => 'application/x-pcl',
vrml => 'x-world/x-vrml',
vtx => 'application/x-vtx',
ps => 'application/postscript',
epsi => 'application/postscript',
pdf => 'application/pdf',
map => 'text/plain',
txt => 'text/plain',
src => 'text/plain',
svg => 'image/svg+xml',
);
my %KnownServers = ( 'dot' => 1, 'neato' => 1 , 'twopi' => 1 );
my $ContentType = 'text/plain';
my $TheGoods = 'Server Error, profound apologies';
sub trouble {
$TheGoods = shift;
$ContentType = 'text/plain';
}
sub run_under_lock {
my ($fh, $cmd) = @_;
my $rc;
flock($fh, LOCK_EX); truncate($fh, 0); $rc = system($cmd); unless ($rc == 0) {
trouble("Server error: Non-zero exit $rc from $cmd\n");
return;
}
flock($fh, LOCK_SH); return 1;
}
sub up_doc {
my ($base, $url, $layouter, $tag) = @_;
my $dotdir = "$Tdir/$layouter/$base";
my $dotfile = "$dotdir/source";
my $tagfile = "$dotdir/$tag";
my $dotfh = new FileHandle;
my $tagfh = new FileHandle;
my $fh = new FileHandle;
my ($size, $mtime, $cmd, $webdoc, $content);
my ($ttime, $rc);
my $now = time();
my ($oldsig, $newsig);
unless (-d $dotdir) {
unless (mkpath( [ $dotdir ], 0, 02775)) {
trouble("Server error: Unable to make directory $dotdir: $!");
return;
}
}
unless (open($dotfh, "+>> $dotfile")) {
trouble("Server error: Open failed on $dotfile: $!");
return;
}
flock($dotfh, LOCK_SH);
($size, $mtime) = (stat($dotfh))[7,9];
$oldsig = ($size > 0? `$SigCommand $dotfile` : 0);
my $browser = LWP::UserAgent->new(); $browser->agent("Kipper Browser"); $webdoc = $browser->request(HTTP::Request->new(GET => $url));
if($webdoc->is_success){ $content = $webdoc->content();
flock($dotfh, LOCK_EX);
truncate($dotfh, 0);
print $dotfh $content;
$dotfh->autoflush();
flock($dotfh, LOCK_SH);
($size, $mtime) = (stat($dotfh))[7,9];
} else { trouble("Server error: Could not find $url\n");
return;
}
($size, $mtime) = (stat($dotfh))[7,9];
unless ($size) {
trouble("Empty dot source\n");
return;
}
unless (open($tagfh, "+>> $tagfile")) {
trouble("Server error: Open failed on $tagfile: $!");
return;
}
flock($tagfh, LOCK_SH);
($size, $ttime) = (stat($tagfh))[7,9];
$newsig = `$SigCommand $dotfile`;
if (($size == 0) || ($oldsig ne $newsig)) {
my $dottag = $tag;
my $tmpfile;
my $tmpfh;
if (($tag eq 'epsi') || ($tag eq 'pdf')) {
$dottag = 'ps';
$tmpfile = "$dotdir/ps";
$tmpfh = new FileHandle;
unless (open($tmpfh, "+>> $tmpfile")) {
trouble("Server error: Open failed on $tmpfile: $!");
return;
}
} else {
$tmpfile = $tagfile;
$tmpfh = $tagfh;
}
$cmd = "DOTFONTPATH=\"$DotFontPath\" $GraphvizBinDir/$layouter -T$dottag < $dotfile > $tmpfile";
return unless (run_under_lock($tmpfh, $cmd));
if ($tag eq 'epsi') {
$cmd = "$EPSIfilter < $tmpfile > $tagfile";
return unless (run_under_lock($tagfh, $cmd));
} elsif ($tag eq 'pdf') {
$cmd = "$GS -q -dNOPAUSE -dBATCH -sDEVICE=pdfwrite -sOutputFile=$tagfile $tmpfile";
return unless (run_under_lock($tagfh, $cmd));
}
}
seek($tagfh,0,0);
{
local($/); $TheGoods = <$tagfh>;
}
1;
}
sub get_dot {
my $urltag = shift;
my ($url, $base, $layouter, $tag);
if ($urltag =~ /^(.+)[.]([^.]+)[.]([^.]+)$/) {
($url, $layouter, $tag) = ($1, $2, $3);
unless ($KnownServers{$layouter}) {
trouble("Unknown layout service $layouter from $url\n");
return;
}
unless ($ContentType = $KnownTypes{$tag}) {
trouble("Unknown tag type $tag from $url\n");
return;
}
($base = $url) =~ s%[/:]%-%g; up_doc($base, $url, $layouter, $tag);
} else {
trouble("Unknown url format: $url\n");
}
}
sub show_results {
my $size = length($TheGoods);
print <<EOF ;
Content-type: $ContentType;
Content-length: $size
Pragma: no-cache
EOF
print($TheGoods);
}
sub main {
my $arg;
if ($arg = ($ENV{'PATH_INFO'})) {
$arg =~ s:/::;
}
else {
$arg = $ARGV[0];
}
get_dot($arg);
show_results();
}
main();