=================================================================== RCS file: /cvs/cvsweb/cvsweb.cgi,v retrieving revision 1.1.1.18 retrieving revision 1.1.1.20 diff -u -p -r1.1.1.18 -r1.1.1.20 --- cvsweb/cvsweb.cgi 2001/01/01 23:55:44 1.1.1.18 +++ 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,15 +43,18 @@ # 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 $ +# $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 @@ -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", @@ -455,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 .= '/'; @@ -482,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."); } @@ -497,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"; - system "cvs", @cvs_options, "-Qd", $cvsroot, "export", "-r", $tag, $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", "-zcf", "-", $basedir, @tar_options + 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; @@ -871,6 +886,8 @@ if (-d $fullname) { ">$tag\n"; } print "\n"; + print " Module path or alias:\n"; + printf "\n", htmlquote($where); print "\n"; print "\n"; } @@ -878,7 +895,7 @@ if (-d $fullname) { if ($allow_tar) { my($basefile) = ($where =~ m,(?:.*/)?([^/]+),); - if ($basefile ne '') { + if (defined($basefile) && $basefile ne '') { print "