webrcs.pl - web interface to rcs for the admin of server based files
#!/bin/perl5 -- -*- C -*-
push( @INC, "/lib/" ); # the home of cgi-lib.pl
require "cgi-lib.pl";
sub webrcs_header
{
local( $title ) = pop( @_ );
print &PrintHeader;
print "<html>\n";
print "<header>\n";
print "<title>$title</title>\n";
print "</header>\n";
print "<body>\n";
print "<h1>$title</h1>\n";
print "<! $version>";
}
sub webrcs_footer
{
print "</body>\n";
print "</html>\n";
}
# Take as argument a path to a file
# return -1 if the file doesn't exist
# return 0 if the file exists but has no RCS file
# return 1 if the file exists and has an RCS file
sub webrcs_rcsp
{
local( $path ) = pop( @_ );
local( @path, $filename, $dir, $rcsname, $result );
print "<! webrcs_rcsp( path: $path ):" if $Debug;
@path = split( /\//, $path );
$filename = pop( @path );
$dir = join( '/', @path );
$rcsname = $dir . "/RCS/" . $filename . ",v";
if ( -e $path )
{
if ( -e $rcsname )
{
$result = 1;
}
else
{
# no RCS version control on this file
$result = 0;
}
}
else
{
$result = -1;
}
print " $result\n>" if $Debug;
return( $result );
}
sub webrcs_rlog
{
local( $path ) = pop( @_ );
local( @revisions, $revision );
print "<! webrcs_rlog( path: $path )\n>" if $Debug;
print "<! webrcs_rlog: $rlog $path\n>" if $Debug;
open( STREAM, "$rlog $path |" ) || die( "Could not run $rlog $path: $!\n" );
$prevrev = "";
print "<dl compact>\n";
while ( <STREAM> )
{
s/</</g;
s/>/>/g;
if ( /^revision (\S*)/ )
{
$revision = $1;
push( @revisions, $revision );
undef @comments;
undef $year;
undef $month;
undef $day;
undef $hour;
undef $minute;
undef $second;
undef $date;
undef $time;
undef $author;
undef $comments;
}
elsif ( /date: (\d*)\/(\d*)\/(\d*) (\d*):(\d*):(\d*);\s*author: (\w*)/ )
{
$year = $1;
$month = $2;
$day = $3;
$hour = $4;
$minute = $5;
$second = $6;
$author = $7;
}
elsif ( /----------------------------/ || /============================/ ) # separator/terminator
{
if ( "$revision" ne "" ) # first close the previous item
{
if ( "$prevrev" ne "" )
{
print "<li><b>Diff</b>: <a
href=/cgi-bin/${webrcs}?path=${path}&revision=${revision}&diff=${prevrev}${debug
token}>${prevrev} - ${revision}</a>\n";
print "</ul>\n";
}
$comments = join( "/", @comments );
$date = "$year/$month/$day";
$time = "$hour:$minute:$second";
print "<dt><a
href=/cgi-bin/${webrcs}?path=${path}&revision=${revision}${debugtoken}>${revi
sion}</a>\n";
print "<dd>\n";
print "<ul>\n";
print "<li><b>Date+time</b>: ${date} ${time}\n";
print "<li><b>Author\n</b>: ${author}\n";
print "<li><b>Comments</b>: ${comments}\n";
$prevrev = $revision;
}
}
elsif ( "$revision" ne "" )
{ # we're in the revision history
chop;
push( @comments, $_ );
}
}
print "</ul>\n";
print "</dl>\n";
# Now put out the little selector form that lets us diff arbitrary
# versions
if ( $#revisions >= 1 )
{
print "<hr>\n";
print "<p>Compare arbitrary available versions of ${path}\n";
$first = $revisions[ 0 ];
$second = $revisions[ 1 ];
print "<form action=/cgi-bin/${webrcs}>\n";
print "<select name=diff>\n";
print "<option selected> $revisions[0]\n";
foreach $i ( @revisions[1..$#revisions] )
{
print "<option> $i\n";
}
print "</select>\n";
print "<select name=revision selected=${second}>\n";
print "<option> $revisions[0]\n";
print "<option selected> $revisions[1]\n";
foreach $i ( @revisions[2..$#revisions] )
{
print "<option> $i\n";
}
print "</select>\n";
print "<input type=submit value=compare versions>\n";
print "<input type=hidden name=path value=${path}>\n";
print "</form>\n";
}
close( STREAM );
}
sub webrcs_handle
{
local( $path, $revision, $depth ) = @_;
local( $p );
print "<! webrcs_handle( path: $path, revision: $revision, depth: $depth
)\n>" if $Debug;
@path = split( /\//, $path );
$filename = $path[ $#path ];
$r = &webrcs_rcsp( $path );
if ( $r == -1 )
{ # No such file
}
elsif ( $r == 0 )
{ # No RCS file
if ( $depth == 0 )
{
if ( -d $path )
{ # it is a directory ...
print "<pre>\n";
opendir( DIR, $path ) || die "Could not open directory $path: $1";
@files = readdir( DIR );
closedir( DIR );
for ( sort @files )
{
next if /^\.$/;
next if /^\.[^.]+$/;
$p = "$path/$_";
&webrcs_handle( $p, $revision, $depth + 1 );
}
print "</pre>\n";
}
else
{ # a plain file (uh, Marc, ...)
print "<pre>\n";
open( STREAM, "< $path" ) || die "Could not open $path: $!";
while ( <STREAM> )
{
print;
}
close( STREAM );
print "</pre>\n";
}
}
else
{
if ( -d $path )
{
if ( "$filename" eq ".." )
{
print "<a href=/cgi-bin/${webrcs}?path=$path${debugtoken}>Up
to higher level directory</a>\n";
}
else
{
print "<a
href=/cgi-bin/${webrcs}?path=$path${debugtoken}>$directoryhtml
$filename</a>\n";
}
}
else
{
print "<a
href=/cgi-bin/${webrcs}?path=$path${debugtoken}>$unknownhtml
$filename</a>\n";
}
}
}
else
{ # an RCS file
if ( "$revision" ne "" )
{
if ( "$diff" ne "" )
{
print "<h2>Version ${diff}</h2>\n";
print "(New text in <b>bold</b>, old text in
<i>italic</i>.)\n";
}
else
{
print "<h2>Version ${revision}</h2>\n";
}
print "<pre>\n";
if ( "$diff" ne "" )
{
$flag = "WebRCS" . $$ . "SCRbeW";
if ( "$diff" eq "latest" )
{
$rcscmd = "${rcsdiff} -D${flag} ${path}";
print "<! rcscmd: $rcscmd\n>" if $Debug;
open( STREAM, "${rcscmd} |" ) || die "Could not rcsdiff $path with
most recently checked in version: $!";
}
else
{
$rcscmd = "${rcsdiff} -D${flag} -r${diff} -r${revision} ${path}";
print "<! rcscmd: $rcscmd\n>" if $Debug;
open( STREAM, "${rcscmd} |" ) || die "Could not rcsdiff $revision
with $diff for $path: $!";
}
}
elsif ( "$revision" eq "latest" )
{
$rcscmd = "${co} -p ${path}";
print "<! rcscmd: $rcscmd\n>" if $Debug;
open( STREAM, "${rcscmd} |" ) || die "Could not check out revision
$revision of $path: $!";
}
else
{
$rcscmd = "${co} -p${revision} ${path}";
print "<! rcscmd: $rcscmd\n>" if $Debug;
open( STREAM, "${rcscmd} |" ) || die "Could not check out revision
$revision of $path: $!";
}
$state = "basic";
while ( <STREAM> )
{
if ( "$diff" eq "latest" )
{
if ( /^#ifndef $flag/ )
{
chop;
$state = "old";
print "<! $_ [state: $state]\n>" if $Debug;
print "<hr><i>";
next;
}
elsif ( /^#ifdef $flag/ )
{
chop;
$state = "new";
print "<! $_ [state: $state]\n>" if $Debug;
print "<hr><b>";
next;
}
elsif ( m|^#else /\* ${flag} \*/| )
{ # else means a new -> old transition
chop;
$state = "new";
print "<! $_ [state: $state]\n>" if $Debug;
print "</i><hr><b>";
next;
}
elsif ( m|^#endif /\* (not )*${flag} \*/| )
{
chop;
$state = "basic";
print "<! $_ [state: $state]\n>" if $Debug;
if ( "$state" eq "old" )
{
print "</i><hr>";
}
else
{ # old
print "</b><hr>";
}
next;
}
}
elsif ( "$diff" ne "" )
{
if ( /^#ifndef $flag/ )
{
chop;
$state = "new";
print "<! $_ [state: $state]\n>" if $Debug;
print "<hr><b>";
next;
}
elsif ( /^#ifdef $flag/ )
{
chop;
$state = "old";
print "<! $_ [state: $state]\n>" if $Debug;
print "<hr><i>";
next;
}
elsif ( m|^#else /\* ${flag} \*/| )
{ # else means a new -> old transition
chop;
$state = "old";
print "<! $_ [state: $state]\n>" if $Debug;
print "</b><hr><i>";
next;
}
elsif ( m|^#endif /\* (not )*${flag} \*/| )
{
chop;
$state = "basic";
print "<! $_ [state: $state]\n>" if $Debug;
if ( "$state" eq "new" )
{
print "</b><hr>";
}
else
{ # old
print "</i><hr>";
}
next;
}
}
s/</</g;
s/>/>/g;
print $_;
}
close( STREAM );
print "</pre>\n";
}
elsif ( $depth == 0 )
{
&webrcs_rlog( $path );
}
else
{
print "<a
href=/cgi-bin/${webrcs}?path=$path${debugtoken}&revision=latest>$unknownhtml
$filename</a> <a
href=/cgi-bin/${webrcs}?path=$path${debugtoken}>$rcshtml</a>\n";
}
}
}
# This makes the URLs created use the same name as this actual
# script. Makes testing easier.
@toks = reverse( split( /\//, $0 ) );
$webrcs = @toks[ 0 ] || "webrcs";
$rlog = "/var/adm/mach/bin/rlog";
$co = "/var/adm/mach/bin/co";
$rcsdiff = "/usr/bin/rcsdiff";
$unknownhtml = '<IMG ALIGN=absbottom BORDER=0
SRC="internal-gopher-unknown">';
$directoryhtml = '<IMG ALIGN=absbottom BORDER=0
SRC="internal-gopher-menu">';
$rcshtml = '<img align=absbottom border=0 src=/icons/rcs.gif>';
$debugtoken = '';
$Debug = 0;
if ( &ReadParse( *input ) )
{
if ( $input{ 'debug' } )
{
$Debug = 1;
$debugtoken = '&debug=1';
}
if ( $input{ 'path' } )
{
$path = $input{ 'path' };
if ( "substr( $path, length( $path ) - 1 )" eq "/" )
{
chop( $path );
}
}
if ( $input{ 'revision' } )
{
$revision = $input{ 'revision' };
}
if ( $input{ 'diff' } )
{
$diff = $input{ 'diff' };
}
&webrcs_header( "Path: $path" );
if ( $Debug )
{
for $i ( sort( keys( %input ) ) )
{
print "<! main: input{ $i }: $input{ $i }\n>";
}
}
&webrcs_handle( $path, $revision, 0 );
&webrcs_footer;
}
else
{
&webrcs_header( "webrcs error" );
print "<br><h2>Error!</h2><hr>Please use URLs like
webrcs?path=file\n";
};