===================================================================
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 "\n";
+ print " Module path or alias:\n";
+ printf "\n", htmlquote($where);
print "\n";
print "\n";
}
@@ -877,7 +895,7 @@ if (-d $fullname) {
if ($allow_tar) {
my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
- if ($basefile ne '') {
+ if (defined($basefile) && $basefile ne '') {
print "
\n",
"",
&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 '