===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.20
retrieving revision 1.1.1.27
diff -u -p -r1.1.1.20 -r1.1.1.27
--- cvsweb/cvsweb.cgi 2001/01/03 03:36:03 1.1.1.20
+++ cvsweb/cvsweb.cgi 2001/07/06 09:54:57 1.1.1.27
@@ -18,7 +18,7 @@
# Copyright (c) 1996-1998 Bill Fenner
# (c) 1998-1999 Henner Zeller
# (c) 1999 Henrik Nordstrom
-# (c) 2000 Akinori MUSHA
+# (c) 2000-2001 Akinori MUSHA
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -42,8 +42,8 @@
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
-# $zId: cvsweb.cgi,v 1.104 2000/11/01 22:05:12 hnordstrom Exp $
-# $kId: cvsweb.cgi,v 1.57 2001/01/03 02:55:30 knu Exp $
+# $zId: cvsweb.cgi,v 1.110 2001/06/29 09:29:36 hnordstrom Exp $
+# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $
#
###
@@ -52,7 +52,8 @@ require 5.000;
use strict;
use vars qw (
- $config $allow_version_select $verbose
+ $cvsweb_revision
+ $mydir $uname $config $allow_version_select $verbose
@CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
%MIRRORS %DEFAULTVALUE %ICONS %MTYPES
@DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
@@ -67,7 +68,8 @@ use vars qw (
%input $query $barequery $sortby $bydate $byrev $byauthor
$bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
$mimetype $charset $defaultTextPlain $defaultViewable
- $allow_compress $GZIPBIN $backicon $diricon $fileicon
+ $command_path %CMD $allow_compress
+ $backicon $diricon $fileicon
$fullname $newname $cvstreedefault
$body_tag $body_tag_for_src $logo $defaulttitle $address
$long_intro $short_instruction $shortLogLen
@@ -82,7 +84,8 @@ use vars qw (
$navigationHeaderColor $tableBorderColor $markupLogColor
$tabstop $state $annTable $sel $curbranch @HideModules
$module $use_descriptions %descriptions @mytz $dwhere $moddate
- $use_moddate $has_zlib $gzip_open $allow_tar @tar_options @cvs_options
+ $use_moddate $has_zlib $gzip_open
+ $allow_tar @tar_options @gzip_options @zip_options @cvs_options
$LOG_FILESEPARATOR $LOG_REVSEPARATOR
);
@@ -98,6 +101,7 @@ sub revcmp($$);
sub fatal($$);
sub redirect($);
sub safeglob($);
+sub search_path($);
sub getMimeTypeFromSuffix($);
sub head($;$);
sub scan_directives(@);
@@ -133,16 +137,24 @@ sub link_tags($);
sub forbidden_module($);
##### Start of Configuration Area ########
+delete $ENV{PATH};
+
+$cvsweb_revision = '1.110' . '.' . (split(/ /,
+ q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.78 2001/07/06 09:49:01 knu Exp $
+))[2];
+
use File::Basename;
+($mydir) = (dirname($0) =~ /(.*)/); # untaint
+
# == EDIT this ==
# Locations to search for user configuration, in order:
for (
- (dirname $0) . '/cvsweb.conf',
+ "$mydir/cvsweb.conf",
'/usr/local/etc/cvsweb/cvsweb.conf'
) {
if (defined($_) && -r $_) {
- ($config) = /(.*)/; # untaint
+ $config = $_;
last;
}
}
@@ -158,7 +170,7 @@ $allow_version_select = 1;
# These are defined to allow checking with perl -cw
@CVSrepositories = @CVSROOT = %CVSROOT =
%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
-%tags = %alltags = @tabcolors = ();
+%tags = %alltags = @tabcolors = %fileinfo = ();
$cvstreedefault = $body_tag = $body_tag_for_src =
$logo = $defaulttitle = $address =
$long_intro = $short_instruction = $shortLogLen =
@@ -235,18 +247,23 @@ $verbose = $v;
$checkoutMagic = "~checkout~";
$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
$where = $pathinfo;
-$where =~ tr|/|/|s;
-$doCheckout = ($where =~ /^\/$checkoutMagic/);
-$where =~ s|^/($checkoutMagic)?||;
-$where =~ s|/$||;
+$doCheckout = ($where =~ m|^/$checkoutMagic/|);
+$where =~ s|^/$checkoutMagic/|/|;
+$where =~ s|^/||;
$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
-$scriptname =~ s|^/?|/|;
-$scriptname =~ s|/+$||;
-$scriptwhere = $scriptname;
-if ($where) {
- $scriptwhere .= '/' . urlencode($where);
+$scriptname =~ s|^/*|/|;
+
+# Let's workaround thttpd's stupidity..
+if ($scriptname =~ m|/$|) {
+ $pathinfo .= '/';
+ my $re = quotemeta $pathinfo;
+ $scriptname =~ s/$re$//;
}
+$scriptwhere = $scriptname;
+$scriptwhere .= '/' . urlencode($where);
+$where = '/' if ($where eq '');
+
$is_mod_perl = defined($ENV{MOD_PERL});
# in lynx, it it very annoying to have two links
@@ -292,9 +309,7 @@ if (-f $config) {
} else {
&fatal("500 Internal Error",
'Configuration not found. Set the variable $config
'
- . 'in cvsweb.cgi, or the environment variable '
- . 'CVSWEB_CONFIG
, to your cvsweb.conf '
- . 'configuration file first.');
+ . 'in cvsweb.cgi to your cvsweb.conf configuration file first.');
}
undef %input;
@@ -460,34 +475,29 @@ $mimetype = &getMimeTypeFromSuffix ($fullname);
$defaultTextPlain = ($mimetype eq "text/plain");
$defaultViewable = $allow_markup && viewable($mimetype);
-# search for GZIP if compression allowed
-# We've to find out if the GZIP-binary exists .. otherwise
-# ge get an Internal Server Error if we try to pipe the
-# output through the nonexistent gzip ..
-# any more elegant ways to prevent this are welcome!
-if ($allow_compress && $maycompress && !$has_zlib) {
- foreach (split(/:/, $ENV{PATH})) {
- if (-x "$_/gzip") {
- $GZIPBIN = "$_/gzip";
- last;
- }
- }
+my $rewrite = 0;
+
+if ($pathinfo =~ m|//|) {
+ $pathinfo =~ y|/|/|s;
+ $rewrite = 1;
}
-if (-d $fullname) {
- #
- # ensure, that directories always end with (exactly) one '/'
- # to allow relative URL's. If they're not, make a redirect.
- ##
- if (!($pathinfo =~ m|/$|) || ($pathinfo =~ m |/{2,}$|)) {
- redirect("$scriptwhere/$query");
- }
- else {
- $where .= '/';
- $scriptwhere .= '/';
- }
+if (-d $fullname && $pathinfo !~ m|/$|) {
+ $pathinfo .= '/';
+ $rewrite = 1;
}
+if (!-d $fullname && $pathinfo =~ m|/$|) {
+ chop $pathinfo;
+ $rewrite = 1;
+}
+
+if ($rewrite) {
+ redirect($scriptname . urlencode($pathinfo) . $query);
+}
+
+undef $rewrite;
+
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.'); } @@ -508,7 +518,8 @@ if ($input{tarball}) { &fatal("403 Forbidden", "Downloading tarballs is prohibited.") unless $allow_tar; my($module) = ($where =~ m,^/?(.*),); # untaint - $module =~ s,/[^/]*$,,; + $module =~ s,/([^/]*)$,,; + my($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/); my($basedir) = ($module =~ m,([^/]+)$,); if ($basedir eq '' || $module eq '') { @@ -520,30 +531,34 @@ if ($input{tarball}) { mkdir($tmpdir, 0700) or &fatal("500 Internal Error", "Unable to make temporary directory: $!"); - my $fatal = ''; + my @fatal; - while (1) { - my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) - ? $input{only_with_tag} : "HEAD"; + my $tag = (exists $input{only_with_tag} && length $input{only_with_tag}) + ? $input{only_with_tag} : "HEAD"; - system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, "-d", "$tmpdir/$basedir", $module - and $fatal = "500 Internal Error","cvs co failure: $!: $module" - && last; - + if (system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module) { + @fatal = ("500 Internal Error", "cvs co failure: $!: $module"); + } else { $| = 1; # Essential to get the buffering right. - print "Content-type: application/x-gzip\r\n\r\n"; + if ($ext eq '.tar.gz') { + print "Content-type: application/x-gzip\r\n\r\n"; - system "tar", @tar_options, "-zcf", "-", "-C", $tmpdir, $basedir - and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" - && last; + system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c" + and @fatal = ("500 Internal Error", "tar zc failure: $!: $basedir"); + } elsif ($ext eq '.zip' && $CMD{zip}) { + print "Content-type: application/zip\r\n\r\n"; - last; + system "cd $tmpdir && $CMD{zip} @zip_options -r - $basedir" + and @fatal = ("500 Internal Error", "zip failure: $!: $basedir"); + } else { + @fatal = ("500 Internal Error", "unsupported file type"); + } } - system "rm", "-rf", $tmpdir if -d $tmpdir; + system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; - &fatal($fatal) if $fatal; + &fatal(@fatal) if @fatal; exit; } @@ -726,7 +741,8 @@ if (-d $fullname) { if ($_ eq '..' || -d "$fullname/$_") { next if ($_ eq '..' && $where eq '/'); - my ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}} + my ($rev,$date,$log,$author,$filename); + ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}} if (defined($fileinfo{$_})); printf '
"; + while (<$filehandle>) { + print htmlquote($_); + } + print ""; } } @@ -1747,7 +1788,7 @@ sub doDiff($$$$$$) { while (($re1, $re2) = each %funcline_regexp) { if ($fullname =~ /$re1/) { - push @difftype, '-F', '$re2'; + push @difftype, '-F', $re2; last; } } @@ -1762,7 +1803,7 @@ sub doDiff($$$$$$) { } if (! open($fh, "-|")) { # child open(STDERR, ">&STDOUT"); # Redirect stderr to stdout - exec("rcsdiff",@difftype,"-r$rev1","-r$rev2",$fullname); + exec($CMD{rcsdiff}, @difftype, "-r$rev1", "-r$rev2", $fullname); } if ($human_readable) { http_header(); @@ -1846,15 +1887,14 @@ sub getDirLogs($$@) { if (defined($tag)) { #can't use -r
did you set the \$ENV{PATH} in your configuration file correctly ?"); + "Failed to spawn GNU rlog on '".join(", ", @files)."'
Did you set the \$command_path in your configuration file correctly ? (Currently '$command_path'");
}
close($fh);
}
@@ -2012,12 +2052,12 @@ sub readLog($;$) {
print("Going to rlog '$fullname'\n") if ($verbose);
if (! open($fh, "-|")) { # child
- if ($revision ne '') {
- exec("rlog",$revision,$fullname);
- }
- else {
- exec("rlog",$fullname);
- }
+ if ($revision ne '') {
+ exec($CMD{rlog}, $revision, $fullname);
+ }
+ else {
+ exec($CMD{rlog}, $fullname);
+ }
}
while (<$fh>) {
print if ($verbose);
@@ -2617,8 +2657,8 @@ sub human_readable_diff($){
print "
Tag: $sym2\n" if ($sym1);
print "\n";
- my $fs = "";
- my $fe = "";
+ my $fs = "";
+ my $fe = "";
my $leftRow = 0;
my $rightRow = 0;
@@ -2640,6 +2680,7 @@ sub human_readable_diff($){
if ($difftxt =~ /^@@/) {
($oldline,$newline,$funname) = $difftxt =~ /@@ \-([0-9]+).*\+([0-9]+).*@@(.*)/;
+ $funname = htmlquote($funname);
print "
Line $oldline"; print " $funname |