#!/usr/bin/perl -s # # cvsweb - a CGI interface to the CVS tree. # # Written by Bill Fenner on his own time. # Insert BSD copyright here. # #HTTP_USER_AGENT: Mozilla/1.1N (X11; I; SunOS 4.1.3_U1 sun4m) via proxy gateway CERN-HTTPD/3.0 libwww/2.17 #SERVER_NAME: www.freebsd.org #QUERY_STRING: baz #SCRIPT_FILENAME: /usr/local/www/cgi-bin/env.pl #SERVER_PORT: 80 #HTTP_ACCEPT: */*, image/gif, image/x-xbitmap, image/jpeg #SERVER_PROTOCOL: HTTP/1.0 #HTTP_COOKIE: s=beta26429821397802167 #PATH_INFO: /foo/bar #REMOTE_ADDR: 13.1.64.94 #DOCUMENT_ROOT: /usr/local/www/data/ #PATH: /sbin:/bin:/usr/sbin:/usr/bin #PATH_TRANSLATED: /usr/local/www/data//foo/bar #GATEWAY_INTERFACE: CGI/1.1 #REQUEST_METHOD: GET #SCRIPT_NAME: /cgi-bin/env.pl #SERVER_SOFTWARE: Apache/1.0.0 #REMOTE_HOST: beta.xerox.com #SERVER_ADMIN: webmaster@freebsd.org # require 'timelocal.pl'; require 'ctime.pl'; $hsty_base = ""; require 'cgi-style.pl'; #&get_the_source; %CVSROOT = ( 'freebsd', '/home/ncvs', 'openbsd', '/home/OpenBSD/cvs', 'learn', '/c/learncvs', 'mozilla', '/a/mozilla-cvs', ); %CVSROOTdescr = ( 'freebsd', 'FreeBSD', 'openbsd', 'OpenBSD', 'learn', 'Learn', 'mozilla', 'Mozilla FreeBSD', ); $cvstreedefault = 'freebsd'; $cvstree = $cvstreedefault; $cvsroot = $CVSROOT{"$cvstree"} || "/home/ncvs"; $intro = " This is a WWW interface to the FreeBSD CVS tree. You can browse the file hierarchy by picking directories (which have slashes after them, e.g. src/). If you pick a file, you will see the revision history for that file. Selecting a revision number will download that revision of the file. There is a link at each revision to display diffs between that revision and the previous one, and a form at the bottom of the page that allows you to display diffs between arbitrary revisions.

If you would like to use this CGI script on your own web server and CVS tree, see the CVSWeb distribution site or the current FreeBSD version.

Please send any suggestions, comments, etc. to Bill Fenner <fenner\@freebsd.org> "; $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. "; $verbose = $v; ($where = $ENV{'PATH_INFO'}) =~ s|^/||; $where =~ s|/$||; ($scriptname = $ENV{'SCRIPT_NAME'}) =~ s|^/?|/|; $scriptname =~ s|/$||; $scriptwhere = $scriptname . '/' . $where; $scriptwhere =~ s|/$||; if ($query = $ENV{'QUERY_STRING'}) { foreach (split(/&/, $query)) { s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted if (/(\S+)=(.*)/) { $input{$1} = $2; } else { $input{$_}++; } } $query = "?" . $query; } $config = '/usr/local/etc/cvsweb'; do "$config" if -f $config; if ($input{'cvsroot'}) { if ($CVSROOT{$input{'cvsroot'}}) { $cvstree = $input{'cvsroot'}; $cvsroot = $CVSROOT{"$cvstree"}; } } do "$config-$cvstree" if -f "$config-$cvstree"; $fullname = $cvsroot . '/' . $where; if (!-d $cvsroot) { &fatal("500 Internal Error",'$CVSROOT not found!

The server on which the CVS tree lives is probably down. Please try again in a few minutes.'); } { local(@foo, $i); local($scriptname) = $ENV{'SCRIPT_NAME'}; foreach (keys %CVSROOT) { if (-d $CVSROOT{$_}) { push(@foo, $_); } } if ($#foo > 1) { $intro .= "

\nThis script support the following CVS trees:\n"; for($i = 0; $i <= $#foo; $i++) { $intro .= qq{} . ($CVSROOTdescr{$foo[$i]} ? $CVSROOTdescr{$foo[$i]} : $foo[$i]) . qq{} . ($i == $#foo ? ".\n" : ",\n"); } } } if (-d $fullname) { opendir(DIR, $fullname) || &fatal("404 Not Found","$where: $!"); @dir = readdir(DIR); closedir(DIR); if ($where eq '') { print &html_header("FreeBSD CVS Repository"); print $intro; } else { print &html_header("/$where"); print $shortinstr; } print "

"; print "Current CVS tree: $cvstree
\n" if $cvstree ne $cvstreedefault; print "Current directory: /$where\n"; print "


\n"; # Using in this manner violates the HTML2.0 spec but # provides the results that I want in most browsers. Another # case of layout spooging up HTML. print "\n"; lookingforattic: for ($i = 0; $i <= $#dir; $i++) { if ($dir[$i] eq "Attic") { last lookingforattic; } } $haveattic = 1 if ($i <= $#dir); if (!$input{"showattic"} && ($i <= $#dir) && opendir(DIR, $fullname . "/Attic")) { splice(@dir, $i, 1, grep((s|^|Attic/|,!m|/\.|), readdir(DIR))); closedir(DIR); } # Sort without the Attic/ pathname. foreach (sort {($c=$a)=~s|.*/||;($d=$b)=~s|.*/||;($c cmp $d)} @dir) { if ($_ eq '.') { next; } next if $_ eq '#cvs.lock'; if (s|^Attic/||) { $attic = " (in the Attic)"; } else { $attic = ""; } if ($_ eq '..') { next if ($where eq ''); ($updir = $scriptwhere) =~ s|[^/]+$||; print " ", &link("Previous Directory",$updir . $query), "
"; # print " ", # &link("Directory-wide diffs", $scriptwhere . '/*'), "
"; } elsif (-d $fullname . "/" . $_) { print " ", &link($_ . "/", $scriptwhere . '/' . $_ . '/' . $query), $attic, "
"; } elsif (s/,v$//) { # TODO: add date/time? How about sorting? print " ", &link($_, $scriptwhere . '/' . ($attic ? "Attic/" : "") . $_ . $query), $attic, "
"; } } print "
\n"; if ($input{"only_on_branch"}) { print "
\n"; print "Currently showing only branch $input{'only_on_branch'}.\n"; $input{"only_on_branch"}=""; foreach $k (keys %input) { print "\n" if $input{$k}; } print "\n"; print "
\n"; } $formwhere = $scriptwhere; $formwhere =~ s|Attic/?$|| if ($input{"showattic"}); if ($haveattic) { print "
\n"; $input{"showattic"}=!$input{"showattic"}; foreach $k (keys %input) { print "\n" if $input{$k}; } print "\n"; print "
\n"; } print &html_footer; print "\n"; } elsif (-f $fullname . ',v') { if ($input{'rev'} =~ /^[\d\.]+$/) { &checkout($fullname, $input{'rev'}); exit; } if ($input{'r1'} && $input{'r2'}) { &dodiff($fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, $input{'tr2'}, $input{'f'}); exit; } print("going to dolog($fullname)\n") if ($verbose); &dolog($fullname); } elsif ($fullname =~ s/\.diff$// && -f $fullname . ",v" && $input{'r1'} && $input{'r2'}) { # Allow diffs using the ".diff" extension # so that browsers that default to the URL # for a save filename don't save diff's as # e.g. foo.c &dodiff($fullname, $input{'r1'}, $input{'tr1'}, $input{'r2'}, $input{'tr2'}, $input{'f'}); exit; } elsif (($newname = $fullname) =~ s|/([^/]+)$|/Attic/$1| && -f $newname . ",v") { # The file has been removed and is in the Attic. # Send a redirect pointing to the file in the Attic. ($newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|; &redirect($newplace); exit; } elsif (0 && (@files = &safeglob($fullname . ",v"))) { print "Content-type: text/plain\n\n"; print "You matched the following files:\n"; print join("\n", @files); # Find the tags from each file # Display a form offering diffs between said tags } else { # Assume it's a module name with a potential path following it. $xtra = $& if (($module = $where) =~ s|/.*||); # Is there an indexed version of modules? if (open(MODULES, "$cvsroot/CVSROOT/modules")) { while () { if (/^(\S+)\s+(\S+)/o && $module eq $1 && -d "${cvsroot}/$2" && $module ne $2) { &redirect($scriptname . '/' . $2 . $xtra); } } } &fatal("404 Not Found","$where: no such file or directory"); } sub htmlify { local($string, $pr) = @_; $string =~ s/&/&/g; $string =~ s//>/g; if ($pr) { $string =~ s|\bpr(\W+[a-z]+/\W*)(\d+)|$&|ig; } $string; } sub link { local($name, $where) = @_; "$name\n"; } sub revcmp { local($rev1, $rev2) = @_; local(@r1) = split(/\./, $rev1); local(@r2) = split(/\./, $rev2); local($a,$b); while (($a = shift(@r1)) && ($b = shift(@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 &html_header("Error"); # print "Content-type: text/html\n"; # print "\n"; # print "Error\n"; # print "Error: $errmsg\n"; print "Error: $errmsg\n"; print &html_footer; exit(1); } sub redirect { local($url) = @_; print "Status: 301 Moved\n"; print "Location: $url\n"; print &html_header("Moved"); # print "Content-type: text/html\n"; # print "\n"; # print "Moved\n"; # print "This document is located here.\n"; print "This document is located here.\n"; print &html_footer; exit(1); } sub safeglob { local($filename) = @_; local($dirname); local(@results); ($dirname = $filename) =~ s|/[^/]+$||; $filename =~ s|.*/||; if (opendir(DIR, $dirname)) { $glob = $filename; # transform filename from glob to regex. Deal with: # [, {, ?, * as glob chars # make sure to escape all other regex chars $glob =~ s/([\.\(\)\|\+])/\\$1/g; $glob =~ s/\*/.*/g; $glob =~ s/\?/./g; $glob =~ s/{([^}]+)}/($t = $1) =~ s-,-|-g; "($t)"/eg; foreach (readdir(DIR)) { if (/^${glob}$/) { push(@results, $dirname . "/" .$_); } } } @results; } sub checkout { local($fullname, $rev) = @_; 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 # or # /home/ncvs/src/sys/netinet/igmp.c,v --> stdout # revision 1.1.1.2 # /* $_ = ; if (/^(\S+),v\s+-->\s+st(andar)?d ?out(put)?\s*$/o && $1 eq $fullname) { # As expected } else { &fatal("500 Internal Error", "Unexpected output from co: $_"); } $_ = ; 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 ; close(RCS); } sub dodiff { local($fullname, $r1, $tr1, $r2, $tr2, $f) = @_; if ($r1 =~ /([^:]+)(:(.+))?/) { $rev1 = $1; $sym1 = $3; } if ($rev1 eq 'text') { $rev1 = $tr1; } if ($r2 =~ /([^:]+)(:(.+))?/) { $rev2 = $1; $sym2 = $3; } if ($rev2 eq 'text') { $rev2 = $tr2; } 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); } # # XXX Putting '-p' here is a personal preference if ($f eq 'c') { $difftype = '-p -c'; $diffname = "Context diff"; } elsif ($f eq 's') { $difftype = '--side-by-side --width=164'; $diffname = "Side by Side"; } else { $difftype = '-p -u'; $diffname = "Unidiff"; } # XXX should this just be text/plain # or should it have an HTML header and then a
	print "Content-type: text/plain\n\n";
	open(RCSDIFF, "rcsdiff $difftype -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 () {
	    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);
}

sub dolog {
	local($fullname) = @_;
	local($curbranch,$symnames);	#...

	print("Going to rlog '$fullname'\n") if ($verbose);
	open(RCS, "rlog '$fullname'|") || &fatal("500 Internal Error",
						"Failed to spawn rlog");
	while () {
	    print if ($verbose);
	    if (/^branch:\s+([\d\.]+)/) {
		$curbranch = $1;
	    }
	    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;
	    }
	}

	if ($onlyonbranch = $input{'only_on_branch'}) {
	    ($onlyonbranch = $symrev{$onlyonbranch}) =~ s/\.0\././;
	    ($onlybranchpoint = $onlyonbranch) =~ s/\.\d+$//;
	}

# 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 (!/^=========/) {
	    $_ = ;
	    last logentry if (!defined($_));	# EOF
	    print "R:", $_ if ($verbose);
	    if (/^revision ([\d\.]+)/) {
		$rev = $1;
	    } elsif (/^========/ || /^----------------------------$/) {
		next logentry;
	    } else {
		# The rlog output is syntactically ambiguous.  We must
		# have guessed wrong about where the end of the last log
		# message was.
		# Since this is likely to happen when people put rlog output
		# in their commit messages, don't even bother keeping
		# these lines since we don't know what revision they go with
		# any more.
		next logentry;
#		&fatal("500 Internal Error","Error parsing RCS output: $_");
	    }
	    $_ = ;
	    print "D:", $_ if ($verbose);
	    if (m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+(\S+);\s+state:\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;
		$state{$rev} = $8;
	    } else {
		&fatal("500 Internal Error", "Error parsing RCS output: $_");
	    }
	    line:
	    while () {
		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, unless there is a branch tag in the RCS file in which case it's the
# highest revision on that branch.  Find it by looking through @revorder; it
# is the first commit listed on the appropriate branch.
	$headrev = $curbranch || "1";
	revision:
	for ($i = 0; $i <= $#revorder; $i++) {
	    if ($revorder[$i] =~ /^(\S*)\.\d+$/ && $headrev eq $1) {
		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+)$/) {
		push(@branchnames, $_);
		#
		# 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 .
		#
		$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} .= $_;
		if ($rev ne $head) {
		    $branchpoint{$head} .= ", " if ($branchpoint{$head});
		    $branchpoint{$head} .= $_;
		}
	    }
	    $sel .= "