===================================================================
RCS file: /cvs/cvsweb/cvsweb.cgi,v
retrieving revision 1.1.1.27
retrieving revision 3.35
diff -u -p -r1.1.1.27 -r3.35
--- cvsweb/cvsweb.cgi 2001/07/06 09:54:57 1.1.1.27
+++ cvsweb/cvsweb.cgi 2000/10/10 21:14:05 3.35
@@ -1,4 +1,4 @@
-#!/usr/bin/perl -wT
+#!/usr/bin/perl5 -ws
#
# 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-2001 Akinori MUSHA
+# (c) 2000 Akinori MUSHA
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
@@ -42,36 +42,30 @@
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#
-# $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 $
+# $zId: cvsweb.cgi,v 1.103 2000/09/20 17:02:29 jumager Exp $
+# $Id: cvsweb.cgi,v 3.35 2000/10/10 21:14:05 knu Exp $
#
###
-require 5.000;
-
use strict;
use vars qw (
- $cvsweb_revision
- $mydir $uname $config $allow_version_select $verbose
- @CVSrepositories @CVSROOT %CVSROOT %CVSROOTdescr
- %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
- @DIFFTYPES %DIFFTYPES @LOGSORTKEYS %LOGSORTKEYS
+ $config $allow_version_select $verbose
+ %CVSROOT %CVSROOTdescr %MIRRORS %DEFAULTVALUE %ICONS %MTYPES
%alltags @tabcolors %fileinfo %tags @branchnames %nameprinted
%symrev %revsym @allrevisions %date %author @revdisplayorder
@revisions %state %difflines %log %branchpoint @revorder
- $prcgi @prcategories $re_prcategories $prkeyword $re_prkeyword $mancgi
+ $prcgi @prcategories $prcategories $mancgi
$checkoutMagic $doCheckout $scriptname $scriptwhere
$where $pathinfo $Browser $nofilelinks $maycompress @stickyvars
%funcline_regexp $is_mod_perl
$is_links $is_lynx $is_w3m $is_msie $is_mozilla3 $is_textbased
%input $query $barequery $sortby $bydate $byrev $byauthor
- $bylog $byfile $defaultDiffType $logsort $cvstree $cvsroot
- $mimetype $charset $defaultTextPlain $defaultViewable
- $command_path %CMD $allow_compress
- $backicon $diricon $fileicon
- $fullname $newname $cvstreedefault
- $body_tag $body_tag_for_src $logo $defaulttitle $address
+ $bylog $byfile $hr_default $logsort $cvstree $cvsroot
+ $mimetype $defaultTextPlain $defaultViewable $allow_compress
+ $GZIPBIN $backicon $diricon $fileicon $fullname $newname
+ $cvstreedefault $body_tag $body_tag_for_src
+ $logo $defaulttitle $address
$long_intro $short_instruction $shortLogLen
$show_author $dirtable $tablepadding $columnHeaderColorDefault
$columnHeaderColorSorted $hr_breakable $showfunc $hr_ignwhite
@@ -80,20 +74,16 @@ use vars qw (
$difffontsize $inputTextSize $mime_types $allow_annotate
$allow_markup $use_java_script $open_extern_window
$extern_window_width $extern_window_height $edit_option_form
- $show_subdir_lastmod $show_log_in_markup $preformat_in_markup $v
+ $show_subdir_lastmod $show_log_in_markup $v
$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 @gzip_options @zip_options @cvs_options
$LOG_FILESEPARATOR $LOG_REVSEPARATOR
);
sub printDiffSelect($);
-sub printDiffLinks($$);
-sub printLogSortSelect($);
sub findLastModifiedSubdirs(@);
-sub htmlify_sub(&$);
sub htmlify($;$);
sub spacedHtmlText($;$);
sub link($$);
@@ -101,7 +91,6 @@ sub revcmp($$);
sub fatal($$);
sub redirect($);
sub safeglob($);
-sub search_path($);
sub getMimeTypeFromSuffix($);
sub head($;$);
sub scan_directives(@);
@@ -128,8 +117,6 @@ sub download_link($$$;$);
sub toggleQuery($$);
sub urlencode($);
sub htmlquote($);
-sub htmlunquote($);
-sub hrefquote($);
sub http_header(;$);
sub html_header($);
sub html_footer();
@@ -137,26 +124,16 @@ sub link_tags($);
sub forbidden_module($);
##### Start of Configuration Area ########
-delete $ENV{PATH};
+use Cwd;
-$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 (
- "$mydir/cvsweb.conf",
- '/usr/local/etc/cvsweb/cvsweb.conf'
+ $ENV{CVSWEB_CONFIG},
+ '/usr/local/etc/cvsweb.conf',
+ getcwd() . '/cvsweb.conf'
) {
- if (defined($_) && -r $_) {
- $config = $_;
- last;
- }
+ $config = $_ if defined($_) && -r $_;
}
# == Configuration defaults ==
@@ -168,9 +145,8 @@ $allow_version_select = 1;
######## Configuration variables #########
# These are defined to allow checking with perl -cw
-@CVSrepositories = @CVSROOT = %CVSROOT =
-%MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
-%tags = %alltags = @tabcolors = %fileinfo = ();
+%CVSROOT = %MIRRORS = %DEFAULTVALUE = %ICONS = %MTYPES =
+%tags = %alltags = @tabcolors = ();
$cvstreedefault = $body_tag = $body_tag_for_src =
$logo = $defaulttitle = $address =
$long_intro = $short_instruction = $shortLogLen =
@@ -188,49 +164,6 @@ $tabstop = $use_moddate = $moddate = $gzip_open = unde
$LOG_FILESEPARATOR = q/^={77}$/;
$LOG_REVSEPARATOR = q/^-{28}$/;
-@DIFFTYPES = qw(h H u c s);
-@DIFFTYPES{@DIFFTYPES} = (
- {
- 'descr' => 'colored',
- 'opts' => [ '-u' ],
- 'colored' => 1,
- },
- {
- 'descr' => 'long colored',
- 'opts' => [ '--unified=15' ],
- 'colored' => 1,
- },
- {
- 'descr' => 'unified',
- 'opts' => [ '-u' ],
- 'colored' => 0,
- },
- {
- 'descr' => 'context',
- 'opts' => [ '-c' ],
- 'colored' => 0,
- },
- {
- 'descr' => 'side by side',
- 'opts' => [ '--side-by-side', '--width=164' ],
- 'colored' => 0,
- },
- );
-
-@LOGSORTKEYS = qw(cvs date rev);
-@LOGSORTKEYS{@LOGSORTKEYS} = (
- {
- 'descr' => 'Not sorted',
- },
- {
- 'descr' => 'Commit date',
- },
- {
- 'descr' => 'Revision',
- },
- );
-
-
##### End of configuration variables #####
use Time::Local;
@@ -247,29 +180,23 @@ $verbose = $v;
$checkoutMagic = "~checkout~";
$pathinfo = defined($ENV{PATH_INFO}) ? $ENV{PATH_INFO} : '';
$where = $pathinfo;
-$doCheckout = ($where =~ m|^/$checkoutMagic/|);
-$where =~ s|^/$checkoutMagic/|/|;
-$where =~ s|^/||;
+$doCheckout = ($where =~ /^\/$checkoutMagic/);
+$where =~ s|^/($checkoutMagic)?||;
+$where =~ s|/+$||;
$scriptname = defined($ENV{SCRIPT_NAME}) ? $ENV{SCRIPT_NAME} : '';
-$scriptname =~ s|^/*|/|;
-
-# Let's workaround thttpd's stupidity..
-if ($scriptname =~ m|/$|) {
- $pathinfo .= '/';
- my $re = quotemeta $pathinfo;
- $scriptname =~ s/$re$//;
+$scriptname =~ s|^/?|/|;
+$scriptname =~ s|/+$||;
+$scriptwhere = $scriptname;
+if ($where) {
+ $scriptwhere .= '/' . urlencode($where);
}
-$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
# per file, so disable the link at the icon
# in this case:
-$Browser = $ENV{HTTP_USER_AGENT} || '';
+$Browser = $ENV{HTTP_USER_AGENT};
$is_links = ($Browser =~ m`^Links `);
$is_lynx = ($Browser =~ m`^Lynx/`i);
$is_w3m = ($Browser =~ m`^w3m/`i);
@@ -302,14 +229,16 @@ $maycompress = (((defined($ENV{HTTP_ACCEPT_ENCODING})
@stickyvars = qw(cvsroot hideattic sortby logsort f only_with_tag);
if (-f $config) {
- require $config
+ do $config
|| &fatal("500 Internal Error",
sprintf('Error in loading configuration file: %s
%s
',
$config, &htmlify($@)));
} else {
&fatal("500 Internal Error",
'Configuration not found. Set the variable $config
'
- . 'in cvsweb.cgi to your cvsweb.conf configuration file first.');
+ . 'in cvsweb.cgi, or the environment variable '
+ . 'CVSWEB_CONFIG
, to your cvsweb.conf '
+ . 'configuration file first.');
}
undef %input;
@@ -317,7 +246,6 @@ $query = $ENV{QUERY_STRING};
if (defined($query) && $query ne '') {
foreach (split(/&/, $query)) {
- y/+/ /;
s/%(..)/sprintf("%c", hex($1))/ge; # unquote %-quoted
if (/(\S+)=(.*)/) {
$input{$1} = $2 if ($2 ne "");
@@ -376,10 +304,6 @@ else {
}
undef @barequery;
-if (defined($input{path})) {
- redirect("$scriptname/$input{path}$query");
-}
-
# get actual parameters
$sortby = $input{"sortby"};
$bydate = 0;
@@ -403,26 +327,11 @@ else {
$byfile = 1;
}
-$defaultDiffType = $input{'f'};
+$hr_default = $input{'f'} eq 'h';
$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",
@@ -447,7 +356,7 @@ foreach $k (keys %ICONS) {
my ($itxt,$ipath,$iwidth,$iheight) = @{$ICONS{$k}};
if ($ipath) {
${"${k}icon"} = sprintf('',
- hrefquote($ipath), htmlquote($itxt), $iwidth, $iheight)
+ htmlquote($ipath), htmlquote($itxt), $iwidth, $iheight)
}
else {
${"${k}icon"} = $itxt;
@@ -459,45 +368,49 @@ my $config_cvstree = "$config-$cvstree";
# Do some special configuration for cvstrees
if (-f $config_cvstree) {
- require $config_cvstree
+ do $config_cvstree
|| &fatal("500 Internal Error",
sprintf('Error in loading configuration file: %s
%s
',
$config_cvstree, &htmlify($@)));
}
undef $config_cvstree;
-$re_prcategories = '(?:' . join('|', @prcategories) . ')' if @prcategories;
-$re_prkeyword = quotemeta($prkeyword) if defined($prkeyword);
+$prcategories = '(?:' . join('|', @prcategories) . ')';
$prcgi .= '%s' if defined($prcgi) && $prcgi !~ /%s/;
-$fullname = "$cvsroot/$where";
+$fullname = $cvsroot . '/' . $where;
$mimetype = &getMimeTypeFromSuffix ($fullname);
$defaultTextPlain = ($mimetype eq "text/plain");
$defaultViewable = $allow_markup && viewable($mimetype);
-my $rewrite = 0;
-
-if ($pathinfo =~ m|//|) {
- $pathinfo =~ y|/|/|s;
- $rewrite = 1;
+# 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;
+ }
+ }
}
-if (-d $fullname && $pathinfo !~ m|/$|) {
- $pathinfo .= '/';
- $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|/$|) {
- 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.');
}
@@ -510,63 +423,10 @@ $module = $1;
if ($module && &forbidden_module($module)) {
&fatal("403 Forbidden", "Access to $where forbidden.");
}
-
-#
-# Handle tarball downloads before any headers are output.
-#
-if ($input{tarball}) {
- &fatal("403 Forbidden", "Downloading tarballs is prohibited.")
- unless $allow_tar;
- my($module) = ($where =~ m,^/?(.*),); # untaint
- $module =~ s,/([^/]*)$,,;
- my($ext) = ($1 =~ /(\.tar\.gz|\.zip)$/);
- my($basedir) = ($module =~ m,([^/]+)$,);
-
- if ($basedir eq '' || $module eq '') {
- &fatal("500 Internal Error", "You cannot download the top level directory.");
- }
-
- my $tmpdir = "/tmp/.cvsweb.$$." . int(time);
-
- mkdir($tmpdir, 0700)
- or &fatal("500 Internal Error", "Unable to make temporary directory: $!");
-
- my @fatal;
-
- my $tag = (exists $input{only_with_tag} && length $input{only_with_tag})
- ? $input{only_with_tag} : "HEAD";
-
- 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.
-
- if ($ext eq '.tar.gz') {
- print "Content-type: application/x-gzip\r\n\r\n";
-
- 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";
-
- 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 $CMD{rm}, '-rf', $tmpdir if -d $tmpdir;
-
- &fatal(@fatal) if @fatal;
-
- exit;
-}
-
##############################
# View a directory
###############################
-if (-d $fullname) {
+elsif (-d $fullname) {
my $dh = do {local(*DH);};
opendir($dh, $fullname) || &fatal("404 Not Found","$where: $!");
my @dir = readdir($dh);
@@ -622,8 +482,9 @@ if (-d $fullname) {
}
print "
\n";
$infocols++;
- printf '',
- $byfile ? $columnHeaderColorSorted : $columnHeaderColorDefault;
+ print " |
---|
";
if ($byfile) {
print 'File';
} else {
@@ -635,8 +496,9 @@ if (-d $fullname) {
# with revision information:
if (scalar(%fileinfo)) {
$infocols++;
- printf ' | ',
- $byrev ? $columnHeaderColorSorted : $columnHeaderColorDefault;
+ print " | ";
if ($byrev) {
print 'Rev.';
} else {
@@ -645,19 +507,21 @@ if (-d $fullname) {
}
print " | ";
$infocols++;
- printf '',
- $bydate ? $columnHeaderColorSorted : $columnHeaderColorDefault;
+ print " | ";
if ($bydate) {
print 'Age';
} else {
print &link('Age', sprintf('./%s#dirlist',
- &toggleQuery("sortby", "date")));
+ &toggleQuery("sortby", "date")));
}
print " | ";
if ($show_author) {
$infocols++;
- printf '',
- $byauthor ? $columnHeaderColorSorted : $columnHeaderColorDefault;
+ print " | ";
if ($byauthor) {
print 'Author';
} else {
@@ -667,18 +531,19 @@ if (-d $fullname) {
print " | ";
}
$infocols++;
- printf '',
- $bylog ? $columnHeaderColorSorted : $columnHeaderColorDefault;
+ print " | ";
if ($bylog) {
print 'Last log entry';
} else {
print &link('Last log entry', sprintf('./%s#dirlist',
- &toggleQuery("sortby", "log")));
+ &toggleQuery("sortby", "log")));
}
print " | ";
}
elsif ($use_descriptions) {
- printf '', $columnHeaderColorDefault;
+ print " | ";
print "Description";
$infocols++;
}
@@ -741,22 +606,21 @@ if (-d $fullname) {
if ($_ eq '..' || -d "$fullname/$_") {
next if ($_ eq '..' && $where eq '/');
- my ($rev,$date,$log,$author,$filename);
- ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}
+ my ($rev,$date,$log,$author,$filename) = @{$fileinfo{$_}}
if (defined($fileinfo{$_}));
- printf ' |
---|
', $tabcolors[$dirrow % 2] if $dirtable;
+ print " |
" if ($dirtable);
if ($_ eq '..') {
- $url = "../$query";
+ $url = "../" . $query;
if ($nofilelinks) {
print $backicon;
}
else {
print &link($backicon, $url);
}
- print " ", &link("Parent Directory", $url);
+ print " ", &link("Previous Directory", $url);
}
else {
- $url = './' . urlencode($_) . "/$query";
+ $url = urlencode($_) . '/' . $query;
print "";
if ($nofilelinks) {
print $diricon;
@@ -775,7 +639,7 @@ if (-d $fullname) {
if ($filename) {
print " | | " if ($dirtable);
if ($date) {
- print " ", readableTime(time() - $date,0), "";
+ print " " . readableTime(time() - $date,0) . "";
}
if ($show_author) {
print " | " if ($dirtable);
@@ -786,8 +650,8 @@ if (-d $fullname) {
print "$filename/$rev";
print " " if ($dirtable);
if ($log) {
- print " ",
- &htmlify(substr($log,0,$shortLogLen));
+ print " "
+ . &htmlify(substr($log,0,$shortLogLen));
if (length $log > 80) {
print "...";
}
@@ -797,7 +661,7 @@ if (-d $fullname) {
else {
my ($dwhere) = ($where ne "/" ? $where : "") . $_;
if ($use_descriptions && defined $descriptions{$dwhere}) {
- print " | " if $dirtable;
+ print " | " if $dirtable;
print $descriptions{$dwhere};
} elsif ($dirtable && $infocols > 1) {
# close the row with the appropriate number of
@@ -819,7 +683,7 @@ if (-d $fullname) {
}
elsif (s/,v$//) {
$fileurl = ($attic ? "Attic/" : "") . urlencode($_);
- $url = './' . $fileurl . $query;
+ $url = $fileurl . $query;
my $rev = '';
my $date = '';
my $log = '';
@@ -828,7 +692,7 @@ if (-d $fullname) {
next if (!defined($fileinfo{$_}));
($rev,$date,$log,$author) = @{$fileinfo{$_}};
$filesfound++;
- printf ' |
', $tabcolors[$dirrow % 2] if $dirtable;
+ print " |
" if ($dirtable);
print "";
if ($nofilelinks) {
print $fileicon;
@@ -843,7 +707,7 @@ if (-d $fullname) {
$defaultViewable ? "text/x-cvsweb-markup" : undef);
print " | " if ($dirtable);
if ($date) {
- print " ", readableTime(time() - $date,0), "";
+ print " " . readableTime(time() - $date,0) . "";
}
if ($show_author) {
print " | " if ($dirtable);
@@ -851,7 +715,7 @@ if (-d $fullname) {
}
print " | " if ($dirtable);
if ($log) {
- print " ", &htmlify(substr($log,0,$shortLogLen));
+ print " " . &htmlify(substr($log,0,$shortLogLen));
if (length $log > 80) {
print "...";
}
@@ -866,7 +730,7 @@ if (-d $fullname) {
if ($dirtable && defined($tableBorderColor)) {
print " |
";
}
- print( $dirtable == 1 ? "\n" : "\n" );
+ print "". ($dirtable == 1) ? "" : "" . "\n";
if ($filesexists && !$filesfound) {
print "NOTE: There are $filesexists files, but none matches the current tag ($input{only_with_tag})\n";
@@ -902,33 +766,9 @@ if (-d $fullname) {
">$tag\n";
}
print "\n";
- print " Module path or alias:\n";
- printf "\n", htmlquote($where);
print "\n";
print "\n";
}
-
- if ($allow_tar) {
- my($basefile) = ($where =~ m,(?:.*/)?([^/]+),);
-
- if (defined($basefile) && $basefile ne '') {
- print "
\n",
- "Download this directory in ";
- # Mangle the filename so browsers show a reasonable
- # filename to download.
- print &link("tarball",
- "./$basefile.tar.gz$query".
- ($query ? "&" : "?")."tarball=1");
- if ($CMD{zip}) {
- print " or ",
- &link("zip archive",
- "./$basefile.zip$query".
- ($query ? "&" : "?")."tarball=1");
- }
- print "
";
- }
- }
-
my $formwhere = $scriptwhere;
$formwhere =~ s|Attic/?$|| if ($input{'hideattic'});
@@ -948,9 +788,12 @@ if (-d $fullname) {
print "