=================================================================== 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 "
\n", "
", &link("Download this directory in tarball", @@ -973,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"))) { @@ -993,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"); } } } @@ -1372,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 @cvs_options -l 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 @@ -2721,7 +2738,7 @@ sub navigateHeader($$$$$) { print qq``; print "\n\n"; print qq`\n`; - print ''; + print ''; print "\n$path$filename - $title - $rev\n"; print "$body_tag_for_src\n"; print ""; @@ -2835,13 +2852,7 @@ sub clickablePath($$) { } sub chooseCVSRoot() { - my @foo; - foreach (sort keys %CVSROOT) { - if (-d $CVSROOT{$_}) { - push(@foo, $_); - } - } - if (@foo > 1) { + if (2 <= @CVSROOT) { my ($k); print "\n"; foreach $k (keys %input) { @@ -2856,19 +2867,26 @@ sub chooseCVSRoot() { print ""; - print ""; - print "
\n\n
"; + print ""; } else { # no choice .. print "CVS Root: [$cvstree]"; } + + print " Module path or alias:\n"; + print "\n"; + print ""; + + if (2 <= @CVSROOT) { + print ""; + } } sub chooseMirror() { @@ -3115,7 +3133,7 @@ sub http_header(;$) { sub html_header($) { my ($title) = @_; - my $version = '$zRevision: 1.104 $ $kRevision: 1.54 $'; #' + my $version = '$zRevision: 1.104 $ $kRevision: 1.57 $'; #' http_header("text/html"); print <