1
0
mirror of https://github.com/php/web-php.git synced 2026-03-30 11:12:09 +02:00
Files
archived-web-php/new/cvsweb.cgi
Rasmus Lerdorf 942a3cc627 Moving lots of stuff into new interface
Colin, could we change the "in the News" button to "Sites"?  I figure
imporant news will go on the front page anyway.

And, could you have a look at the sites page?  At the very least we should
match up the blue colour, but I bet you have a cooler-looking way of
putting up these URL's!
1998-03-04 03:28:27 +00:00

544 lines
16 KiB
Perl
Executable File

#!/usr/local/bin/perl -s
$cvsroot = '/repository/php3';
# Set $rcsbinaries to the location of the RCS binaries, if they're
# not in the web server's $PATH
#$rcsbinaries = '/usr/local/bin';
# The HTML title will be $title: /pathname
$title = "PHP Version 3.0 CVS Tree";
# The HTML to go inside the <H1> tag
$h1 = 'PHP Version 3.0 CVS Tree';
# $intro is the HTML that is displayed along with the
# top-level tree
$intro = "
<blockquote>This is a WWW interface to PHP Version 3.0 CVS Tree. You can get your own copy of the
tree by using a CVS client from your own system. If you don't already have one, you will
find one at <a href=\"http://www.cyclic.com/\">http://www.cyclic.com/</a>. You can get your
own copy of the tree with the commands:
<PRE> cvs -d :pserver:cvsread\@www.lerdorf.on.ca:/repository login</PRE>
When it asks you for a password enter: <b>phpfi</b><P>
Then type:
<PRE> cvs -d :pserver:cvsread\@www.lerdorf.on.ca:/repository checkout php3</PRE>
This will create a php3 directory in your current directory. It will
take a bit of time, especially if your network connection is slow.
But once it is done, you will have an up to date copy of the master
CVS source tree. You can then at any time cd into this directory and
type:
<PRE> cvs update -d</PRE>
to update your source tree to be in sync with the master tree.<P>
In order to compile php from this master source tree you will need the GNU
yacc replacement called Bison (at least version 1.25) as well as the GNU lex
replacement called flex. Both are available at <a href=\"ftp://prep.ai.mit.edu/pub/gnu/\">
ftp://prep.ai.mit.edu/pub/gnu/</a>.
Keep in mind that the CVS version may not always compile, or if it does
compile, it may not be stable. The CVS version is a development version
and should be treated as such.<P>
If you plan on making significant contributions to the PHP code,
CVS write access is available. E-mail <a href=\"mailto:rasmus\@lerdorf.on.ca\">
rasmus\@lerdorf.on.ca</a> for more information.</blockquote>
<p>
";
#
# $shortinstr is the HTML displayed at the top of non-top-level
# directory listings.
$shortinstr = "
Click on a directory to enter that directory. Click on a file to display
its revision history and to get a
chance to display diffs between revisions.
";
#
# $backicon is the icon to be used for the previous directory, if any
$backicon = "/icons/back.gif";
# $diricon is the icon to be used for a directory, if any
$diricon = "/icons/dir.gif";
# $texticon is the icon to be used for a text file, if any
$texticon = "/icons/text.gif";
#
# $tailhtml is the html for the bottom of the page
$tailhtml ="<ADDRESS><A HREF=\"mailto:rasmus\@lerdorf.on.ca\">rasmus\@lerdorf.on.ca</A></ADDRESS>";
##### End configuration section
require 'timelocal.pl';
require 'ctime.pl';
$cvswebversion = "1.0";
$ENV{'PATH'} = "/usr/local/bin:/usr/bin";
$verbose = $v;
($where = $ENV{'PATH_INFO'}) =~ s|^/||;
$where =~ s|/$||;
$fullname = $cvsroot . '/' . $where;
($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|;
$scriptname =~ s|/$||;
$scriptwhere = $scriptname . '/' . $where;
$scriptwhere =~ s|/$||;
if (!-d $cvsroot) {
&fatal("500 Internal Error",'$CVSROOT not found!');
}
if (-d $fullname) {
# Something that would be nice to support, although I have no real
# good idea of how, would be to get full directory diff's, using
# symbolic names (revision numbers would be meaningless).
# The problem is finding a list of symbolic names that is common
# to all the files in the directory.
#
opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!");
@dir = readdir(DIR);
closedir(DIR);
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>${title}: /$where</TITLE></HEAD>\n";
print "<BODY>\n";
print "<!-- Generated by cvsweb version $cvswebversion -->\n";
print "<H1>$h1</H1>\n<HR>\n";
if ($where eq '') {
print $intro;
} else {
print $shortinstr;
}
print "<p>Current directory: <b>/$where</b>\n";
print "<P><HR>\n";
# Using <MENU> in this manner violates the HTML2.0 spec but
# provides the results that I want in most browsers. Another
# case of layout desires spooging up HTML.
print "<MENU>\n";
foreach (sort @dir) {
if ($_ eq '.') {
next;
}
if ($_ eq '..') {
next if ($where eq '');
($updir = $scriptwhere) =~ s|[^/]+$||;
if (defined($backicon)) {
print "<IMG SRC=\"$backicon\" ALT=\"[UP ]\">";
} else {
print "[UP ]";
}
print " ", &link("Previous Directory",$updir), "<BR>";
} elsif (-d $fullname . "/" . $_) {
if (defined($diricon)) {
print "<IMG SRC=\"$diricon\" ALT=\"[DIR]\">";
} else {
print "[DIR]";
}
print " ",
&link($_ . "/", $scriptwhere . '/' . $_ . '/'), "<BR>";
} elsif (s/,v$//) {
if (defined($texticon)) {
print "<IMG SRC=\"$texticon\" ALT=\"[TXT]\">";
} else {
print "[TXT]";
}
print " ", &link($_, $scriptwhere . '/' . $_), "<BR>";
}
}
print "</MENU>\n";
print "<HR><font size=-1><i>Created by cvsweb $cvswebversion</i></font>\n";
# print $tailhtml,"\n";
print "</BODY></HTML>\n";
} elsif (-f $fullname . ',v') {
if ($_ = $ENV{'QUERY_STRING'}) {
s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
if (/rev=([\d\.]+)/) {
$rev = $1;
open(RCS, "co -p$rev '$fullname' 2>&1 |") ||
&fail("500 Internal Error", "Couldn't co: $!");
# /home/ncvs/src/sys/netinet/igmp.c,v --> standard output
# revision 1.1.1.2
# /*
$_ = <RCS>;
if (/^$fullname,v\s+-->\s+standard output\s*$/o) {
# As expected
} else {
&fatal("500 Internal Error",
"Unexpected output from co: $_");
}
$_ = <RCS>;
if (/^revision\s+$rev\s*$/) {
# As expected
} else {
&fatal("500 Internal Error",
"Unexpected output from co: $_");
}
$| = 1;
print "Content-type: text/plain\n\n";
# print "Content-encoding: x-gzip\n\n";
# open(GZIP, "|gzip -1 -c"); # need lightweight compression
# print GZIP <RCS>;
# close(GZIP);
print <RCS>;
close(RCS);
exit;
}
if (/r1=([^&:]+)(:([^&]+))?/) {
$rev1 = $1;
$sym1 = $3;
}
if ($rev1 eq 'text') {
if (/tr1=([^&]+)/) {
$rev1 = $1;
}
}
if (/r2=([^&:]+)(:([^&]+))?/) {
$rev2 = $1;
$sym2 = $3;
}
if ($rev2 eq 'text') {
if (/tr2=([^&]+)/) {
$rev2 = $1;
}
}
if (!($rev1 =~ /^[\d\.]+$/) || !($rev2 =~ /^[\d\.]+$/)) {
&fatal("404 Not Found",
"Malformed query \"$ENV{'QUERY_STRING'}\"");
}
#
# rev1 and rev2 are now both numeric revisions.
# Thus we do a DWIM here and swap them if rev1 is after rev2.
# XXX should we warn about the fact that we do this?
if (&revcmp($rev1,$rev2) > 0) {
($tmp1, $tmp2) = ($rev1, $sym1);
($rev1, $sym1) = ($rev2, $sym2);
($rev2, $sym2) = ($tmp1, $tmp2);
}
#
$difftype = "-u";
$diffname = "Unidiff";
if (/f=([^&]+)/) {
if ($1 eq 'c') {
$difftype = '-c';
$diffname = "Context diff";
}
}
# XXX should this just be text/plain
# or should it have an HTML header and then a <pre>
print "Content-type: text/plain\n\n";
# open(RCSDIFF, "rcsdiff $difftype -r$rev1 -r$rev2 '$fullname' 2>&1 |") ||
open(RCSDIFF, "rcsdiff -c -r$rev1 -r$rev2 '$fullname' 2>&1 |") ||
&fail("500 Internal Error", "Couldn't rcsdiff: $!");
#
#===================================================================
#RCS file: /home/ncvs/src/sys/netinet/tcp_output.c,v
#retrieving revision 1.16
#retrieving revision 1.17
#diff -c -r1.16 -r1.17
#*** /home/ncvs/src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16
#--- /home/ncvs/src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17
#
# Ideas:
# - nuke the stderr output if it's what we expect it to be
# - Add "no differences found" if the diff command supplied no output.
#
#*** src/sys/netinet/tcp_output.c 1995/11/03 22:08:08 1.16
#--- src/sys/netinet/tcp_output.c 1995/12/05 17:46:35 1.17 RELENG_2_1_0
# (bogus example, but...)
#
if ($difftype eq '-u') {
$f1 = '---';
$f2 = '\+\+\+';
} else {
$f1 = '\*\*\*';
$f2 = '---';
}
while (<RCSDIFF>) {
if (m|^$f1 $cvsroot|o) {
s|$cvsroot/||o;
if ($sym1) {
chop;
$_ .= " " . $sym1 . "\n";
}
} elsif (m|^$f2 $cvsroot|o) {
s|$cvsroot/||o;
if ($sym2) {
chop;
$_ .= " " . $sym2 . "\n";
}
}
print $_;
}
close(RCSDIFF);
exit;
}
open(RCS, "rlog '$fullname'|") || &fatal("500 Internal Error",
"Failed to spawn rlog");
while (<RCS>) {
print if ($verbose);
if ($symnames) {
if (/^\s+([^:]+):\s+([\d\.]+)/) {
$symrev{$1} = $2;
if ($revsym{$2}) {
$revsym{$2} .= ", ";
}
$revsym{$2} .= $1;
} else {
$symnames = 0;
}
} elsif (/^symbolic names/) {
$symnames = 1;
} elsif (/^-----/) {
last;
}
}
# each log entry is of the form:
# ----------------------------
# revision 3.7.1.1
# date: 1995/11/29 22:15:52; author: fenner; state: Exp; lines: +5 -3
# log info
# ----------------------------
logentry:
while (!/^=========/) {
$_ = <RCS>;
print "R:", $_ if ($verbose);
if (/^revision ([\d\.]+)/) {
$rev = $1;
} elsif (/^========/ || /^----------------------------$/) {
next logentry;
} else {
&fatal("500 Internal Error","Error parsing RCS output: $_");
}
$_ = <RCS>;
print "D:", $_ if ($verbose);
if (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);|) {
$yr = $1;
# damn 2-digit year routines
if ($yr > 100) {
$yr -= 1900;
}
$date{$rev} = &timelocal($6,$5,$4,$3,$2 - 1,$yr);
$author{$rev} = $7;
} else {
&fatal("500 Internal Error", "Error parsing RCS output: $_");
}
line:
while (<RCS>) {
print "L:", $_ if ($verbose);
next line if (/^branches:\s/);
last line if (/^----------------------------$/ || /^=========/);
$log{$rev} .= $_;
}
print "E:", $_ if ($verbose);
}
close(RCS);
print "Done reading RCS file\n" if ($verbose);
#
# Sort the revisions into commit-date order.
@revorder = sort {$date{$b} <=> $date{$a}} keys %date;
print "Done sorting revisions\n" if ($verbose);
#
# HEAD is an artificial tag which is simply the highest tag number on the main
# branch. Find it by looking through @revorder; it should at least
# be near the beginning (In fact, it *should* be the first commit listed on
# the main branch.)
revision:
for ($i = 0; $i <= $#revorder; $i++) {
if ($revorder[$i] =~ /^\d+\.\d+$/) {
if ($revsym{$revorder[$i]}) {
$revsym{$revorder[$i]} .= ", ";
}
$revsym{$revorder[$i]} .= "HEAD";
$symrev{"HEAD"} = $revorder[$i];
last revision;
}
}
print "Done finding HEAD\n" if ($verbose);
#
# Now that we know all of the revision numbers, we can associate
# absolute revision numbers with all of the symbolic names, and
# pass them to the form so that the same association doesn't have
# to be built then.
#
# should make this a case-insensitive sort
foreach (sort keys %symrev) {
$rev = $symrev{$_};
if ($rev =~ /^(\d+(\.\d+)+)\.0\.(\d+)$/) {
#
# A revision number of A.B.0.D really translates into
# "the highest current revision on branch A.B.D".
#
# If there is no branch A.B.D, then it translates into
# the head A.B .
#
# This is pure speculation.
#
$head = $1;
$branch = $3;
$regex = $head . "." . $branch;
$regex =~ s/\./\./g;
# <
# \____/
$rev = $head;
revision:
foreach $r (@revorder) {
if ($r =~ /^${regex}/) {
$rev = $head . "." . $branch;
last revision;
}
}
$revsym{$rev} .= ", " if ($revsym{$rev});
$revsym{$rev} .= $_;
}
$sel .= "<OPTION VALUE=\"${rev}:${_}\">$_\n";
}
print "Done associating revisions with branches\n" if ($verbose);
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>CVS log for $where</TITLE></HEAD>\n";
print "<BODY>\n";
print "<!-- Generated by cvsweb version $cvswebversion -->\n";
print "<H1 align=center>CVS log for $where</H1>\n";
($upwhere = $where) =~ s|[^/]+$||;
print "Up to ", &link($upwhere,$scriptname . "/" . $upwhere);
print "<BR>\n";
print "<A HREF=\"#diff\">Request diff between arbitrary revisions</A>\n";
print "<HR>\n";
# The other possible U.I. I can see is to have each revision be hot
# and have the first one you click do ?r1=foo
# and since there's no r2 it keeps going & the next one you click
# adds ?r2=foo and performs the query.
# I suppose there's no reason we can't try both and see which one
# people prefer...
for ($i = 0; $i <= $#revorder; $i++) {
$_ = $revorder[$i];
# print "RCS revision <b>$_</b>\n";
print "<A HREF=\"$scriptwhere?rev=$_\"><b>$_</b></A>";
if (/^1\.1\.1\.\d+$/) {
print " <i>(vendor branch)</i>";
}
# print "<BR>\n";
# print "Checked in on <i>" . &ctime($date{$_}) . "</i> by ";
# print "<i>" . $author{$_} . "</i><BR>\n";
print " <i>" . &ctime($date{$_}) . "</i> by ";
print "<i>" . $author{$_} . "</i>\n";
if ($revsym{$_}) {
# print "CVS Tags: <b>$revsym{$_}</b><BR>\n";
print "<BR>CVS Tags: <b>$revsym{$_}</b>";
}
if (($br = $_) =~ s/\.\d+$// && $revsym{$br}) {
# print "Branch: <b>$revsym{$br}</b><BR>\n";
if ($revsym{$_}) {
print "; ";
} else {
print "<BR>";
}
print "Branch: <b>$revsym{$br}</b>";
}
# Find the previous revision on this branch.
@prevrev = split(/\./, $_);
if (--$prevrev[$#prevrev] == 0) {
# If it was X.Y.Z.1, just make it X.Y
if ($#prevrev > 1) {
pop(@prevrev);
pop(@prevrev);
} else {
# It was rev 1.1 (XXX does CVS use revisions
# greater than 1.x?)
if ($prevrev[0] != 1) {
print "<i>* I can't figure out the previous revision! *</i>\n";
}
}
}
if ($prevrev[$#prevrev] != 0) {
$prev = join(".", @prevrev);
print "<BR><A HREF=\"$scriptwhere?r1=$prev";
print "&r2=$_\">Diffs to $prev</A>\n";
#
# Plus, if it's on a branch, and it's not a vendor branch,
# offer to diff with the immediately-preceding commit if it
# is not the previous revision as calculated above
# and if it is on the HEAD (or at least on a higher branch)
# (e.g. change gets committed and then brought
# over to -stable)
if (!/^1\.1\.1\.\d+$/ && ($i != $#revorder) &&
($prev ne $revorder[$i+1])) {
@tmp1 = split(/\./, $revorder[$i+1]);
@tmp2 = split(/\./, $_);
if ($#tmp1 < $#tmp2) {
print "; <A HREF=\"$scriptwhere?r1=$revorder[$i+1]";
print "&r2=$_\">Diffs to $revorder[$i+1]</A>\n";
}
}
}
# print "Log message:<BR>\n";
print "<PRE>\n";
print &htmlify($log{$_});
print "</PRE><HR>\n";
}
print "<A NAME=diff>\n";
print "This form allows you to request diffs between any two\n";
print "revisions of a file. You may select a symbolic revision\n";
print "name using the selection box or you may type in a numeric\n";
print "revision using the type-in text box.\n";
print "</A><P>\n";
print "<FORM METHOD=\"GET\" ACTION=\"$scriptwhere\">\n";
print "Diffs between \n";
print "<SELECT NAME=\"r1\">\n";
print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";
print $sel;
print "</SELECT>\n";
print "<INPUT TYPE=\"TEXT\" NAME=\"tr1\" VALUE=\"$revorder[$#revorder]\">\n";
print " and \n";
print "<SELECT NAME=\"r2\">\n";
print "<OPTION VALUE=\"text\" SELECTED>Use Text Field\n";
print $sel;
print "</SELECT>\n";
print "<INPUT TYPE=\"TEXT\" NAME=\"tr2\" VALUE=\"$revorder[0]\">\n";
print "<BR><INPUT TYPE=RADIO NAME=\"f\" VALUE=u CHECKED>Unidiff<br>\n";
print "<INPUT TYPE=RADIO NAME=\"f\" VALUE=c>Context diff<br>\n";
print "<INPUT TYPE=SUBMIT VALUE=\"Get Diffs\">\n";
print "</FORM>\n";
print "<HR><font size=-1><i>Created by cvsweb $cvswebversion</i></font>\n";
# print $tailhtml,"\n";
print "</BODY></HTML>\n";
} else {
&fatal("404 Not Found","$where: no such file or directory");
}
sub htmlify {
local($string) = @_;
$string =~ s/&/&amp;/g;
$string =~ s/</&lt;/g;
$string =~ s/>/&gt;/g;
$string;
}
sub link {
local($name, $where) = @_;
"<A HREF=\"$where\">$name</A>\n";
}
sub revcmp {
local($rev1, $rev2) = @_;
local(@r1) = split(/\./, $rev1);
local(@r2) = split(/\./, $rev2);
local($a,$b);
while (($a = pop(@r1)) && ($b = pop(@r2))) {
if ($a != $b) {
return $a <=> $b;
}
}
if (@r1) { return 1; }
if (@r2) { return -1; }
return 0;
}
sub fatal {
local($errcode, $errmsg) = @_;
print "Status: $errcode\n";
print "Content-type: text/html\n";
print "\n";
print "<HTML><HEAD><TITLE>Error</TITLE></HEAD>\n";
print "<BODY>Error: $errmsg</BODY></HTML>\n";
exit(1);
}