===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.17
retrieving revision 1.1.1.20
diff -u -p -r1.1.1.17 -r1.1.1.20
--- cvsweb/cvsweb.cgi	2000/12/29 09:20:45	1.1.1.17
+++ cvsweb/cvsweb.cgi	2001/01/03 03:36:03	1.1.1.20
@@ -1,4 +1,4 @@
-#!/usr/bin/perl5 -ws
+#!/usr/bin/perl -wT
 #
 # cvsweb - a CGI interface to CVS trees.
 #
@@ -43,20 +43,23 @@
 # SUCH DAMAGE.
 #
 # $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $
-# $kId: cvsweb.cgi,v 1.49 2000/12/29 09:12:15 knu Exp $
+# $kId: cvsweb.cgi,v 1.57 2001/01/03 02:55:30 knu Exp $
 #
 ###
 
+require 5.000;
+
 use strict;
 
 use vars qw (
     $config $allow_version_select $verbose
-    %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
+    @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
+    %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
     @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
     %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted
     %symrev %revsym @allrevisions %date %author @revdisplayorder
     @revisions %state %difflines %log %branchpoint @revorder
-    $prcgi @prcategories $prcategories $mancgi
+    $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
     $checkoutMagic $doCheckout $scriptname $scriptwhere
     $where $pathinfo $Browser $nofilelinks $maycompress @stickyvars
     %funcline_regexp $is_mod_perl
@@ -75,11 +78,11 @@ use vars qw (
     $difffontsize $inputTextSize $mime_types $allow_annotate
     $allow_markup $use_java_script $open_extern_window
     $extern_window_width $extern_window_height $edit_option_form
-    $show_subdir_lastmod $show_log_in_markup $v
+    $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v
     $navigationHeaderColor $tableBorderColor $markupLogColor
     $tabstop $state $annTable $sel $curbranch @HideModules
     $module $use_descriptions %descriptions @mytz $dwhere $moddate
-    $use_moddate $has_zlib $gzip_open $allow_tar
+    $use_moddate $has_zlib $gzip_open $allow_tar @tar_options @cvs_options
     $LOG_FILESEPARATOR $LOG_REVSEPARATOR
 );
 
@@ -130,16 +133,18 @@ sub link_tags($);
 sub forbidden_module($);
 
 ##### Start of Configuration Area ########
-use Cwd;
+use File::Basename;
 
 # == EDIT this ==
 # Locations to search for user configuration, in order:
 for (
-     $ENV{CVSWEB_CONFIG},
-     '/usr/local/etc/cvsweb.conf',
-     getcwd() . '/cvsweb.conf'
+     (dirname $0) . '/cvsweb.conf',
+     '/usr/local/etc/cvsweb/cvsweb.conf'
     ) {
-    $config = $_ if defined($_) && -r $_;
+    if (defined($_) && -r $_) {
+	($config) = /(.*)/; # untaint
+	last;
+    }
 }
 
 # == Configuration defaults ==
@@ -151,7 +156,8 @@ $allow_version_select = 1;
 
 ######## Configuration variables #########
 # These are defined to allow checking with perl -cw
-%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
+@CVSrepositories = @CVSROOT = %CVSROOT =
+%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
 %tags = %alltags = @tabcolors = ();
 $cvstreedefault = $body_tag = $body_tag_for_src =
 $logo = $defaulttitle = $address =
@@ -355,6 +361,10 @@ else {
 }
 undef @barequery;
 
+if (defined($input{path})) {
+    redirect("$scriptname/$input{path}$query");
+}
+
 # get actual parameters
 $sortby = $input{"sortby"};
 $bydate = 0;
@@ -382,7 +392,22 @@ $defaultDiffType = $input{'f'};
 
 $logsort = $input{'logsort'};
 
+my @tmp = @CVSrepositories;
+my @pair;
 
+while (@pair = splice(@tmp, 0, 2)) {
+    my($key, $val) = @pair;
+    my($descr, $cvsroot) = @$val;
+
+    next if !-d $cvsroot;
+
+    $CVSROOTdescr{$key} = $descr;
+    $CVSROOT{$key} = $cvsroot;
+    push @CVSROOT, $key;
+}
+undef @tmp;
+undef @pair;
+
 ## Default CVS-Tree
 if (!defined($CVSROOT{$cvstreedefault})) {
    &fatal("500 Internal Error",
@@ -426,10 +451,11 @@ if (-f $config_cvstree) {
 }
 undef $config_cvstree;
 
-$prcategories = '(?:' . join('|', @prcategories) . ')';
+$re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories;
+$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
 $prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
 
-$fullname = $cvsroot . '/' . $where;
+$fullname = "$cvsroot/$where";
 $mimetype = &getMimeTypeFromSuffix ($fullname);
 $defaultTextPlain = ($mimetype eq "text/plain");
 $defaultViewable = $allow_markup && viewable($mimetype);
@@ -454,7 +480,7 @@ if (-d $fullname) {
     # to allow relative URL's. If they're not, make a redirect.
     ##
     if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) {
-	redirect ($scriptwhere . '/' . $query);
+	redirect("$scriptwhere/$query");
     }
     else {
 	$where .= '/';
@@ -481,11 +507,11 @@ if ($module && &forbidden_module($module)) {
 if ($input{tarball}) {
     &fatal("403 Forbidden", "Downloading tarballs is prohibited.")
       unless $allow_tar;
-    $where =~ s,/[^/]*$,,;
-    $where =~ s,^/,,;
-    my($basedir) = ($where =~ m,([^/]+)$,);
+    my($module) = ($where =~ m,^/?(.*),);	# untaint
+    $module =~ s,/[^/]*$,,;
+    my($basedir) = ($module =~ m,([^/]+)$,);
 
-    if ($basedir eq '' || $where eq '') {
+    if ($basedir eq '' || $module eq '') {
 	&fatal("500 Internal Error", "You cannot download the top level directory.");
     }
 
@@ -496,34 +522,24 @@ if ($input{tarball}) {
 
     my $fatal = '';
 
-    do {
-	chdir $tmpdir
-	  or $fatal = "500 Internal Error", "Unable to cd to temporary directory: $!"
-	    && last;
+    while (1) {
+	my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
+	  ? $input{only_with_tag} : "HEAD";
 
-	my @params = (exists $input{only_with_tag} && length $input{only_with_tag})
-	  ? ("-r", $input{only_with_tag}) : ();
-
-	system "cvs", "-RlQd", $cvsroot, "co", @params, $where
-	  and $fatal = "500 Internal Error","cvs co failure: $!: $where"
+	system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, "-d", "$tmpdir/$basedir", $module
+	  and $fatal = "500 Internal Error","cvs co failure: $!: $module"
 	    && last;
 
-	chdir "$where/.."
-	  or $fatal = "500 Internal Error","Cannot find expected directory in checkout"
-	    && last;
-
 	$| = 1; # Essential to get the buffering right.
 
 	print "Content-type: application/x-gzip\r\n\r\n";
 
-	system "tar", "--ignore-failed-read", "--exclude", "CVS", "-zcf", "-", $basedir
+	system "tar", @tar_options, "-zcf", "-", "-C", $tmpdir, $basedir
 	  and $fatal = "500 Internal Error","tar zc failure: $!: $basedir"
 	    && last;
 
-	chdir $tmpdir
-	  or $fatal = "500 Internal Error","Unable to cd to temporary directory: $!"
-	    && last;
-    } while (0);
+	last;
+    }
 
     system "rm", "-rf", $tmpdir if -d $tmpdir;
 
@@ -870,6 +886,8 @@ if (-d $fullname) {
 		       ">$tag\n";
 	    }
 	    print "</SELECT>\n";
+	    print " Module path or alias:\n";
+	    printf "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"%s\" SIZE=15>\n", htmlquote($where);
 	    print "<INPUT TYPE=SUBMIT VALUE=\"Go\">\n";
 	    print "</FORM>\n";
 	}
@@ -877,7 +895,7 @@ if (-d $fullname) {
 	if ($allow_tar) {
 	    my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
 
-	    if ($basefile ne '') {
+	    if (defined($basefile) && $basefile ne '') {
 		print "<HR NOSHADE>\n",
 		  "<DIV align=center>",
 		    &link("Download this directory in tarball",
@@ -972,7 +990,7 @@ if (-d $fullname) {
 	# The file has been removed and is in the Attic.
 	# Send a redirect pointing to the file in the Attic.
 	(my $newplace = $scriptwhere) =~ s|/([^/]+)$|/Attic/$1|;
-	&redirect($newplace);
+	redirect("$newplace$query");
 	exit;
     }
     elsif (0 && (my @files = &safeglob($fullname . ",v"))) {
@@ -992,7 +1010,7 @@ if (-d $fullname) {
 	    while (<$fh>) {
 		if (/^(\S+)\s+(\S+)/o && $module eq $1
 		    && -d "$cvsroot/$2" && $module ne $2) {
-		    &redirect("$scriptname/$2$xtra");
+		    redirect("$scriptname/$2$xtra$query");
 		}
 	    }
 	}
@@ -1113,7 +1131,7 @@ sub htmlify($;$) {
 
     if ($extra) {
 	# get PR #'s as link: "PR#nnnn" "PR: nnnn, ..." "PR nnnn, ..." "bin/nnnn"
-	if (defined($prcgi)) {
+	if (defined($prcgi) && defined($re_prcategories) && defined($re_prkeyword)) {
 	    my $prev;
 
 	    do {
@@ -1121,7 +1139,7 @@ sub htmlify($;$) {
 
 		$_ = htmlify_sub {
 		    s{
-		      (\bPR[:\#]?\s*
+		      (\b$re_prkeyword[:\#]?\s*
 		       (?:
 			\#?
 			\d+[,\s]\s*
@@ -1136,7 +1154,7 @@ sub htmlify($;$) {
 
 	    $_ = htmlify_sub {
 		s{
-		  (\b$prcategories/(\d+)\b)
+		  (\b$re_prcategories/(\d+)\b)
 		 }{
 		     &link($1, sprintf($prcgi, $2))
 		 }egox;
@@ -1147,7 +1165,7 @@ sub htmlify($;$) {
 	if (defined($mancgi)) {
 	    $_ = htmlify_sub {
 		s{
-		  (\b([a-zA-Z][\w_.]+)
+		  (\b([a-zA-Z][\w.]+)
 		   (?:
 		    \( ([0-9n]) \)\B
 		    |
@@ -1155,7 +1173,7 @@ sub htmlify($;$) {
 		   )
 		  )
 		 }{
-		     &link($1, sprintf($mancgi, $3 ne '' ? $3 : $4, $2))
+		     &link($1, sprintf($mancgi, defined($3) ? $3 : $4, $2))
 		 }egx;
 	    } $_;
 	}
@@ -1371,8 +1389,8 @@ sub doAnnotate($$) {
     # the public domain.
     # we could abandon the use of rlog, rcsdiff and co using
     # the cvsserver in a similiar way one day (..after rewrite)
-    $pid = open2($reader, $writer, "cvs -Rl server") || fatal ("500 Internal Error",
-							       "Fatal Error - unable to open cvs for annotation");
+    $pid = open2($reader, $writer, "cvs", @cvs_options, "server")
+      || fatal ("500 Internal Error", "Fatal Error - unable to open cvs for annotation");
 
     # OK, first send the request to the server.  A simplified example is:
     #     Root /home/kingdon/zwork/cvsroot
@@ -1564,7 +1582,7 @@ sub doCheckout($$) {
     # Safely for a child process to read from.
     if (! open($fh, "-|")) { # child
       open(STDERR, ">&STDOUT"); # Redirect stderr to stdout
-      exec("cvs", "-Rld", $cvsroot, "co", "-p", $revopt, $where);
+      exec("cvs", @cvs_options, "-d", $cvsroot, "co", "-p", $revopt, $where);
     }
 
     if (eof($fh)) {
@@ -1646,7 +1664,7 @@ sub cvswebMarkup($$$) {
     elsif ($mimetype =~ m%^application/pdf%) {
 	printf '<EMBED SRC="%s" WIDTH="100%"><BR>', hrefquote("$url$barequery");
     }
-    else {
+    elsif ($preformat_in_markup) {
 	print "<PRE>";
 
 	# prefetch several lines
@@ -1661,6 +1679,9 @@ sub cvswebMarkup($$$) {
 	}
 	print "</PRE>";
     }
+    else {
+	print "<PLAINTEXT>\n", <$filehandle>;
+    }
 }
 
 sub viewable($) {
@@ -1822,7 +1843,7 @@ sub getDirLogs($$@) {
 	return;
     }
 
-    if ($tag) {
+    if (defined($tag)) {
 	#can't use -r<tag> as - is allowed in tagnames, but misinterpreated by rlog..
 	if (! open($fh, "-|")) {
 		open(STDERR, '>/dev/null'); # rlog may complain; ignore.
@@ -1840,14 +1861,13 @@ sub getDirLogs($$@) {
     while (<$fh>) {
 	if ($state eq "start") {
 	    #Next file. Initialize file variables
-	    $rev = undef;
-	    $revwanted = undef;
-	    $branch = undef;
-	    $branchpoint = undef;
-	    $filename = undef;
-	    $log = undef;
-	    $revision = undef;
-	    $branch = undef;
+	    $rev = '';
+	    $revwanted = '';
+	    $branch = '';
+	    $branchpoint = '';
+	    $filename = '';
+	    $log = '';
+	    $revision = '';
 	    %symrev = ();
 	    @filetags = ();
 	    #jump to head state
@@ -1866,7 +1886,7 @@ again:
 		$branch = $1 
 	    } elsif (/^symbolic names:/) {
 		$state = "tags";
-		($branch = $head) =~ s/\.\d+$// if (!defined($branch));
+		($branch = $head) =~ s/\.\d+$// if $branch eq '';
 		$branch =~ s/(\d+)$/0.$1/;
 		$symrev{MAIN} = $branch;
 		$symrev{HEAD} = $branch;
@@ -1875,9 +1895,9 @@ again:
 		push (@filetags, "MAIN", "HEAD");
 	    } elsif (/$LOG_REVSEPARATOR/o) {
 		$state = "log";
-		$rev = undef;
-		$date = undef;
-		$log = "";
+		$rev = '';
+		$date = '';
+		$log = '';
 		# Try to reconstruct the relative filename if RCS spits out a full path
 		$filename =~ s%^\Q$DirName\E/%%;
 	    }
@@ -1895,7 +1915,7 @@ again:
 			$revwanted = $symrev{$tag eq "HEAD" ? "MAIN" : $tag};
 			($branch = $revwanted) =~ s/\b0\.//;
 			($branchpoint = $branch) =~ s/\.?\d+$//;
-			$revwanted = undef if ($revwanted ne $branch);
+			$revwanted = '' if ($revwanted ne $branch);
 		    } elsif ($tag ne "HEAD") {
 			print "Tag not found, skip this file" if ($verbose);
 			$state = "skip";
@@ -1912,19 +1932,19 @@ again:
 	if ($state eq "log") {
 	    if (/$LOG_REVSEPARATOR/o || /$LOG_FILESEPARATOR/o) {
 		# End of a log entry.
-		my $revbranch;
-		($revbranch = $rev) =~ s/\.\d+$//;
+		my $revbranch = $rev;
+		$revbranch =~ s/\.\d+$//;
 		print "$filename $rev Wanted: $revwanted ",
 		  "Revbranch: $revbranch Branch: $branch ",
 		    "Branchpoint: $branchpoint\n" if ($verbose);
-		if (!defined($revwanted) && defined($branch)
+		if ($revwanted eq '' && $branch ne ''
 		    && $branch eq $revbranch || !defined($tag)) {
 		    print "File revision $rev found for branch $branch\n"
 			if ($verbose);
 		    $revwanted = $rev;
 		}
-		if (defined($revwanted) ? $rev eq $revwanted :
-		    defined($branchpoint) ? $rev eq $branchpoint :
+		if ($revwanted ne '' ? $rev eq $revwanted :
+		    $branchpoint ne '' ? $rev eq $branchpoint :
 		    0 && ($rev eq $head)) { # Don't think head is needed here..
 		    print "File info $rev found for $filename\n" if ($verbose);
 		    my @finfo = ($rev,$date,$log,$author,$filename);
@@ -1933,11 +1953,11 @@ again:
 		    $fileinfo{$name} = [ @finfo ];
 		    $state = "done" if ($rev eq $revwanted);
 		}
-		$rev = undef;
-		$date = undef;
-		$log = "";
+		$rev = '';
+		$date = '';
+		$log = '';
 	    }
-	    elsif (!defined($date) && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
+	    elsif ($date eq '' && m|^date:\s+(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);|) {
 		my $yr = $1;
 		# damn 2-digit year routines :-)
 		if ($yr > 100) {
@@ -1949,7 +1969,7 @@ again:
 		$log = '';
 		next;
 	    }
-	    elsif (!defined($rev) && m/^revision (.*)$/) {
+	    elsif ($rev eq '' && /^revision (.*)$/) {
 		$rev = $1;
 		next;
 	    }
@@ -2357,18 +2377,18 @@ sub printLog($;$) {
 	    if (/^\d+\.\d+\.\d+/ && !/^1\.1\.1\.\d+$/) {
 		my ($i,$nextmain);
 		for ($i = 0; $i < $#revorder && $revorder[$i] ne $_; $i++){}
-		my (@tmp2) = split(/\./, $_);
+		my @tmp2 = split(/\./, $_);
 		for ($nextmain = ""; $i > 0; $i--) {
-		    my ($next) = $revorder[$i-1];
-		    my (@tmp1) = split(/\./, $next);
-		    if ($#tmp1 < $#tmp2) {
+		    my $next = $revorder[$i-1];
+		    my @tmp1 = split(/\./, $next);
+		    if (@tmp1 < @tmp2) {
 			$nextmain = $next;
 			last;
 		    }
 		    # Only the highest version on a branch should have
 		    # a diff for the "next main".
-		    last if (join(".",@tmp1[0..$#tmp1-1])
-			     eq join(".",@tmp2[0..$#tmp1-1]));
+		    last if (@tmp1 - 1 <= @tmp2 &&
+			     join(".",@tmp1[0..$#tmp1-1]) eq join(".",@tmp2[0..$#tmp1-1]));
 		}
 		if (!defined($diffrev{$nextmain})) {
 		    $diffrev{$nextmain} = 1;
@@ -2718,7 +2738,7 @@ sub navigateHeader($$$$$) {
     print qq`<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">`;
     print "<HTML>\n<HEAD>\n";
     print qq`<META name="robots" content="nofollow">\n`;
-    print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.49 $ -->';
+    print '<!-- CVSweb $zRevision: 1.104 $  $kRevision: 1.57 $ -->';
     print "\n<TITLE>$path$filename - $title - $rev</TITLE></HEAD>\n";
     print  "$body_tag_for_src\n";
     print "<table width=\"100%\" border=0 cellspacing=0 cellpadding=1 bgcolor=\"$navigationHeaderColor\">";
@@ -2832,13 +2852,7 @@ sub clickablePath($$) {
 }
 
 sub chooseCVSRoot() {
-    my @foo;
-    foreach (sort keys %CVSROOT) {
-	if (-d $CVSROOT{$_}) {
-	    push(@foo, $_);
-	}
-    }
-    if (@foo > 1) {
+    if (2 <= @CVSROOT) {
 	my ($k);
 	print "<form method=\"GET\" action=\"${scriptwhere}\">\n";
 	foreach $k (keys %input) {
@@ -2853,19 +2867,26 @@ sub chooseCVSRoot() {
 	print "<td>\n<select name=\"cvsroot\"";
 	print " onchange=\"submit()\"" if ($use_java_script);
 	print ">\n";
-	foreach $k (@foo) {
+	foreach $k (@CVSROOT) {
 	    print "<option value=\"$k\"";
 	    print " selected" if ($k eq $cvstree);
 	    print ">", ($CVSROOTdescr{$k} ? $CVSROOTdescr{$k} : $k), "</option>\n";
 	}
 	print "</select>\n</td>";
-	print "<td><input type=submit value=\"Go\"></td>";
-	print "</tr></table></form>";
+	print "<td>";
     }
     else {
 	# no choice ..
 	print "CVS Root: <b>[$cvstree]</b>";
     }
+
+    print " Module path or alias:\n";
+    print "<INPUT TYPE=TEXT NAME=\"path\" VALUE=\"\" SIZE=15>\n";
+    print "<input type=submit value=\"Go\">";
+
+    if (2 <= @CVSROOT) {
+	print "</td></tr></table></form>";
+    }
 }
 
 sub chooseMirror() {
@@ -3052,6 +3073,10 @@ sub hrefquote($) {
 
 sub http_header(;$) {
     my $content_type = shift || "text/html";
+
+    $content_type .= "; charset=$charset"
+      if $content_type =~ m,^text/, && defined($charset) && $charset;
+
     if (defined($moddate)) {
 	if ($is_mod_perl) {
 	    Apache->request->header_out("Last-Modified" => scalar gmtime($moddate) . " GMT");
@@ -3108,8 +3133,8 @@ sub http_header(;$) {
 
 sub html_header($) {
     my ($title) = @_;
-    my $version = '$zRevision: 1.104 $  $kRevision: 1.49 $'; #'
-    http_header(defined($charset) ? "text/html; charset=$charset" : "text/html");
+    my $version = '$zRevision: 1.104 $  $kRevision: 1.57 $'; #'
+    http_header("text/html");
     print <<EOH;
 <!doctype html public "-//W3C//DTD HTML 4.0 Transitional//EN"
  "http://www.w3.org/TR/REC-html40/loose.dtd">