=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.20 retrieving revision 1.1.1.22 diff -u -p -r1.1.1.20 -r1.1.1.22 --- cvsweb/cvsweb.cgi 2001/01/03 03:36:03 1.1.1.20 +++ cvsweb/cvsweb.cgi 2001/01/14 08:49:27 1.1.1.22 @@ -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.105 2000/11/26 01:51:04 jumager Exp $ +# $Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.64 2001/01/13 07:48:09 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 @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 = join('.', '1.105', (split(/ /, + q$Idaemons: /home/cvs/cvsweb/cvsweb.cgi,v 1.64 2001/01/13 07:48:09 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; } } @@ -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 @@ -460,34 +477,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.'); } @@ -526,7 +538,7 @@ if ($input{tarball}) { 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 + system $CMD{cvs}, @cvs_options, '-Qd', $cvsroot, 'export', '-r', $tag, '-d', "$tmpdir/$basedir", $module and $fatal = "500 Internal Error","cvs co failure: $!: $module" && last; @@ -534,14 +546,14 @@ if ($input{tarball}) { print "Content-type: application/x-gzip\r\n\r\n"; - system "tar", @tar_options, "-zcf", "-", "-C", $tmpdir, $basedir + system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c" and $fatal = "500 Internal Error","tar zc failure: $!: $basedir" && last; last; } - system "rm", "-rf", $tmpdir if -d $tmpdir; + system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; &fatal($fatal) if $fatal; @@ -726,7 +738,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 '
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 +2035,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); @@ -2735,14 +2758,19 @@ sub navigateHeader($$$$$) { my ($swhere,$path,$filename,$rev,$title) = @_; $swhere = "" if ($swhere eq $scriptwhere); $swhere = urlencode($filename) if ($swhere eq ""); - print qq``; - print "\n
\n"; - print qq`\n`; - print ''; - print "\n";
+
+ print <
|