=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.18 retrieving revision 1.1.1.22 diff -u -p -r1.1.1.18 -r1.1.1.22 --- cvsweb/cvsweb.cgi 2001/01/01 23:55:44 1.1.1.18 +++ cvsweb/cvsweb.cgi 2001/01/14 08:49:27 1.1.1.22 @@ -1,4 +1,4 @@ -#!/usr/bin/perl5 -ws +#!/usr/bin/perl -wT # # cvsweb - a CGI interface to CVS trees. # @@ -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,16 +42,20 @@ # 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.54 2001/01/01 23:15:02 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 $ # ### +require 5.000; + use strict; use vars qw ( - $config $allow_version_select $verbose - %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES + $cvsweb_revision + $mydir $uname $config $allow_version_select $verbose + @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr + %MIRRORS %DEFAULTVALUE %ICONS %MTYPES @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS %alltags @tabcolors %fileinfo %tags @branchnames %nameprinted %symrev %revsym @allrevisions %date %author @revdisplayorder @@ -64,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 @@ -79,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 ); @@ -95,6 +101,7 @@ sub revcmp($$); sub fatal($$); sub redirect($); sub safeglob($); +sub search_path($); sub getMimeTypeFromSuffix($); sub head($;$); sub scan_directives(@); @@ -130,16 +137,26 @@ sub link_tags($); sub forbidden_module($); ##### Start of Configuration Area ######## -use Cwd; +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 ( - $ENV{CVSWEB_CONFIG}, - '/usr/local/etc/cvsweb.conf', - getcwd() . '/cvsweb.conf' + "$mydir/cvsweb.conf", + '/usr/local/etc/cvsweb/cvsweb.conf' ) { - $config = $_ if defined($_) && -r $_; + if (defined($_) && -r $_) { + $config = $_; + last; + } } # == Configuration defaults == @@ -151,7 +168,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 = @@ -229,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 @@ -355,6 +378,10 @@ else { } undef @barequery; +if (defined($input{path})) { + redirect("$scriptname/$input{path}$query"); +} + # get actual parameters $sortby = $input{"sortby"}; $bydate = 0; @@ -382,7 +409,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", @@ -435,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.'); } @@ -482,11 +519,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."); } @@ -497,36 +534,26 @@ 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"; - system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, $where - and $fatal = "500 Internal Error","cvs co failure: $!: $where" + system $CMD{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", "-zcf", "-", $basedir, @tar_options + system "$CMD{tar} @tar_options -cf - -C $tmpdir $basedir | $CMD{gzip} @gzip_options -c" 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; + system $CMD{rm}, '-rf', $tmpdir if -d $tmpdir; &fatal($fatal) if $fatal; @@ -711,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); } @@ -1995,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); @@ -2718,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 <
";
}
else {
# no choice ..
print "CVS Root: [$cvstree]";
}
+
+ print " Module path or alias:\n";
+ print "\n";
+ print "";
+
+ if (2 <= @CVSROOT) {
+ print " | |